diff --git a/proof/ROOT b/proof/ROOT
index cb8a159bab..3f6712c7d5 100644
--- a/proof/ROOT
+++ b/proof/ROOT
@@ -147,9 +147,9 @@ session DPolicy in "dpolicy" = DRefine +
 session Access in "access-control" = AInvs +
   directories
     "$L4V_ARCH"
-  theories
+  theories [quick_and_dirty] (* for development only *)
     "ArchADT_AC"
-    "ExampleSystem"
+    (* "ExampleSystem" *)
 
 session InfoFlow in "infoflow" = Access +
   directories
diff --git a/proof/access-control/AARCH64/ArchADT_AC.thy b/proof/access-control/AARCH64/ArchADT_AC.thy
new file mode 100644
index 0000000000..ca23b3c3e4
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchADT_AC.thy
@@ -0,0 +1,113 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchADT_AC
+imports ADT_AC
+begin
+
+context Arch begin global_naming AARCH64
+
+named_theorems ADT_AC_assms
+
+lemma ptr_offset_in_ptr_range:
+  "\<lbrakk> invs s; get_vspace_of_thread (kheap s) (arch_state s) tcb \<noteq> global_pt s;
+     get_page_info (aobjs_of s)
+       (get_vspace_of_thread (kheap s) (arch_state s) tcb) x = Some (base, sz, attr, r) \<rbrakk>
+     \<Longrightarrow> ptrFromPAddr base + (x && mask sz) \<in> ptr_range (ptrFromPAddr base) sz"
+  apply (simp add: ptr_range_def mask_def)
+  apply (rule conjI)
+   apply (rule_tac b="2 ^ sz - 1" in word_plus_mono_right2)
+    apply (frule some_get_page_info_umapsD)
+          apply (fastforce dest: get_vspace_of_thread_reachable
+                           simp:  get_page_info_def)+
+    apply clarsimp
+    apply (drule is_aligned_ptrFromPAddr_n)
+     apply (simp add: pageBitsForSize_def pageBits_def canonical_bit_def
+                      ptTranslationBits_def pptrBaseOffset_alignment_def
+               split: vmpage_size.splits)
+    apply (clarsimp simp: is_aligned_no_overflow' word_and_le1)+
+  apply (subst p_assoc_help)
+  apply (rule word_plus_mono_right)
+   apply (rule word_and_le1)
+  apply (frule some_get_page_info_umapsD)
+        apply (fastforce dest: get_vspace_of_thread_reachable
+                         simp: get_page_info_def)+
+  apply clarsimp
+  apply (drule is_aligned_ptrFromPAddr_n)
+   apply (simp add: pageBitsForSize_def pageBits_def canonical_bit_def
+                    ptTranslationBits_def pptrBaseOffset_alignment_def
+             split: vmpage_size.splits)
+  apply (clarsimp simp: is_aligned_no_overflow')
+  done
+
+lemma user_op_access[ADT_AC_assms]:
+  "\<lbrakk> invs s; pas_refined aag s; is_subject aag tcb; ptable_lift tcb s x = Some ptr;
+     auth \<in> vspace_cap_rights_to_auth (ptable_rights tcb s x) \<rbrakk>
+     \<Longrightarrow> abs_has_auth_to aag auth tcb (ptrFromPAddr ptr)"
+  apply (clarsimp simp: ptable_lift_def split: option.splits)
+  apply (insert get_vspace_of_thread_asid_or_global_pt)
+  apply (erule_tac x=s in meta_allE)
+  apply (erule_tac x=tcb in meta_allE)
+  apply (cases "get_vspace_of_thread (kheap s) (arch_state s) tcb = global_pt s"; clarsimp)
+   apply (frule get_page_info_gpd_kmaps[rotated 3]; fastforce simp: get_page_info_def)
+  apply (frule (2) ptr_offset_in_ptr_range)
+  apply (frule get_vspace_of_thread_reachable; clarsimp)
+  apply (frule vs_lookup_table_vspace)
+     apply fastforce+
+  apply (clarsimp simp: vspace_for_asid_def entry_for_asid_def pool_for_asid_def entry_for_pool_def)
+  apply (clarsimp simp: get_vspace_of_thread_def get_page_info_def ptable_rights_def pt_lookup_slot_def
+                 split: if_splits option.splits kernel_object.splits cap.splits arch_cap.splits pt_type.splits)
+  apply (frule pt_lookup_slot_from_level_is_subject)
+          apply (fastforce elim: vs_lookup_table_vref_independent)+
+   apply (rule aag_Control_into_owns)
+    apply (clarsimp simp: pas_refined_def auth_graph_map_def state_objs_to_policy_def)
+    apply (erule subsetD)
+    apply (drule_tac addr="tcb_cnode_index 1" in caps_of_state_tcb)
+    apply (clarsimp simp: tcb_cnode_map_def)
+    apply (drule sbta_caps)
+      apply (fastforce simp: obj_refs_def)
+     apply (fastforce simp: cap_auth_conferred_def arch_cap_auth_conferred_def)
+    apply (rule_tac x=tcb in exI, fastforce)
+   apply simp
+  apply (clarsimp simp: pt_lookup_slot_from_level_def)
+  apply (drule_tac vref'=x in vs_lookup_table_vref_independent, rule order_refl)
+  apply (drule pt_walk_level)
+  apply (drule (1) vs_lookup_table_extend, rule order_refl)
+  apply (rename_tac level vref)
+  apply (case_tac "level = asid_pool_level", simp add: pt_walk_top)
+  apply (frule vs_lookup_table_is_aligned; clarsimp)
+  apply (clarsimp simp: pas_refined_def pte_info_def split: pte.splits)
+  apply (erule subsetD)
+  apply (clarsimp simp: auth_graph_map_def state_objs_to_policy_def vspace_for_asid_def)
+  apply (drule_tac s="pasObjectAbs aag vref" in sym)
+  apply (clarsimp simp: ptes_of_Some pts_of_Some)
+  apply (clarsimp simp: pt_apply_def split: pt.splits)
+   apply (intro exI conjI sbta_vref | simp add: state_vrefs_def vspace_objs_of_Some)+
+   apply (clarsimp simp: vs_refs_aux_def graph_of_def pte_ref2_def)
+   apply (rule_tac x="UCAST(64 \<rightarrow> vs_index_len) (pt_index max_pt_level x)" in exI)
+   apply (fastforce simp: image_iff ptrFromPAddr_def mult_is_add.mult_ac split: pte.splits)
+  apply (intro exI conjI sbta_vref | simp add: state_vrefs_def vspace_objs_of_Some)+
+  apply (clarsimp simp: vs_refs_aux_def graph_of_def pte_ref2_def)
+  apply (rule_tac x="UCAST(64 \<rightarrow> 9) (pt_index level x)" in exI)
+  apply (fastforce simp: image_iff ptrFromPAddr_def mult_is_add.mult_ac split: pte.splits)
+  done
+
+lemma write_in_vspace_cap_rights[ADT_AC_assms]:
+  "AllowWrite \<in> ptable_rights (cur_thread s) s va
+   \<Longrightarrow> Write \<in> vspace_cap_rights_to_auth (ptable_rights (cur_thread s) s va)"
+  by (clarsimp simp: vspace_cap_rights_to_auth_def)
+
+end
+
+
+global_interpretation ADT_AC_1?: ADT_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact ADT_AC_assms)
+qed
+
+end
diff --git a/proof/access-control/AARCH64/ArchAccess.thy b/proof/access-control/AARCH64/ArchAccess.thy
new file mode 100644
index 0000000000..0aff83ea09
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchAccess.thy
@@ -0,0 +1,363 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchAccess
+imports Types
+begin
+
+context Arch begin global_naming AARCH64
+
+subsection \<open>Arch-specific transformation of caps into authorities\<close>
+
+definition vspace_cap_rights_to_auth :: "cap_rights \<Rightarrow> auth set" where
+  "vspace_cap_rights_to_auth r \<equiv>
+     (if AllowWrite \<in> r then {Write} else {})
+   \<union> (if AllowRead \<in> r then {Read} else {})"
+
+definition arch_cap_auth_conferred where
+  "arch_cap_auth_conferred arch_cap \<equiv>
+     (if is_FrameCap arch_cap then vspace_cap_rights_to_auth (acap_rights arch_cap) else {Control})"
+
+subsection \<open>Generating a policy from the current ASID distribution\<close>
+
+definition pte_ref2 where
+  "pte_ref2 level pte \<equiv> case pte of
+     PagePTE paddr _ _ rights
+       \<Rightarrow> Some (ptrFromPAddr paddr,
+                pt_bits_left level,
+                vspace_cap_rights_to_auth rights)
+   | PageTablePTE ppn
+       \<Rightarrow> Some (ptrFromPAddr (paddr_from_ppn ppn), 0, {Control})
+   | _ \<Rightarrow> None"
+
+definition vs_refs_aux :: "vm_level \<Rightarrow> arch_kernel_obj \<Rightarrow> (obj_ref \<times> obj_ref \<times> aa_type \<times> auth) set"
+  where
+  "vs_refs_aux level \<equiv> \<lambda>ko. case ko of
+     ASIDPool pool \<Rightarrow> (\<lambda>(r,p). (p, ucast r, AASIDPool, Control)) ` graph_of (option_map ap_vspace o pool)
+   | PageTable pt \<Rightarrow> (case pt of
+       VSRootPT pt \<Rightarrow> \<Union>(r,(p, sz, auth)) \<in> graph_of (pte_ref2 level o pt).
+                      (\<lambda>(p, a). (p, ucast r, APageTable VSRootPT_T, a)) ` (ptr_range p sz \<times> auth)
+     | NormalPT pt \<Rightarrow> \<Union>(r,(p, sz, auth)) \<in> graph_of (pte_ref2 level o pt).
+                      (\<lambda>(p, a). (p, ucast r, APageTable NormalPT_T, a)) ` (ptr_range p sz \<times> auth))
+   | _ \<Rightarrow> {}"
+
+definition state_vrefs where
+  "state_vrefs s \<equiv> \<lambda>p.
+     \<Union>{vs_refs_aux lvl ao | lvl ao bot asid vref. vs_lookup_table bot asid vref s = Some (lvl, p)
+                                                 \<and> vspace_objs_of s p = Some ao \<and> vref \<in> user_region}"
+
+lemma state_vrefsD:
+  "\<lbrakk> vs_lookup_table level asid vref s = Some (lvl, p);
+     vspace_objs_of s p = Some ao; vref \<in> user_region; x \<in> vs_refs_aux lvl ao \<rbrakk>
+     \<Longrightarrow> x \<in> state_vrefs s p"
+  unfolding state_vrefs_def by fastforce
+
+end
+
+context Arch_p_arch_update_eq begin global_naming AARCH64
+
+interpretation Arch .
+
+lemma state_vrefs[iff]: "state_vrefs (f s) = state_vrefs s"
+  by (simp add: state_vrefs_def pspace)
+
+end
+
+context Arch begin global_naming AARCH64
+
+lemmas state_vrefs_upd =
+  cur_thread_update.state_vrefs
+  cdt_update.state_vrefs
+  irq_node_update_arch.state_vrefs
+  interrupt_update.state_vrefs
+  revokable_update.state_vrefs
+  machine_state_update.state_vrefs
+  more_update.state_vrefs
+
+end
+
+context Arch begin
+
+primrec aobj_ref' where
+  "aobj_ref' (ASIDPoolCap ref _) = {ref}"
+| "aobj_ref' ASIDControlCap = {}"
+| "aobj_ref' (FrameCap ref _ sz _ _) = ptr_range ref (pageBitsForSize sz)"
+| "aobj_ref' (PageTableCap ref _ _) = {ref}"
+| "aobj_ref' (VCPUCap ref) = {ref}"
+
+fun acap_asid' :: "arch_cap \<Rightarrow> asid set" where
+  "acap_asid' (FrameCap _ _ _ _ mapping) = fst ` set_option mapping"
+| "acap_asid' (PageTableCap _ _ mapping) = fst ` set_option mapping"
+| "acap_asid' (ASIDPoolCap _ asid) = {x. asid_high_bits_of x = asid_high_bits_of asid \<and> x \<noteq> 0}"
+| "acap_asid' ASIDControlCap = UNIV"
+| "acap_asid' (VCPUCap _) = {}"
+
+inductive_set state_asids_to_policy_aux for aag caps asid_tab vrefs where
+  sata_asid:
+    "\<lbrakk> caps ptr = Some (ArchObjectCap acap); asid \<in> acap_asid' acap \<rbrakk>
+       \<Longrightarrow> (pasObjectAbs aag (fst ptr), Control, pasASIDAbs aag asid)
+             \<in> state_asids_to_policy_aux aag caps asid_tab vrefs"
+| sata_asid_lookup:
+    "\<lbrakk> asid_tab (asid_high_bits_of asid) = Some poolptr;
+       (pdptr, ucast (asid && mask asid_low_bits), AASIDPool, a) \<in> vrefs poolptr \<rbrakk>
+       \<Longrightarrow> (pasASIDAbs aag asid, a, pasObjectAbs aag pdptr)
+             \<in> state_asids_to_policy_aux aag caps asid_tab vrefs"
+| sata_asidpool:
+    "\<lbrakk> asid_tab (asid_high_bits_of asid) = Some poolptr; asid \<noteq> 0 \<rbrakk>
+       \<Longrightarrow> (pasObjectAbs aag poolptr, AAuth ASIDPoolMapsASID, pasASIDAbs aag asid)
+             \<in> state_asids_to_policy_aux aag caps asid_tab vrefs"
+
+definition
+  "state_asids_to_policy_arch aag caps astate vrefs \<equiv>
+     state_asids_to_policy_aux aag caps (arm_asid_table astate)
+                               (vrefs :: 64 word \<Rightarrow> (64 word \<times> 64 word \<times> aa_type \<times> auth) set)"
+declare state_asids_to_policy_arch_def[simp]
+
+section \<open>Arch-specific integrity definition\<close>
+
+subsection \<open>How ASIDs can change\<close>
+
+abbreviation integrity_asids_aux :: "'a PAS \<Rightarrow> 'a set \<Rightarrow> obj_ref \<Rightarrow> asid \<Rightarrow>
+                                     (asid_high_index \<rightharpoonup> obj_ref) \<Rightarrow> (asid_high_index \<rightharpoonup> obj_ref) \<Rightarrow>
+                                     (obj_ref \<rightharpoonup> asid_pool) \<Rightarrow> (obj_ref \<rightharpoonup> asid_pool) \<Rightarrow> bool" where
+  "integrity_asids_aux aag subjects x asid atab atab' pools pools'  \<equiv>
+     (atab (asid_high_bits_of asid) \<noteq> atab' (asid_high_bits_of asid)
+      \<longrightarrow> (\<forall>x. atab' (asid_high_bits_of asid) = Some x \<longrightarrow> pasObjectAbs aag x \<in> subjects) \<and>
+          (\<forall>asid'. asid' \<noteq> 0 \<and> asid_high_bits_of asid' = asid_high_bits_of asid
+                   \<longrightarrow> pasASIDAbs aag asid' \<in> subjects)) \<and>
+     (pasObjectAbs aag x \<notin> subjects
+      \<longrightarrow> (\<forall>pool. pools x = Some pool
+                  \<longrightarrow> pools' x \<noteq> None \<and>
+                      (\<forall>pool'. pools' x = Some pool' \<longrightarrow>
+                               (pool \<noteq> pool' \<longrightarrow> (\<exists>asid. atab (asid_high_bits_of asid) = Some x)))))"
+
+definition integrity_asids ::
+  "'a PAS \<Rightarrow> 'a set \<Rightarrow> obj_ref \<Rightarrow> asid \<Rightarrow> 'y::state_ext state \<Rightarrow> 'z::state_ext state  \<Rightarrow> bool" where
+  "integrity_asids aag subjects x asid s s' \<equiv>
+   integrity_asids_aux aag subjects x asid (asid_table s) (asid_table s')
+                                           (asid_pools_of s) (asid_pools_of s')"
+
+sublocale kheap_update: Arch_arch_update_eq "kheap_update f"
+  by unfold_locales simp
+
+lemma (in Arch_p_arch_update_eq) integrity_asids_update[simp]:
+  "integrity_asids aag subjects x a (f st) s = integrity_asids aag subjects x a st s"
+  "integrity_asids aag subjects x a st (f s) = integrity_asids aag subjects x a st s"
+  by (auto simp: integrity_asids_def arch pspace)
+
+lemmas integrity_asids_updates =
+  cdt_update.integrity_asids_update
+  more_update.integrity_asids_update
+  revokable_update.integrity_asids_update
+  interrupt_update.integrity_asids_update
+  cur_thread_update.integrity_asids_update
+  machine_state_update.integrity_asids_update
+
+lemma integrity_asids_cnode_update':
+  "\<lbrakk> kheap st p = Some (CNode sz cs); integrity_asids aag subjects x a st (s\<lparr>kheap := rest\<rparr>) \<rbrakk>
+     \<Longrightarrow> integrity_asids aag subjects x a st (s\<lparr>kheap := \<lambda>x. if x = p then v else rest x\<rparr>)"
+  by (auto simp: integrity_asids_def opt_map_def split: option.splits)
+
+lemma integrity_asids_tcb_update':
+  "\<lbrakk> kheap st p = Some (TCB tcb); integrity_asids aag subjects x a st (s\<lparr>kheap := rest\<rparr>) \<rbrakk>
+     \<Longrightarrow> integrity_asids aag subjects x a st (s\<lparr>kheap := \<lambda>x. if x = p then v else rest x\<rparr>)"
+  by (auto simp: integrity_asids_def opt_map_def split: option.splits)
+
+lemma integrity_asids_ep_update':
+  "\<lbrakk> kheap st p = Some (Endpoint ep); integrity_asids aag subjects x a st (s\<lparr>kheap := rest\<rparr>) \<rbrakk>
+     \<Longrightarrow> integrity_asids aag subjects x a st (s\<lparr>kheap := \<lambda>x. if x = p then v else rest x\<rparr>)"
+  by (auto simp: integrity_asids_def opt_map_def split: option.splits)
+
+lemma integrity_asids_ntfn_update':
+  "\<lbrakk> kheap st p = Some (Notification ntfn); integrity_asids aag subjects x a st (s\<lparr>kheap := rest\<rparr>) \<rbrakk>
+     \<Longrightarrow> integrity_asids aag subjects x a st (s\<lparr>kheap := \<lambda>x. if x = p then v else rest x\<rparr>)"
+  by (auto simp: integrity_asids_def opt_map_def split: option.splits)
+
+lemmas integrity_asids_kh_upds'' =
+  integrity_asids_cnode_update'
+  integrity_asids_tcb_update'
+  integrity_asids_ep_update'
+  integrity_asids_ntfn_update'
+
+lemmas integrity_asids_kh_upds =
+  integrity_asids_kh_upds''
+  integrity_asids_kh_upds''[where rest="kheap s" and s=s for s, folded fun_upd_def, simplified]
+
+declare integrity_asids_def[simp]
+
+lemma integrity_asids_kh_upds':
+  "integrity_asids aag subjects x a (s\<lparr>kheap := (kheap s)(p \<mapsto> CNode sz cs)\<rparr>) s"
+  "integrity_asids aag subjects x a (s\<lparr>kheap := (kheap s)(p \<mapsto> TCB tcb)\<rparr>) s"
+  "integrity_asids aag subjects x a (s\<lparr>kheap := (kheap s)(p \<mapsto> Endpoint ep)\<rparr>) s"
+  "integrity_asids aag subjects x a (s\<lparr>kheap := (kheap s)(p \<mapsto> Notification ntfn)\<rparr>) s"
+  by (auto simp: opt_map_def split: option.splits)
+
+lemma integrity_asids_kh_update:
+  "integrity_asids aag subject x a (s\<lparr>kheap := kh\<rparr>) (s\<lparr>kheap := kh'\<rparr>)
+   \<Longrightarrow> integrity_asids aag subject x a (s\<lparr>kheap := kh(p := v)\<rparr>) (s\<lparr>kheap := kh'(p := v)\<rparr>)"
+  by (clarsimp simp: opt_map_def)
+
+
+subsection \<open>Misc definitions\<close>
+
+fun ctxt_IP_update where
+  "ctxt_IP_update (UserContext fpu ctxt) = UserContext fpu (ctxt(NextIP := ctxt FaultIP))"
+
+lemma ctxt_IP_update_def:
+  "ctxt_IP_update ctxt =
+   (case ctxt of (UserContext fpu ctxt') \<Rightarrow> UserContext fpu (ctxt'(NextIP := ctxt' FaultIP)))"
+  by (cases ctxt; clarsimp)
+
+abbreviation arch_IP_update where
+  "arch_IP_update arch \<equiv> arch_tcb_context_set (ctxt_IP_update (arch_tcb_context_get arch)) arch"
+
+definition asid_pool_integrity ::
+  "'a set \<Rightarrow> 'a PAS \<Rightarrow> (asid_low_index \<rightharpoonup> asid_pool_entry) \<Rightarrow> (asid_low_index \<rightharpoonup> asid_pool_entry) \<Rightarrow> bool" where
+  "asid_pool_integrity subjects aag pool pool' \<equiv>
+     \<forall>x. pool' x \<noteq> pool x
+         \<longrightarrow> pool' x = None \<and> aag_subjects_have_auth_to subjects aag Control (ap_vspace (the (pool x)))"
+
+inductive arch_integrity_obj_atomic ::
+   "'a PAS \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> arch_kernel_obj \<Rightarrow> arch_kernel_obj \<Rightarrow> bool"
+  for aag subjects l ao ao' where
+  arch_troa_asidpool_clear:
+    "\<lbrakk> ao = ASIDPool pool; ao' = ASIDPool pool';
+       asid_pool_integrity subjects aag pool pool' \<rbrakk>
+       \<Longrightarrow> arch_integrity_obj_atomic aag subjects l ao ao'"
+
+inductive arch_integrity_obj_alt ::
+   "'a PAS \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> arch_kernel_obj \<Rightarrow> arch_kernel_obj \<Rightarrow> bool"
+  for aag subjects l' ao ao' where
+  arch_tro_alt_asidpool_clear:
+    "\<lbrakk> ao = ASIDPool pool; ao' = ASIDPool pool';
+       asid_pool_integrity subjects aag pool pool'\<rbrakk>
+       \<Longrightarrow> arch_integrity_obj_alt aag subjects l' ao ao'"
+
+definition auth_ipc_buffers :: "'z::state_ext state \<Rightarrow> obj_ref \<Rightarrow> obj_ref set" where
+  "auth_ipc_buffers s \<equiv> \<lambda>p. case (get_tcb p s) of
+     None \<Rightarrow> {}
+   | Some tcb \<Rightarrow>
+     (case tcb_ipcframe tcb of
+        ArchObjectCap (FrameCap p' R vms False _) \<Rightarrow>
+          if AllowWrite \<in> R
+          then (ptr_range (p' + (tcb_ipc_buffer tcb && mask (pageBitsForSize vms))) msg_align_bits)
+          else {}
+      | _ \<Rightarrow> {})"
+
+end
+
+
+context begin interpretation Arch .
+
+requalify_consts
+  vspace_cap_rights_to_auth
+  aobj_ref'
+  acap_asid'
+  state_vrefs
+  state_asids_to_policy_arch
+  integrity_asids
+  ctxt_IP_update
+  arch_IP_update
+  arch_cap_auth_conferred
+  arch_integrity_obj_atomic
+  arch_integrity_obj_alt
+  auth_ipc_buffers
+
+requalify_facts
+  integrity_asids_updates
+  state_vrefs_upd
+  integrity_asids_kh_upds
+  integrity_asids_kh_upds'
+  integrity_asids_kh_update
+
+end
+
+declare state_vrefs_upd[simp]
+declare integrity_asids_updates[simp]
+
+
+context Arch begin global_naming AARCH64
+
+(* FIXME AARCH64: update the access control spec
+   -Parameterise arch object updates with machine state and arch state
+   -Model virtualised machine state more explicitly
+   -Specify when virtualised machine state can change (i.e. restoring from current VCPU)
+   -Specify when arm_current_vcpu can change (i.e. once current VCPU has been saved)
+   -Specify integrity constraints for FPUs
+*)
+
+\<comment> \<open>Anyone can save virtualised registers to the current VCPU\<close>
+lemma arch_troa_vcpu_save_reg:
+    "\<lbrakk> aobjs_of s vptr = Some (VCPU vcpu); ao' = VCPU vcpu';
+       option_map fst (arm_current_vcpu (arch_state s)) = Some vptr;
+       vcpu' = vcpu\<lparr>vcpu_regs := (vcpu_regs vcpu)(reg := vcpuHardwareReg_val reg (machine_state s))\<rparr> \<rbrakk>
+       \<Longrightarrow> arch_integrity_obj_atomic aag subjects l ao ao'"
+  sorry
+
+(* FIXME AARCH64: assert a connection to the current (or soon-to-be-switched-to) thread? *)
+\<comment> \<open>Anyone can update the virtual count offset in the current VCPU\<close>
+lemma arch_troa_vcpu_restore_vtimer:
+  "\<lbrakk> aobjs_of s vptr = Some (VCPU vcpu); ao' = VCPU vcpu';
+     option_map fst (arm_current_vcpu (arch_state s)) = Some vptr;
+     vcpu' = vcpu\<lparr>vcpu_regs := (vcpu_regs vcpu)
+                    (VCPURegCNTVOFF := vcpu_regs vcpu VCPURegCNTVOFF
+                                       + (read_cntpct_val (machine_state s)
+                                          - vtimerLastPCount (vcpu_vtimer vcpu)))\<rparr> \<rbrakk>
+     \<Longrightarrow> arch_integrity_obj_atomic aag subjects l ao ao'"
+  sorry
+
+\<comment> \<open>Anyone can save the physical count register to the current VCPU\<close>
+lemma arch_troa_vcpu_save_virt_timer:
+    "\<lbrakk> aobjs_of s vptr = Some (VCPU vcpu); ao' = VCPU vcpu';
+       option_map fst (arm_current_vcpu (arch_state s)) = Some vptr;
+       vcpu' = vcpu\<lparr>vcpu_vtimer := VirtTimer (read_cntpct_val (machine_state s))\<rparr> \<rbrakk>
+       \<Longrightarrow> arch_integrity_obj_atomic aag subjects l ao ao'"
+  sorry
+
+\<comment> \<open>Anyone can save virtualised GIC registers to the current VCPU\<close>
+lemma arch_troa_vcpu_save_vgic:
+    "\<lbrakk> aobjs_of s vptr = Some (VCPU vcpu); ao' = VCPU vcpu';
+       option_map fst (arm_current_vcpu (arch_state s)) = Some vptr;
+       vcpu' = vcpu \<lparr>vcpu_vgic := vgic\<rparr>;
+       vgic = vcpu_vgic vcpu\<lparr>vgic_hcr := gic_vcpu_ctrl_hcr_val (machine_state s)\<rparr> \<or>
+       vgic = vcpu_vgic vcpu\<lparr>vgic_vmcr := gic_vcpu_ctrl_vmcr_val (machine_state s)\<rparr> \<or>
+       vgic = vcpu_vgic vcpu\<lparr>vgic_apr := gic_vcpu_ctrl_apr_val (machine_state s)\<rparr> \<or>
+       vgic = vcpu_vgic vcpu\<lparr>vgic_lr := (vgic_lr (vcpu_vgic vcpu))
+                                        (vreg := gic_vcpu_ctrl_lr_val (of_nat vreg) (machine_state s))\<rparr> \<rbrakk>
+       \<Longrightarrow> arch_integrity_obj_atomic aag subjects l ao ao'"
+  sorry
+
+\<comment> \<open>Update the vmid of a pool\<close>
+lemma
+  arch_troa_asidpool_vmid:
+    "\<lbrakk> ao = ASIDPool pool; ao' = ASIDPool pool';
+       \<forall>x. (pool x = None) = (pool' x = None);
+       \<forall>x e e'. pool x = Some e \<and> pool' x = Some e'
+           \<longrightarrow> (ap_vspace e = ap_vspace e' \<and>
+               (ap_vmid e = ap_vmid e' \<or> ap_vmid e = None \<or> ap_vmid e' = None)) \<rbrakk>
+       \<Longrightarrow> arch_integrity_obj_atomic aag subjects l ao ao'"
+  sorry
+
+\<comment> \<open>If a VCPU belongs to the current agent, then so does its associated TCB\<close>
+lemma associated_tcb_is_subject:
+  "\<lbrakk> vcpus_of s v = Some vcpu; vcpu_tcb vcpu = Some t; is_subject aag v \<rbrakk>
+     \<Longrightarrow> is_subject aag t"
+  sorry
+
+\<comment> \<open>If a TCB belongs to the current agent, then so does its associated VCPU\<close>
+lemma associated_vcpu_is_subject:
+  "\<lbrakk> get_tcb t s = Some tcb; tcb_vcpu (tcb_arch tcb) = Some v; is_subject aag t \<rbrakk>
+     \<Longrightarrow> is_subject aag v"
+  sorry
+
+(* FIXME AARCH64: clarify when we can assume this *)
+lemma invs_valid_cur_vcpu:
+  "invs s \<Longrightarrow> valid_cur_vcpu s"
+  sorry
+
+end
+
+end
diff --git a/proof/access-control/AARCH64/ArchAccess_AC.thy b/proof/access-control/AARCH64/ArchAccess_AC.thy
new file mode 100644
index 0000000000..4e3376a928
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchAccess_AC.thy
@@ -0,0 +1,261 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchAccess_AC
+imports Access_AC
+begin
+
+section\<open>Arch-specific AC proofs\<close>
+
+context Arch begin global_naming AARCH64
+
+named_theorems Access_AC_assms
+
+lemma acap_class_reply[Access_AC_assms]:
+  "acap_class acap \<noteq> ReplyClass t"
+  by (cases acap; simp)
+
+lemma arch_troa_tro_alt[Access_AC_assms, elim!]:
+  "arch_integrity_obj_atomic aag subjects l ko ko'
+   \<Longrightarrow> arch_integrity_obj_alt aag subjects l ko ko'"
+  by (fastforce elim: arch_integrity_obj_atomic.cases intro: arch_integrity_obj_alt.intros)
+
+lemma clear_asidpool_trans[elim]:
+  "\<lbrakk> asid_pool_integrity subjects aag pool pool';
+     asid_pool_integrity subjects aag pool' pool'' \<rbrakk>
+     \<Longrightarrow> asid_pool_integrity subjects aag pool pool''"
+  unfolding asid_pool_integrity_def by metis
+
+lemma cap_asid'_member[simp]:
+  "asid \<in> cap_asid' cap = (\<exists>acap. cap = ArchObjectCap acap \<and> asid \<in> acap_asid' acap)"
+  by (cases cap; clarsimp)
+
+lemma clas_caps_of_state[Access_AC_assms]:
+  "\<lbrakk> caps_of_state s slot = Some cap; pas_refined aag s \<rbrakk>
+     \<Longrightarrow> cap_links_asid_slot aag (pasObjectAbs aag (fst slot)) cap"
+  apply (clarsimp simp: cap_links_asid_slot_def label_owns_asid_slot_def pas_refined_def)
+  apply (drule state_asids_to_policy_aux.intros)
+   apply assumption
+  apply (blast dest: state_asids_to_policy_aux.intros)
+  done
+
+lemma arch_tro_alt_trans_spec[Access_AC_assms]:
+  "\<lbrakk> arch_integrity_obj_alt aag subjects l ko ko';
+     arch_integrity_obj_alt aag subjects l ko' ko'' \<rbrakk>
+     \<Longrightarrow> arch_integrity_obj_alt aag subjects l ko ko''"
+  by (fastforce simp: arch_integrity_obj_alt.simps)
+
+end
+
+
+global_interpretation Access_AC_1?: Access_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Access_AC_assms)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma auth_ipc_buffers_tro[Access_AC_assms]:
+  "\<lbrakk> integrity_obj_state aag activate subjects s s';
+     x \<in> auth_ipc_buffers s' p; pasObjectAbs aag p \<notin> subjects \<rbrakk>
+     \<Longrightarrow> x \<in> auth_ipc_buffers s p "
+  by (drule_tac x = p in spec)
+     (erule integrity_objE;
+      fastforce simp: tcb_states_of_state_def get_tcb_def auth_ipc_buffers_def
+               split: cap.split_asm arch_cap.split_asm if_split_asm bool.splits)
+
+lemma trasids_trans[Access_AC_assms]:
+  "\<lbrakk> (\<forall>x a. integrity_asids aag subjects x a s s');
+     (\<forall>x a. integrity_asids aag subjects x a  s' s'') \<rbrakk>
+     \<Longrightarrow> (\<forall>x a. integrity_asids aag subjects x a s s'')"
+  by clarsimp metis
+
+lemma integrity_asids_refl[Access_AC_assms, simp]:
+  "integrity_asids aag subjects x a s s"
+  by simp
+
+lemma integrity_asids_update_autarch[Access_AC_assms]:
+  "\<lbrakk> \<forall>x a. integrity_asids aag {pasSubject aag} x a st s; is_subject aag ptr \<rbrakk>
+     \<Longrightarrow> \<forall>x a. integrity_asids aag {pasSubject aag} x a st (s\<lparr>kheap := (kheap s)(ptr \<mapsto> obj)\<rparr>)"
+  by (auto simp: opt_map_def)
+
+end
+
+
+global_interpretation Access_AC_2?: Access_AC_2
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; (fact Access_AC_assms)?)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma ipcframe_subset_page:
+  "\<lbrakk> valid_objs s; get_tcb p s = Some tcb;
+     tcb_ipcframe tcb = ArchObjectCap (FrameCap p' R vms d xx);
+     x \<in> ptr_range (p' + (tcb_ipc_buffer tcb && mask (pageBitsForSize vms))) msg_align_bits \<rbrakk>
+     \<Longrightarrow> x \<in> ptr_range p' (pageBitsForSize vms)"
+   apply (frule (1) valid_tcb_objs)
+   apply (clarsimp simp add: valid_tcb_def ran_tcb_cap_cases)
+   apply (erule set_mp[rotated])
+   apply (rule ptr_range_subset)
+     apply (simp add: valid_cap_def cap_aligned_def)
+    apply (simp add: valid_tcb_def valid_ipc_buffer_cap_def is_aligned_andI1 split:bool.splits)
+   apply (rule order_trans [OF _ pbfs_atleast_pageBits])
+   apply (simp add: msg_align_bits pageBits_def)
+  apply (rule and_mask_less')
+  apply (simp add: pbfs_less_wb' [unfolded word_bits_conv])
+  done
+
+lemma auth_ipc_buffers_member_def:
+  "x \<in> auth_ipc_buffers s p =
+   (\<exists>tcb p' R vms xx. get_tcb p s = Some tcb
+                   \<and> tcb_ipcframe tcb = (ArchObjectCap (FrameCap p' R vms False xx))
+                   \<and> caps_of_state s (p, tcb_cnode_index 4) =
+                      Some (ArchObjectCap (FrameCap p' R vms False xx))
+                   \<and> AllowWrite \<in> R
+                   \<and> x \<in> ptr_range (p' + (tcb_ipc_buffer tcb && mask (pageBitsForSize vms)))
+                                    msg_align_bits)"
+  unfolding auth_ipc_buffers_def
+  by (clarsimp simp: caps_of_state_tcb' split: option.splits cap.splits arch_cap.splits bool.splits)
+
+lemma auth_ipc_buffers_member[Access_AC_assms]:
+  "\<lbrakk> x \<in> auth_ipc_buffers s p; valid_objs s \<rbrakk>
+     \<Longrightarrow> \<exists>tcb acap. get_tcb p s = Some tcb
+                  \<and> tcb_ipcframe tcb = (ArchObjectCap acap)
+                  \<and> caps_of_state s (p, tcb_cnode_index 4) = Some (ArchObjectCap acap)
+                  \<and> Write \<in> arch_cap_auth_conferred acap
+                  \<and> x \<in> aobj_ref' acap"
+  by (fastforce simp: auth_ipc_buffers_def caps_of_state_tcb' arch_cap_auth_conferred_def
+                      vspace_cap_rights_to_auth_def ipcframe_subset_page
+               split: option.splits cap.splits arch_cap.splits bool.splits if_splits)
+
+lemma asid_pool_integrity_mono[Access_AC_assms]:
+  "\<lbrakk> asid_pool_integrity S aag cont cont'; S \<subseteq> T \<rbrakk> \<Longrightarrow> asid_pool_integrity T aag cont cont'"
+  unfolding asid_pool_integrity_def by fastforce
+
+lemma integrity_asids_mono[Access_AC_assms]:
+    "\<lbrakk> integrity_asids aag S x a s s'; S \<subseteq> T; pas_refined aag s; valid_objs s \<rbrakk>
+       \<Longrightarrow> integrity_asids aag T x a s s'"
+  by fastforce
+
+lemma arch_integrity_obj_atomic_mono[Access_AC_assms]:
+  "\<lbrakk> arch_integrity_obj_atomic aag S l ao ao'; S \<subseteq> T; pas_refined aag s; valid_objs s \<rbrakk>
+     \<Longrightarrow> arch_integrity_obj_atomic aag T l ao ao'"
+  by (clarsimp simp: arch_integrity_obj_atomic.simps asid_pool_integrity_mono)
+
+end
+
+
+global_interpretation Access_AC_3?: Access_AC_3
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Access_AC_assms)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma pas_refined_irq_state_independent[intro!, simp]:
+  "pas_refined x (s\<lparr>machine_state := machine_state s\<lparr>irq_state := f (irq_state (machine_state s))\<rparr>\<rparr>) =
+   pas_refined x s"
+  by (simp add: pas_refined_def)
+
+(* FIXME AARCH64: try to use in_opt_map_eq where possible *)
+lemma vspace_objs_of_Some:
+  "(vspace_objs_of s p = Some ao) = (aobjs_of s p = Some ao \<and> \<not>is_VCPU ao)"
+  by (clarsimp simp: in_opt_map_eq vspace_obj_of_Some)
+
+lemma state_irqs_to_policy_eq_caps:
+  "\<lbrakk> x \<in> state_irqs_to_policy_aux aag caps; caps = caps' \<rbrakk>
+     \<Longrightarrow> x \<in> state_irqs_to_policy_aux aag caps'"
+  by (erule subst)
+
+lemma vs_lookup_table_eqI':
+    "\<lbrakk> asid_table s' (asid_high_bits_of asid) = asid_table s (asid_high_bits_of asid);
+       \<forall>pool_ptr. asid_table s' (asid_high_bits_of asid) = Some pool_ptr
+                  \<longrightarrow> bot_level \<le> max_pt_level
+                  \<longrightarrow> vspace_for_pool pool_ptr asid (asid_pools_of s') =
+                      vspace_for_pool pool_ptr asid (asid_pools_of s);
+       bot_level < max_pt_level \<longrightarrow> pts_of s' = pts_of s \<rbrakk>
+   \<Longrightarrow> vs_lookup_table bot_level asid vref s' = vs_lookup_table bot_level asid vref s"
+  by (auto simp: obind_def vs_lookup_table_def asid_pool_level_eq[symmetric]
+                 pool_for_asid_def entry_for_pool_def vspace_for_pool_def
+          split: option.splits)
+
+lemma vs_refs_aux_eqI:
+  assumes "pts_of s' = pts_of s"
+  and "\<forall>p sz. data_at sz p s' = data_at sz p s"
+  and "\<forall>pool_ptr asid. (asid_pools_of s' |> oapply asid |> ogets ap_vspace) pool_ptr
+                     = (asid_pools_of s |> oapply asid |> ogets ap_vspace) pool_ptr"
+  and "aobjs_of s p = Some ao"
+  and "aobjs_of s' p = Some ao'"
+  shows "vs_refs_aux level ao = vs_refs_aux level ao'"
+  apply (insert assms)
+  apply (clarsimp simp: fun_eq_iff)
+  apply (erule_tac x=p in allE)+
+  apply (fastforce simp: vs_refs_aux_def graph_of_def image_iff opt_map_def ogets_def
+                  split: option.splits arch_kernel_obj.splits)
+  done
+
+lemma state_vrefs_eqI':
+  assumes "asid_table s' = asid_table s"
+    and "pts_of s' = pts_of s"
+    and "\<forall>p sz. data_at sz p s' = data_at sz p s"
+    and "\<forall>pool_ptr asid. (asid_pools_of s' |> oapply asid |> ogets ap_vspace) pool_ptr
+                       = (asid_pools_of s |> oapply asid |> ogets ap_vspace) pool_ptr"
+  shows "state_vrefs s' = state_vrefs s"
+  apply (insert assms)
+  apply (prop_tac "\<And>level asid vref. vs_lookup_table level asid vref s' = vs_lookup_table level asid vref s")
+   apply (rule vs_lookup_table_eqI')
+     apply (auto simp: fun_eq_iff vspace_for_pool_def entry_for_pool_def obind_def ogets_def opt_map_def)[3]
+  apply (rule ext)+
+  apply (intro equalityI subsetI; subst (asm) state_vrefs_def; clarsimp)
+
+   apply (clarsimp simp: vspace_objs_of_Some)
+   apply (case_tac "vspace_objs_of s x"; clarsimp?)
+    apply (clarsimp simp: fun_eq_iff)
+    apply (erule_tac x=x in allE)+
+    apply (fastforce simp: vspace_obj_of_def vs_refs_aux_def graph_of_def
+                           image_iff opt_map_def ogets_def is_VCPU_def
+                    split: option.splits arch_kernel_obj.splits if_splits )[1]
+   apply (prop_tac "\<forall>level. vs_refs_aux level ao = vs_refs_aux level ac")
+    apply (intro allI vs_refs_aux_eqI; fastforce simp: vspace_objs_of_Some)
+   apply (fastforce intro: state_vrefsD)
+
+  apply (clarsimp simp: vspace_objs_of_Some)
+  apply (case_tac "vspace_objs_of s' x"; clarsimp?)
+   apply (clarsimp simp: fun_eq_iff)
+   apply (erule_tac x=x in allE)+
+   apply (fastforce simp: vspace_obj_of_def vs_refs_aux_def graph_of_def
+                          image_iff opt_map_def ogets_def is_VCPU_def
+                   split: option.splits arch_kernel_obj.splits if_splits )[1]
+  apply (prop_tac "\<forall>level. vs_refs_aux level ac = vs_refs_aux level ao")
+   apply (intro allI vs_refs_aux_eqI; fastforce simp: vspace_objs_of_Some)
+  apply (fastforce intro!: state_vrefsD)
+  done
+
+lemma state_vrefs_eqI:
+  assumes "asid_table s' = asid_table s"
+    and "vspace_objs_of s' = vspace_objs_of s"
+  shows "state_vrefs s' = state_vrefs s"
+  apply (prop_tac "\<forall>level asid vref. vs_lookup_table level asid vref s = vs_lookup_table level asid vref s'")
+   apply (intro allI vs_lookup_table_eqI')
+  using assms apply (fastforce simp: obj_at_def)
+  using vspace_objs_of_aps_eq assms apply fastforce
+  using vspace_objs_of_pts_eq assms apply fastforce
+  using assms apply (fastforce simp: state_vrefs_def)
+  done
+
+end
+
+end
diff --git a/proof/access-control/AARCH64/ArchArch_AC.thy b/proof/access-control/AARCH64/ArchArch_AC.thy
new file mode 100644
index 0000000000..f2954fd9dc
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchArch_AC.thy
@@ -0,0 +1,2524 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchArch_AC
+imports Arch_AC
+begin
+
+text\<open>
+
+Arch-specific access control.
+
+\<close>
+
+context Arch begin global_naming AARCH64
+
+named_theorems Arch_AC_assms
+
+lemma set_mrs_state_vrefs[Arch_AC_assms, wp]:
+  "\<lbrace>(\<lambda>s. P (state_vrefs s))\<rbrace>
+   set_mrs thread buf msgs
+   \<lbrace>\<lambda>_ s. P (state_vrefs s)\<rbrace>"
+  apply (simp add: set_mrs_def split_def set_object_def get_object_def split del: if_split)
+  apply (wpsimp wp: gets_the_wp get_wp put_wp mapM_x_wp'
+              simp: zipWithM_x_mapM_x split_def store_word_offs_def
+         split_del: if_split)
+  apply (subst (asm) state_vrefs_tcb_upd[symmetric])
+   apply (auto simp: fun_upd_def get_tcb_def tcb_at_def)
+  done
+
+lemma mul_add_word_size_lt_msg_align_bits_ofnat[Arch_AC_assms]:
+  "\<lbrakk> p < 2 ^ (msg_align_bits - word_size_bits); k < word_size \<rbrakk>
+     \<Longrightarrow> of_nat p * of_nat word_size + k < (2 :: obj_ref) ^ msg_align_bits"
+  apply (rule is_aligned_add_less_t2n[where n=word_size_bits])
+     apply (simp_all add: msg_align_bits' word_size_word_size_bits is_aligned_mult_triv2)
+   apply (simp_all add: word_size_word_size_bits word_size_bits_def)
+  apply (erule word_less_power_trans_ofnat[where k=3 and m=10, simplified], simp)
+  done
+
+lemma zero_less_word_size[Arch_AC_assms, simp]:
+    "0 < (word_size :: obj_ref)"
+  by (simp add: word_size_def)
+
+end
+
+
+global_interpretation Arch_AC_1?: Arch_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Arch_AC_assms)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+definition level_of_table :: "obj_ref \<Rightarrow> 'z :: state_ext state \<Rightarrow> vm_level"
+  where
+  "level_of_table p s \<equiv>
+     GREATEST lvl. \<exists>asid vref. vref \<in> user_region \<and> vs_lookup_table lvl asid vref s = Some (lvl, p)"
+
+lemma level_of_table_vs_lookup_table:
+  "\<lbrakk> vs_lookup_table level asid vref s = Some (level, p);
+     ptes_of s pt_t p = Some pte; level \<le> max_pt_level; vref \<in> user_region; invs s \<rbrakk>
+     \<Longrightarrow> level_of_table p s = level"
+  apply (subst level_of_table_def)
+  apply (rule Greatest_equality, fastforce)
+  apply (case_tac "y = asid_pool_level")
+   apply (fastforce dest: vs_lookup_table_no_asid)
+  apply (fastforce dest: vs_lookup_table_unique_level)
+  done
+
+lemma vs_lookup_slot_level_of_slot:
+  "\<lbrakk> vs_lookup_slot level asid vref s = Some (level, p);
+     ptes_of s pt_t p = Some pte; level \<le> max_pt_level; vref \<in> user_region; invs s \<rbrakk>
+     \<Longrightarrow> level_of_slot asid vref p s = level"
+  apply (subst level_of_slot_def)
+  apply (rule Greatest_equality)
+   apply clarsimp
+  apply (case_tac "y = asid_pool_level")
+   apply (fastforce dest: vs_lookup_slot_no_asid)
+  apply (fastforce dest: vs_lookup_slot_unique_level)
+  done
+
+lemma pool_for_asid_vs_lookupD:
+  "pool_for_asid asid s = Some p \<Longrightarrow>
+   vs_lookup_table asid_pool_level asid vref s = Some (asid_pool_level, p)"
+  by (simp add: pool_for_asid_vs_lookup)
+
+lemma vs_lookup_table_vref_independent:
+  "\<lbrakk> vs_lookup_table level asid vref s = opt; level \<ge> max_pt_level \<rbrakk>
+     \<Longrightarrow> vs_lookup_table level asid vref' s = opt"
+  by (cases "level = asid_pool_level"; clarsimp simp: vs_lookup_table_def)
+
+lemma state_vrefs_store_NonPageTablePTE:
+  "\<lbrakk> invs s; is_aligned p pte_bits; vs_lookup_slot level asid vref s = Some (level, p);
+     vref \<in> user_region; \<not> is_PageTablePTE pte; pts_of s (table_base (pt_type pt) p) = Some pt \<rbrakk>
+     \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(table_base (pt_type pt) p \<mapsto>
+                                     ArchObj (PageTable (pt_upd pt (table_index (pt_type pt) p) pte))
+                                    )\<rparr>) =
+         (\<lambda>x. if \<exists>level' vref'. vref_for_level vref' (level + 1) = vref_for_level vref (level + 1) \<and>
+                                vref' \<in> user_region \<and> p = pt_slot_offset level (table_base (pt_type pt) p) vref' \<and>
+                                pt_walk level level' (table_base (pt_type pt) p) vref' (ptes_of s) = Some (level',x)
+              then (if x = table_base (pt_type pt) p
+                    then vs_refs_aux level (PageTable (pt_upd pt (table_index (pt_type pt) p) pte))
+                    else {})
+              else state_vrefs s x)"
+  apply (rule all_ext)
+  apply (case_tac "level = asid_pool_level")
+   apply (fastforce simp: vs_lookup_slot_def vs_lookup_table_def
+                          ptes_of_Some pts_of_Some aobjs_of_Some
+                    dest: pool_for_asid_no_pte)
+  apply (frule vs_lookup_slot_level_type)
+         apply (fastforce simp: ptes_of_Some pts_of_Some aobjs_of_Some)+
+  apply (prop_tac "ptes_of s (pt_type pt) p \<noteq> None")
+   apply (drule valid_vspace_objs_strong_slotD; clarsimp simp: ptes_of_Some pts_of_Some aobjs_of_Some)
+  apply (frule vs_lookup_slot_table_base; clarsimp split del: if_split)
+  apply (subst (asm) ptes_of_Some)
+  apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp split del: if_split)
+  apply safe
+   apply (subst (asm) state_vrefs_def)+
+   apply (clarsimp split: option.splits split del: if_split)
+   apply (subst (asm) vs_lookup_non_PageTablePTE[where s=s and s'="kheap_update _ s" and p=p])
+             apply ((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                             intro: ptes_of_pts_of_upd
+                              dest: pte_ptr_eq split: if_splits
+                    | clarsimp simp: opt_map_def fun_upd_def split: option.splits)+; fail)+
+
+   apply (frule pts_of_ptes_of; clarsimp)
+   apply (case_tac "x = table_base (pt_type pt) p"; clarsimp)
+    apply (case_tac "lvl = asid_pool_level")
+     apply (fastforce dest: vs_lookup_table_no_asid[OF vs_lookup_level, where pt_t="pt_type pt"]
+                      simp: ptes_of_Some pts_of_Some aobjs_of_Some split: if_splits)
+    apply (fastforce dest: vs_lookup_table_unique_level[OF vs_lookup_level]
+                     elim: allE[where x=level] split: if_splits)
+   apply (clarsimp split: if_splits)
+    apply (case_tac "level' = asid_pool_level")
+     apply (fastforce dest: vs_lookup_slot_no_asid simp: ptes_of_Some pts_of_Some aobjs_of_Some)
+    apply (frule vs_lookup_slot_level_of_slot)
+        apply (fastforce simp: ptes_of_Some pts_of_Some aobjs_of_Some split: option.splits)
+       apply fastforce+
+    apply (subst (asm) vs_lookup_slot_table_unfold)
+       apply fastforce+
+    apply clarsimp
+    apply (metis (no_types, lifting) vs_lookup_slot_table_unfold vs_lookup_slot_unique_level)
+   apply (rule conjI; clarsimp)
+    apply (case_tac "level' < level")
+     apply (subst (asm) vs_lookup_vref_for_level_eq1, rule sym, assumption)
+     apply (frule (2) vs_lookup_table_extend)
+     apply (case_tac "lvl = asid_pool_level")
+      apply (fastforce dest: vs_lookup_table_pt_at vs_lookup_asid_pool
+                       simp: asid_pools_of_ko_at obj_at_def)
+     apply (frule_tac level=lvl in vs_lookup_level)
+     apply (drule (1) vs_lookup_table_unique_level, rule refl)
+          apply fastforce+
+     apply (frule bit1.plus_one_leq)
+     apply (erule_tac x=level in allE)
+     apply (subst (asm) vs_lookup_slot_vref_for_level[symmetric], assumption)
+     apply (frule_tac bot_level=bot in vs_lookup_min_level)
+     apply (fastforce simp: vs_lookup_slot_vref_for_level vs_lookup_slot_table_unfold)
+    apply (subst (asm) pt_walk.simps, clarsimp)
+   apply (fastforce simp: state_vrefs_def opt_map_def)
+  apply (prop_tac "level_of_slot asid vref p s = level")
+   apply (fastforce simp: vs_lookup_slot_table_unfold  ptes_of_Some intro: vs_lookup_slot_level_of_slot)
+  apply (clarsimp split: if_splits)
+   apply (rule state_vrefsD)
+      apply (subst vs_lookup_non_PageTablePTE[where s=s and p=p and pte=pte])
+                apply ((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                                 intro: ptes_of_pts_of_upd
+                                  dest: pte_ptr_eq split: if_splits
+                        | clarsimp simp: opt_map_def fun_upd_def split: option.splits)+; fail)+
+  apply (case_tac "x = table_base (pt_type pt) p")
+   apply (fastforce elim: allE[where x=level])
+  apply (subst (asm) state_vrefs_def, clarsimp)
+  apply (rule_tac level=lvl and asid=asida and vref=vrefa in state_vrefsD)
+     apply (subst vs_lookup_non_PageTablePTE[where s=s and p=p and pte=pte])
+               apply ((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                                intro: ptes_of_pts_of_upd
+                                 dest: pte_ptr_eq split: if_splits
+                       | clarsimp simp: opt_map_def fun_upd_def split: option.splits)+; fail)+
+     apply (clarsimp split: if_splits)
+     apply (intro conjI; clarsimp)
+      apply (case_tac "level' = asid_pool_level")
+       apply (fastforce dest: vs_lookup_slot_no_asid simp: ptes_of_Some pts_of_Some aobjs_of_Some)
+      apply (case_tac "lvl < level")
+       apply (drule_tac bot_level=bot in vs_lookup_level)
+       apply (subst (asm) vs_lookup_split_Some, erule dual_order.strict_implies_order)
+        apply fastforce
+       apply (frule vs_lookup_slot_level_type)
+              apply (fastforce simp: ptes_of_Some pts_of_Some aobjs_of_Some)+
+       apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+       apply (drule (1) vs_lookup_table_unique_level; fastforce)
+      apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+      apply (metis vs_lookup_slot_table vs_lookup_slot_unique_level)
+     apply (fastforce dest: vs_lookup_level)
+    apply (fastforce simp: aobjs_of_Some opt_map_def)
+   apply clarsimp
+  apply clarsimp
+  done
+
+
+lemma state_vrefs_store_NonPageTablePTE':
+  "\<lbrakk> invs s; is_aligned p pte_bits; \<not> is_PageTablePTE pte;
+     pts_of s (table_base (pt_type pt) p) = Some pt;
+     \<forall>level asid vref. vref \<in> user_region \<longrightarrow> vs_lookup_slot level asid vref s \<noteq> Some (level, p) \<rbrakk>
+     \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(table_base (pt_type pt) p \<mapsto>
+                                     ArchObj (PageTable (pt_upd pt (table_index (pt_type pt) p) pte))
+                                    )\<rparr>) =
+         (\<lambda>x. if x = table_base (pt_type pt) p \<and> (\<exists>level. \<exists>\<rhd> (level, table_base (pt_type pt) p) s)
+              then vs_refs_aux (level_of_table (table_base (pt_type pt) p) s)
+                               (PageTable (pt_upd pt (table_index (pt_type pt) p) pte))
+              else state_vrefs s x)"
+  apply (rule all_ext)
+
+  apply safe
+   apply (frule pts_of_ptes_of; clarsimp)
+   apply (subst (asm) state_vrefs_def)+
+   apply (clarsimp split: option.splits split del: if_split)
+   apply (clarsimp split: if_split_asm option.splits split del: if_split)
+    apply (subst (asm) vs_lookup_non_PageTablePTE[where s=s and p=p and pte=pte])
+              apply ((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                              intro: ptes_of_pts_of_upd
+                               dest: pte_ptr_eq split: if_splits
+                     | clarsimp simp: opt_map_def fun_upd_def split: option.splits)+; fail)+
+    apply (clarsimp split: if_splits)
+    apply (drule vs_lookup_level)
+    apply (rule conjI; clarsimp)
+    apply (case_tac "level = asid_pool_level")
+     apply (clarsimp simp: ptes_of_Some pts_of_Some)
+     apply (fastforce dest: vs_lookup_table_pt_at vs_lookup_asid_pool
+                      simp: asid_pools_of_ko_at obj_at_def opt_map_def)
+    apply (case_tac "lvl = asid_pool_level")
+      apply (fastforce dest: vs_lookup_table_pt_at vs_lookup_asid_pool
+                       simp: asid_pools_of_ko_at obj_at_def)
+    apply (subst level_of_table_vs_lookup_table[where pt_t="pt_type pt"]; fastforce)
+   apply (subst (asm) vs_lookup_non_PageTablePTE[where s=s and p=p and pte=pte])
+             apply ((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                                           intro: ptes_of_pts_of_upd
+                                            dest: pte_ptr_eq split: if_splits
+                                  | clarsimp simp: opt_map_def fun_upd_def split: option.splits)+; fail)+
+   apply (fastforce simp: state_vrefs_def aobjs_of_Some)
+  apply (clarsimp split: if_splits)
+   apply (case_tac "level = asid_pool_level")
+     apply (clarsimp simp: ptes_of_Some pts_of_Some)
+     apply (fastforce dest: vs_lookup_table_pt_at vs_lookup_asid_pool
+                      simp: asid_pools_of_ko_at obj_at_def opt_map_def)
+   apply (subst (asm) level_of_table_vs_lookup_table[where pt_t="pt_type pt"])
+        apply (fastforce simp: ptes_of_Some pts_of_Some aobjs_of_Some)+
+   apply (rule state_vrefsD)
+      apply (subst vs_lookup_non_PageTablePTE[where s=s and p=p and pte=pte ])
+                apply ((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                                                          intro: ptes_of_pts_of_upd
+                                                           dest: pte_ptr_eq split: if_splits
+                                                 | clarsimp simp: opt_map_def fun_upd_def split: option.splits)+; fail)+
+  apply (case_tac "x = table_base (pt_type pt) p")
+   apply (fastforce dest: vs_lookup_level simp: state_vrefs_def)
+  apply (subst (asm) state_vrefs_def, clarsimp)
+  apply (rule state_vrefsD)
+     apply (subst vs_lookup_non_PageTablePTE[where s=s and p=p and pte=pte ])
+               apply ((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                                                                        intro: ptes_of_pts_of_upd
+                                                                         dest: pte_ptr_eq split: if_splits
+                                                               | clarsimp simp: opt_map_def fun_upd_def split: option.splits)+; fail)+
+  done
+
+(* FIXME AC: make this less ugly *)
+lemma state_vrefs_store_NonPageTablePTE_wp:
+  "\<lbrace>\<lambda>s. invs s \<and> \<not> is_PageTablePTE pte \<and>
+        (\<forall>pt. pts_of s (table_base pt_t p) = Some pt \<and> pt_t = pt_type pt \<and> is_aligned p pte_bits \<longrightarrow>
+              (if \<exists>level asid vref. vs_lookup_slot level asid vref s = Some (level, p) \<and> vref \<in> user_region
+               then (\<exists>level asid vref. vs_lookup_slot level asid vref s = Some (level, p) \<and> vref \<in> user_region \<and>
+                                       P (\<lambda>x. (if \<exists>level' vref'. vref_for_level vref' (level + 1) = vref_for_level vref (level + 1) \<and>
+                                                                 vref' \<in> user_region \<and> p = pt_slot_offset level (table_base pt_t p) vref' \<and>
+                                                                 pt_walk level level' (table_base pt_t p) vref' (ptes_of s) = Some (level', x)
+                                               then (if x = table_base pt_t p
+                                                     then vs_refs_aux level (PageTable (pt_upd pt (table_index pt_t p) pte))
+                                                     else {})
+                                               else state_vrefs s x)))
+               else P (\<lambda>x. (if x = table_base pt_t p \<and> (\<exists>level. \<exists>\<rhd> (level, table_base pt_t p) s)
+                            then vs_refs_aux (level_of_table (table_base pt_t p) s) (PageTable (pt_upd pt (table_index pt_t p) pte))
+                            else state_vrefs s x))))\<rbrace>
+   store_pte pt_t p pte
+   \<lbrace>\<lambda>_ s. P (state_vrefs s)\<rbrace>"
+  unfolding store_pte_def set_pt_def
+  apply (wpsimp wp: set_object_wp)
+  apply (case_tac "\<exists>level asid vref. vs_lookup_slot level asid vref s = Some (level, p) \<and>
+                                     vref \<in> user_region")
+   apply clarsimp
+   apply (erule_tac x=pt in allE)
+   apply (subst state_vrefs_store_NonPageTablePTE)
+         apply fastforce+
+    apply (clarsimp simp: obj_at_def pts_of_Some aobjs_of_Some)
+   apply (case_tac "level = asid_pool_level")
+    apply (fastforce dest: vs_lookup_slot_no_asid
+                     simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)
+   apply (clarsimp simp: pts_of_Some aobjs_of_Some obj_at_def)
+   apply (case_tac "levela = asid_pool_level")
+    apply (fastforce dest: vs_lookup_slot_no_asid
+                     simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)
+   apply (drule (1) vs_lookup_slot_unique_level)
+         apply fastforce+
+   apply clarsimp
+   apply (frule_tac level'="level+1" in vref_for_level_eq_mono)
+    apply (fastforce intro: vm_level_less_le_1)
+   apply clarsimp
+  apply (erule_tac x=pt in allE)
+  apply (subst state_vrefs_store_NonPageTablePTE'; fastforce simp: obj_at_def aobjs_of_Some pts_of_Some)
+  done
+
+lemma store_pte_thread_st_auth[wp]:
+  "store_pte pt_t p pte \<lbrace>\<lambda>s. P (thread_st_auth s)\<rbrace>"
+  unfolding store_pte_def set_pt_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: get_tcb_def thread_st_auth_def tcb_states_of_state_def obj_at_def
+                 elim!: rsubst[where P=P, OF _ ext])
+  done
+
+lemma store_pte_thread_bound_ntfns[wp]:
+  "store_pte pt_t p pte \<lbrace>\<lambda>s. P (thread_bound_ntfns s)\<rbrace>"
+  unfolding store_pte_def set_pt_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: get_tcb_def thread_bound_ntfns_def  obj_at_def
+                 elim!: rsubst[where P=P, OF _ ext])
+  done
+
+lemma store_pte_domains_of_state[wp]:
+  "store_pte pt_t p pte \<lbrace>\<lambda>s. P (domains_of_state s)\<rbrace>"
+  unfolding store_pte_def set_pt_def by (wpsimp wp: set_object_wp)
+
+lemma mapM_x_store_pte_caps_of_state[wp]:
+  "mapM_x (swp (store_pte pt_t) InvalidPTE) slots \<lbrace>\<lambda>s. P (asid_table s)\<rbrace>"
+  by (wpsimp wp: mapM_x_wp')
+
+lemma state_bits_to_policy_vrefs_subseteq:
+  "\<And>cdt. \<lbrakk> x \<in> state_bits_to_policy caps ts tbn cdt vrefs; caps = caps';
+           ts = ts'; tbn = tbn'; cdt = cdt'; \<forall>x. vrefs x \<subseteq> state_vrefs s x \<rbrakk>
+           \<Longrightarrow> x \<in> state_bits_to_policy caps'  ts' tbn' cdt' (state_vrefs s)"
+  apply (cases x; clarsimp)
+  apply (erule state_bits_to_policy.cases; fastforce intro: state_bits_to_policy.intros)
+  done
+
+lemma state_asids_to_policy_vrefs_subseteq:
+  "\<lbrakk> x \<in> state_asids_to_policy_aux aag caps asid_tab vrefs; caps = caps';
+     \<forall>x. vrefs x \<subseteq> state_vrefs s x; \<forall>x y. asid_tab x = Some y \<longrightarrow> asid_table s x = Some y \<rbrakk>
+     \<Longrightarrow> x \<in> state_asids_to_policy_aux aag caps' (asid_table s) (state_vrefs s)"
+  apply (cases x; clarsimp)
+  apply (erule state_asids_to_policy_aux.cases; fastforce intro: state_asids_to_policy_aux.intros)
+  done
+
+lemma vs_lookup_table_subseteq:
+    "\<lbrakk> vs_lookup_table bot_level asid vref s' = Some (lvl,ptr);
+       \<forall>pptr. pool_for_asid asid s' = Some pptr \<longrightarrow> pool_for_asid asid s = Some pptr;
+       \<forall>pptr vref. vspace_for_pool pptr asid (asid_pools_of s') = Some vref
+               \<longrightarrow> vspace_for_pool pptr asid (asid_pools_of s) = Some vref;
+       ptes_of s' = ptes_of s \<rbrakk>
+   \<Longrightarrow> vs_lookup_table bot_level asid vref s = Some (lvl,ptr)"
+   by (auto simp: vs_lookup_table_def in_obind_eq split: if_splits)
+
+lemma vs_refs_aux_subseteq:
+  assumes "\<forall>asid vref. vspace_for_pool 0 asid (K (asid_pool_of ao')) = Some vref
+                   \<longrightarrow> vspace_for_pool 0 asid (K (asid_pool_of ao)) = Some vref"
+  and "\<forall>idx vref. option_map (swp pt_apply idx) (pt_of ao') = Some vref
+              \<longrightarrow> option_map (swp pt_apply idx) (pt_of ao) = Some vref"
+  and "aa_type ao' = aa_type ao"
+  shows "vs_refs_aux lvl ao' \<subseteq> vs_refs_aux lvl ao"
+  apply (insert assms)
+  apply (case_tac ao'; case_tac ao;
+         clarsimp simp: vs_refs_aux_def graph_of_def image_iff pt_type_def
+                 split: pt.splits if_splits)
+    apply (erule_tac x="ucast ac" in allE)
+    apply (fastforce simp: asid_low_bits_of_def vspace_for_pool_def
+                           entry_for_pool_def in_obind_eq ucast_ucast_id)
+   apply (erule_tac x="ucast ac" in allE)
+   apply (intro exI conjI; fastforce simp: ucast_ucast_id vs_index_bits_def)
+  apply (erule_tac x="ucast ac" in allE)
+  apply (intro exI conjI; fastforce simp: ucast_ucast_id vs_index_bits_def)
+  done
+
+lemma state_vrefs_subseteq:
+  assumes "typs_of s' x = typs_of s x"
+    and "pts_of s' = pts_of s"
+    and "\<forall>pptr asid. pool_for_asid asid s' = Some pptr \<longrightarrow> pool_for_asid asid s = Some pptr"
+    and "\<forall>pptr asid vref. vspace_for_pool pptr asid (asid_pools_of s') = Some vref
+               \<longrightarrow> vspace_for_pool pptr asid (asid_pools_of s) = Some vref"
+  shows "state_vrefs s' x \<subseteq> state_vrefs s x"
+  apply (subst state_vrefs_def)
+  using assms(1) apply clarsimp
+  apply (case_tac "vspace_objs_of s x")
+   apply (fastforce simp: opt_map_def a_type_def
+                   split: option.splits arch_kernel_obj.splits kernel_object.splits if_splits)[1]
+  apply (prop_tac "vs_refs_aux lvl ao \<subseteq> vs_refs_aux lvl ac")
+   apply (rule vs_refs_aux_subseteq)
+     using assms(4)
+     apply (fastforce simp: opt_map_def aa_type_def vspace_for_pool_def entry_for_pool_def obind_def
+                     split: option.splits arch_kernel_obj.splits)
+    using assms(2)
+    apply (clarsimp simp: in_opt_map_eq fun_eq_iff)
+    apply (erule_tac x=x in allE)
+    apply (fastforce simp: opt_map_def aa_type_def split: if_splits arch_kernel_obj.splits)
+   apply (fastforce simp: opt_map_def aa_type_def
+                   split: option.splits arch_kernel_obj.splits)
+  apply (rule_tac state_vrefsD)
+     apply (erule vs_lookup_table_subseteq)
+  using assms by fastforce+
+
+lemma pas_refined_subseteq:
+  "\<lbrakk> pas_refined aag s; caps_of_state s' = caps_of_state s;
+     \<forall>x y. asid_table s' x = Some y \<longrightarrow> asid_table s x = Some y;
+     \<forall>x. state_vrefs s' x \<subseteq> state_vrefs s x; interrupt_irq_node s' = interrupt_irq_node s;
+     domains_of_state s' = domains_of_state s; thread_st_auth s' = thread_st_auth s;
+     thread_bound_ntfns s' = thread_bound_ntfns s;  cdt s' = cdt s \<rbrakk>
+     \<Longrightarrow> pas_refined aag s'"
+  apply (auto simp: pas_refined_def)
+   apply (clarsimp simp: state_objs_to_policy_def)
+   apply (erule subsetD)
+   apply (clarsimp simp: auth_graph_map_def)
+   apply (rule exI, rule conjI, rule refl)+
+   apply (erule state_bits_to_policy_vrefs_subseteq; clarsimp)
+  apply (erule subsetD, rule state_asids_to_policy_vrefs_subseteq, auto)
+  done
+
+lemma store_InvalidPTE_state_objs_in_policy:
+  "\<lbrace>\<lambda>s. state_objs_in_policy aag s \<and> invs s\<rbrace>
+   store_pte pt_t p InvalidPTE
+   \<lbrace>\<lambda>_ s. state_objs_in_policy aag s\<rbrace>"
+  apply (rule hoare_weaken_pre)
+   apply (clarsimp simp: state_objs_to_policy_def pred_conj_def)
+   apply wps
+   apply (rule state_vrefs_store_NonPageTablePTE_wp)
+  apply (intro conjI; fastforce?)
+  apply (intro allI impI)
+  apply clarsimp
+  apply (rule conjI; clarsimp)
+   apply (intro exI conjI)
+     apply assumption
+    apply clarsimp
+   apply (clarsimp simp: state_objs_to_policy_def)
+   apply (erule subsetD)
+   apply (clarsimp simp: auth_graph_map_def)
+   apply (rule exI, rule conjI, rule refl)+
+   apply (erule state_bits_to_policy_vrefs_subseteq; clarsimp)
+   apply (case_tac "level = asid_pool_level")
+    apply (fastforce dest: vs_lookup_slot_no_asid
+                     simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)
+   apply (frule vs_lookup_slot_level_type)
+          apply (fastforce simp: ptes_of_Some)+
+   apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+   apply (erule state_vrefsD)
+     apply (fastforce simp: pts_of_Some vspace_objs_of_Some obj_at_def)
+    apply clarsimp
+   apply (fastforce simp: vs_refs_aux_def graph_of_def pte_ref2_def split: if_splits pt.splits)
+  apply (clarsimp simp: state_objs_to_policy_def)
+  apply (erule subsetD)
+  apply (clarsimp simp: auth_graph_map_def)
+  apply (rule exI, rule conjI, rule refl)+
+  apply (erule state_bits_to_policy_vrefs_subseteq; clarsimp)
+  apply (case_tac "level = asid_pool_level")
+   apply (fastforce dest: vs_lookup_table_no_asid[where pt_t=pt_t]
+                    simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)
+  apply (frule level_of_table_vs_lookup_table[where pt_t=pt_t])
+      apply (fastforce dest: vs_lookup_slot_no_asid[where pt_t=pt_t]
+                       simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)+
+  apply (erule state_vrefsD)
+    apply (fastforce simp: pts_of_Some vspace_objs_of_Some obj_at_def)
+   apply clarsimp
+   apply (auto simp: vs_refs_aux_def graph_of_def pte_ref2_def split: if_splits pt.splits)
+   apply fastforce
+  apply fastforce
+  done
+
+lemma store_InvalidPTE_state_asids_to_policy:
+  "\<lbrace>\<lambda>s. state_asids_to_policy aag s \<subseteq> pasPolicy aag \<and> invs s\<rbrace>
+   store_pte pt_t p InvalidPTE
+   \<lbrace>\<lambda>_ s. state_asids_to_policy aag s \<subseteq> pasPolicy aag\<rbrace>"
+  apply (rule hoare_weaken_pre)
+   apply (clarsimp simp: state_objs_to_policy_def pred_conj_def)
+   apply wps
+   apply (rule state_vrefs_store_NonPageTablePTE_wp)
+  apply clarsimp
+  apply (rule conjI; clarsimp)
+   apply (intro exI conjI)
+     apply assumption
+    apply clarsimp
+   apply clarsimp
+   apply (erule subsetD)
+   apply (erule state_asids_to_policy_vrefs_subseteq; clarsimp)
+   apply (case_tac "level = asid_pool_level")
+    apply (fastforce dest: vs_lookup_slot_no_asid
+                     simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)
+   apply (frule vs_lookup_slot_level_type)
+          apply (fastforce simp: ptes_of_Some)+
+   apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+   apply (erule state_vrefsD)
+     apply (fastforce simp: pts_of_Some vspace_objs_of_Some obj_at_def)
+    apply clarsimp
+   apply (fastforce simp: vs_refs_aux_def graph_of_def pte_ref2_def split: if_splits pt.splits)
+  apply (erule subsetD)
+  apply (erule state_asids_to_policy_vrefs_subseteq; clarsimp)
+  apply (case_tac "level = asid_pool_level")
+   apply (fastforce dest: vs_lookup_table_no_asid[where pt_t=pt_t]
+                    simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)
+  apply (frule level_of_table_vs_lookup_table[where pt_t=pt_t])
+      apply (fastforce dest: vs_lookup_slot_no_asid
+                       simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)+
+  apply (erule state_vrefsD)
+    apply (fastforce simp: pts_of_Some vspace_objs_of_Some obj_at_def)
+   apply clarsimp
+  apply (auto simp: vs_refs_aux_def graph_of_def pte_ref2_def split: if_splits pt.splits)
+   apply fastforce
+  apply fastforce
+  done
+
+lemma mapM_x_swp_store_InvalidPTE_pas_refined:
+  "\<lbrace>pas_refined aag and invs and
+    (\<lambda>s. \<forall>x \<in> set slots. table_base pt_t x \<notin> global_refs s \<and>
+                         (\<forall>asid. vspace_for_asid asid s \<noteq> Some (table_base pt_t x)))\<rbrace>
+   mapM_x (swp (store_pte pt_t) InvalidPTE) slots
+   \<lbrace>\<lambda>_ s. pas_refined aag s\<rbrace>"
+  supply state_asids_to_policy_arch_def[simp del]
+  apply (rule hoare_strengthen_post)
+   apply (rule mapM_x_wp[where S="set slots"])
+    apply (simp add: pas_refined_def)
+    apply (wpsimp wp: store_InvalidPTE_state_objs_in_policy store_InvalidPTE_state_asids_to_policy
+                      store_pte_invs hoare_vcg_const_Ball_lift hoare_vcg_all_lift)
+    apply (auto simp: wellformed_pte_def)
+  done
+
+lemma mapM_swp_store_pte_invs_unmap:
+  "\<lbrace>\<lambda>s. invs s \<and> pte = InvalidPTE \<and> table_base pt_t p \<notin> global_refs s
+               \<and> (\<forall>asid. vspace_for_asid asid s \<noteq> Some (table_base pt_t p))\<rbrace>
+   store_pte pt_t p pte
+   \<lbrace>\<lambda>_. invs\<rbrace>"
+  by (wpsimp wp: store_pte_invs simp: wellformed_pte_def)
+
+lemma store_pte_pas_refined:
+  "\<lbrace>\<lambda>s. pas_refined aag s \<and> invs s \<and> table_base pt_t p \<notin> global_refs s \<and>
+        (\<exists>slot pt_t ref. caps_of_state s slot = Some (ArchObjectCap (PageTableCap (table_base pt_t p) pt_t ref)))\<rbrace>
+   store_pte pt_t p InvalidPTE
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  supply state_asids_to_policy_arch_def[simp del]
+  apply (clarsimp simp: pas_refined_def)
+  apply (wpsimp wp: store_InvalidPTE_state_objs_in_policy store_InvalidPTE_state_asids_to_policy)
+  done
+
+crunch invalidate_tlb_by_asid
+  for pas_refined[wp]: "pas_refined aag"
+
+lemma unmap_page_table_pas_refined:
+ "\<lbrace>pas_refined aag and invs and K (vaddr \<in> user_region)\<rbrace>
+  unmap_page_table asid vaddr pt
+  \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding unmap_page_table_def
+  apply (rule hoare_gen_asm)
+  apply (wpsimp wp: set_cap_pas_refined get_cap_wp pt_lookup_from_level_wrp store_pte_invs_unmap
+                    store_pte_pas_refined hoare_vcg_imp_lift' hoare_vcg_ball_lift hoare_vcg_all_lift)
+  apply (rule_tac x=asid in exI)
+  apply clarsimp
+  apply (case_tac "level = asid_pool_level")
+   apply (fastforce dest: vs_lookup_slot_no_asid)
+  apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+  apply (intro conjI)
+    apply (clarsimp simp: reachable_page_table_not_global)
+   apply (frule vs_lookup_table_pt_at; clarsimp?)
+   apply (drule vs_lookup_table_valid_cap; clarsimp?)
+   apply (fastforce simp: valid_cap_def valid_arch_cap_def valid_arch_cap_ref_def obj_at_def
+                    dest: caps_of_state_valid split: cap.splits arch_cap.splits)
+  done
+
+crunch unmap_page_table
+  for cdt[wp]: "\<lambda>s. P (cdt s)"
+
+definition authorised_page_table_inv :: "'a PAS \<Rightarrow> page_table_invocation \<Rightarrow> bool" where
+  "authorised_page_table_inv aag pti \<equiv>
+   case pti of PageTableMap cap cslot pte slot level \<Rightarrow>
+                 is_subject aag (fst cslot) \<and> is_subject aag (table_base (level_type level) slot) \<and>
+                 pas_cap_cur_auth aag (ArchObjectCap cap)
+             | PageTableUnmap cap cslot \<Rightarrow>
+                 is_subject aag (fst cslot) \<and>
+                 aag_cap_auth aag (pasSubject aag) (ArchObjectCap cap) \<and>
+                 (\<forall>p pt_t asid vspace_ref. cap = PageTableCap p pt_t (Some (asid, vspace_ref))
+                                      \<longrightarrow> is_subject_asid aag asid \<and>
+                                          (\<forall>x \<in> set [p, p + 2 ^ pte_bits .e. p + 2 ^ (pt_bits pt_t) - 1].
+                                                             is_subject aag (table_base pt_t x)))"
+
+lemma perform_pt_inv_unmap_pas_refined:
+ "\<lbrace>pas_refined aag and invs and valid_pti (PageTableUnmap cap ct_slot)
+                            and K (authorised_page_table_inv aag (PageTableUnmap cap ct_slot))\<rbrace>
+  perform_pt_inv_unmap cap ct_slot
+  \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding perform_pt_inv_unmap_def
+  apply (wpsimp wp: set_cap_pas_refined get_cap_wp)
+        apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift)
+       apply wps
+       apply (rule hoare_vcg_all_lift[OF hoare_vcg_imp_lift'[OF mapM_x_wp_inv]], wpsimp wp: mapM_x_wp_inv)
+       apply (rule hoare_vcg_conj_lift[OF hoare_strengthen_post[OF mapM_x_swp_store_InvalidPTE_pas_refined]], assumption)
+       apply (wpsimp wp: pt_lookup_from_level_wrp store_pte_invs_unmap store_pte_pas_refined
+                         mapM_x_wp_inv unmap_page_table_pas_refined
+                         hoare_vcg_imp_lift' hoare_vcg_ball_lift hoare_vcg_all_lift)+
+  apply (rule conjI)
+   apply (fastforce simp: is_PageTableCap_def authorised_page_table_inv_def
+                          valid_pti_def update_map_data_def cte_wp_at_caps_of_state)
+  apply (clarsimp simp: is_PageTableCap_def authorised_page_table_inv_def valid_arch_cap_def
+                        valid_pti_def cte_wp_at_caps_of_state update_map_data_def aag_cap_auth_def
+                        cap_auth_conferred_def arch_cap_auth_conferred_def wellformed_mapdata_def
+                        cap_links_asid_slot_def cap_links_irq_def is_transferable.simps)
+  apply (prop_tac "table_base NormalPT_T x = acap_obj cap")
+   apply (drule (1) caps_of_state_aligned_page_table)
+   apply (simp only: is_aligned_neg_mask_eq')
+   apply (clarsimp simp: add_mask_fold)
+   apply (drule subsetD[OF upto_enum_step_subset], clarsimp)
+   apply (drule neg_mask_mono_le[where n="pt_bits NormalPT_T"])
+   apply (drule neg_mask_mono_le[where n="pt_bits NormalPT_T"])
+   apply (fastforce dest: plus_mask_AND_NOT_mask_eq)
+  apply (rule conjI; clarsimp)
+   apply (fastforce simp: cte_wp_at_caps_of_state cap_range_def
+                    dest: invs_valid_global_refs valid_global_refsD)
+  apply (frule vspace_for_asid_target)
+  apply (drule valid_vs_lookupD; clarsimp)
+  apply (drule (1) unique_table_refsD[rotated]; clarsimp)
+  apply (clarsimp simp: obj_at_def)
+  apply (drule (1) cap_to_pt_is_pt_cap_and_type)
+    apply (fastforce simp: in_omonad obj_at_def)
+   apply (fastforce intro: valid_objs_caps)
+  apply (clarsimp simp: is_cap_simps)
+  done
+
+(* FIXME AARCH64: move *)
+lemma fun_upd2_apply:
+  "(f (x, y := z)) a b = (if a = x \<and> b = y then z else f a b)"
+  by (clarsimp simp: fun_upd2_def)
+
+lemma vs_lookup_PageTablePTE:
+  "\<lbrakk> vs_lookup_table level asid vref s' = Some (lvl', pt);
+     pspace_aligned s; valid_vspace_objs s; valid_asid_table s;
+     invalid_pte_at pt_t p s; ptes_of s' = (ptes_of s)(pt_t,p \<mapsto> pte); is_PageTablePTE pte;
+     asid_pools_of s' = asid_pools_of s; asid_table s' = asid_table s;
+     vref \<in> user_region;
+     pts_of s (the (pte_ref pte)) = Some (empty_pt NormalPT_T); pt \<noteq> pptr_from_pte pte \<rbrakk>
+     \<Longrightarrow> \<exists>level' \<ge> level. vs_lookup_table level' asid vref s = Some (lvl', pt)"
+  apply (induct level arbitrary: lvl' pt rule: bit1.from_top_full_induct[where y=max_pt_level])
+   apply (fastforce simp: geq_max_pt_level vs_lookup_table_def pool_for_asid_def obind_def)
+  apply (rule_tac x=lvl' in exI)
+  apply (frule vs_lookup_min_level, clarsimp)
+  apply (drule vs_lookup_level)
+  apply (case_tac "lvl' < max_pt_level")
+   apply (frule vs_lookup_table_split_last_Some; clarsimp)
+   apply (erule_tac x="lvl'+1" in allE)
+   apply (drule mp)
+    apply (fastforce elim: le_less_trans dest: vm_level_less_plus_1_mono)
+   apply (erule_tac x="lvl'+1" in allE)
+   apply clarsimp
+   apply (frule (1) subst[where P="\<lambda>ptes. _ ptes = (_ :: pte option)"])
+   apply (clarsimp simp: fun_upd2_apply split: if_splits)
+   apply (cases pte; clarsimp)
+   apply (drule mp)
+    apply clarsimp
+    apply (case_tac "(lvl' + 1) + 1 \<le> max_pt_level")
+     apply (fastforce simp: add_ac ptes_of_Some dest!: pptr_from_pte_aligned_pt_bits[where pte=pte])
+    apply (prop_tac "is_aligned (pptr_from_pte pte) (pt_bits (level_type (lvl' + 1)))")
+     apply (fastforce simp: geq_max_pt_level plus_one_eq_asid_pool max_pt_level_plus_one[symmetric]
+                            vs_lookup_max_pt_level_eq[where s=s and s'=s'] less_imp_neq not_le add_ac
+                      dest: vs_lookup_table_is_aligned[where pt_ptr="pptr_from_pte (PageTablePTE _)"])
+    apply (clarsimp simp: ptes_of_Some)
+   apply (cases pte; clarsimp)
+   apply (drule_tac bot_level=level' in vs_lookup_level)
+   apply (subst vs_lookup_split_Some)
+     prefer 3
+     apply (rule exI, rule conjI, assumption)
+     apply (frule_tac P="\<lambda>x. x" and level1=lvl' and level'1="lvl'+1"
+                   in subst[OF vs_lookup_split_Some, rotated 2])
+       apply (fastforce dest: vm_level_less_le_1)
+      apply (fastforce dest: vm_level_less_max_pt_level vm_level_less_plus_1_mono)
+     apply clarsimp
+     apply (subst (asm) pt_walk.simps)
+     apply (clarsimp simp: obind_def)
+     apply (subst pt_walk.simps)
+     apply (clarsimp split: if_splits option.splits simp: obind_def)
+    apply (fastforce dest: vm_level_less_le_1)
+   apply (fastforce dest: vm_level_less_max_pt_level vm_level_less_plus_1_mono)
+  apply (case_tac "lvl' = asid_pool_level")
+   apply (auto simp: geq_max_pt_level vs_lookup_table_def pool_for_asid_def obind_def)
+  done
+
+lemma vs_lookup_PageTablePTE':
+  "\<lbrakk> vs_lookup_table level asid vref s = Some (lvl', pt);
+     pspace_aligned s; valid_vspace_objs s; valid_asid_table s;
+     invalid_pte_at pt_t p s; ptes_of s' = (ptes_of s)(pt_t, p \<mapsto> pte); is_PageTablePTE pte;
+     asid_pools_of s' = asid_pools_of s; asid_table s' = asid_table s; vref \<in> user_region  \<rbrakk>
+     \<Longrightarrow> \<exists>level' \<ge> level. vs_lookup_table level' asid vref s' = Some (lvl', pt)"
+  apply (induct level arbitrary: lvl' pt rule: bit1.from_top_full_induct[where y=max_pt_level])
+   apply (fastforce simp: geq_max_pt_level vs_lookup_table_def pool_for_asid_def obind_def)
+  apply (rule_tac x=lvl' in exI)
+  apply (frule vs_lookup_min_level, clarsimp)
+  apply (drule vs_lookup_level)
+  apply (case_tac "lvl' < max_pt_level")
+   apply (frule vs_lookup_table_split_last_Some; clarsimp)
+   apply (erule_tac x="lvl'+1" in allE)
+   apply (drule mp)
+    apply (fastforce elim: le_less_trans dest: vm_level_less_plus_1_mono)
+   apply (erule_tac x="lvl'+1" in allE)
+   apply clarsimp
+   apply (drule_tac bot_level=level' in vs_lookup_level)
+   apply (subst vs_lookup_split_Some)
+     prefer 3
+     apply (rule exI, rule conjI, assumption)
+     apply (frule_tac P="\<lambda>x. x" and level1=lvl' and level'1="lvl'+1"
+                   in subst[OF vs_lookup_split_Some, rotated 2])
+       apply (fastforce dest: vm_level_less_le_1)
+      apply (fastforce dest: vm_level_less_max_pt_level vm_level_less_plus_1_mono)
+     apply clarsimp
+     apply (subst (asm) pt_walk.simps)
+     apply (clarsimp simp: obind_def split: if_splits)
+     apply (subst pt_walk.simps)
+     apply (clarsimp simp: obind_def split: if_splits)
+     apply (cases pte; clarsimp)
+     apply (frule is_aligned_pt[rotated])
+      apply (erule vs_lookup_table_pt_at; fastforce)
+     apply (clarsimp split: option.splits)
+     apply (rule context_conjI)
+      apply (clarsimp simp: fun_upd2_def)
+     apply clarsimp
+      apply (clarsimp simp: fun_upd2_def split: if_splits)
+     apply (clarsimp simp: invalid_pte_at_def ptes_of_Some pts_of_Some aobjs_of_Some)
+    apply (fastforce dest: vm_level_less_le_1)
+   apply (fastforce dest: vm_level_less_max_pt_level vm_level_less_plus_1_mono)
+  apply (case_tac "lvl' = asid_pool_level")
+   apply (auto simp: geq_max_pt_level vs_lookup_table_def pool_for_asid_def obind_def)
+  done
+
+lemma state_vrefs_store_PageTablePTE:
+  assumes "invs s"
+  and "is_aligned p pte_bits"
+  and "vs_lookup_slot level asid vref s = Some (level, p)"
+  and "vref \<in> user_region"
+  and "is_PageTablePTE pte"
+  and "invalid_pte_at (pt_type pt) p s"
+  and "pts_of s (the (pte_ref pte)) = Some (empty_pt NormalPT_T)"
+  and "the (pte_ref pte) \<noteq> table_base (pt_type pt) p"
+  and "(kheap s)(table_base (pt_type pt) p) = Some (ArchObj (PageTable pt))"
+  shows "state_vrefs (s\<lparr>kheap := (kheap s)(table_base (pt_type pt) p \<mapsto>
+                                 ArchObj (PageTable (pt_upd pt (table_index (pt_type pt) p) pte)))\<rparr>) =
+         (\<lambda>x. if x = table_base (pt_type pt) p
+              then vs_refs_aux level (PageTable (pt_upd pt (table_index (pt_type pt) p) pte))
+              else state_vrefs s x)"
+  (is "state_vrefs ?s' = _")
+  using assms
+  apply -
+  apply (rule all_ext)
+  apply (case_tac "level = asid_pool_level")
+   apply (fastforce simp: vs_lookup_slot_def vs_lookup_table_def
+                          ptes_of_Some pts_of_Some aobjs_of_Some
+                    dest: pool_for_asid_no_pte split: if_splits)
+  apply safe
+   apply (clarsimp simp: state_vrefs_def opt_map_def split: option.splits)
+   apply (case_tac "x = pptr_from_pte pte")
+    apply (clarsimp simp: pte_ref_def2 split: if_splits)
+    apply (fastforce simp: empty_pt_def vs_refs_aux_def graph_of_def pte_ref2_def split: if_splits pt.splits)
+   apply (drule_tac s=s and pte=pte and p=p in vs_lookup_PageTablePTE)
+              apply ((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                              intro: ptes_of_pts_of_upd
+                               dest: pte_ptr_eq split: if_splits
+                     | clarsimp simp: opt_map_def fun_upd_def split: option.splits)+; fail)+
+   apply clarsimp
+   apply (drule vs_lookup_level)
+   apply (case_tac "lvl = asid_pool_level")
+    apply (fastforce dest: vs_lookup_asid_pool simp: asid_pools_of_ko_at obj_at_def)
+  apply (frule vs_lookup_slot_level_type)
+          apply (fastforce simp: ptes_of_Some pts_of_Some aobjs_of_Some)+
+   apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+   apply (fastforce dest: vs_lookup_table_unique_level split: if_splits)
+  apply (clarsimp simp: state_vrefs_def opt_map_def)
+   apply (case_tac "level = asid_pool_level")
+    apply (fastforce dest: vs_lookup_asid_pool simp: asid_pools_of_ko_at obj_at_def)
+  apply (frule vs_lookup_slot_level_type)
+          apply ((fastforce simp: ptes_of_Some pts_of_Some aobjs_of_Some)+)[7]
+  apply (frule vs_lookup_slot_table_base)
+     apply clarsimp+
+  apply (case_tac "x = table_base (pt_type pt) p"; clarsimp)
+   apply (drule_tac pte=pte and s'="?s'" in vs_lookup_PageTablePTE')
+              apply (((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                              intro: ptes_of_pts_of_upd
+                               dest: pte_ptr_eq split: if_splits
+                     | clarsimp simp: opt_map_def fun_upd_def fun_upd2_def split: if_splits option.splits)+; fail)+)[10]
+  apply (drule_tac level=bot and pte=pte and s'="?s'" in vs_lookup_PageTablePTE')
+              apply (((fastforce simp: ptes_of_pts_of_upd ptes_of_Some pts_of_Some aobjs_of_Some
+                              intro: ptes_of_pts_of_upd
+                               dest: pte_ptr_eq split: if_splits
+                     | clarsimp simp: opt_map_def fun_upd_def fun_upd2_def split: if_splits option.splits)+; fail)+)[10]
+  done
+
+lemma state_vrefs_store_PageTablePTE_wp:
+  "\<lbrace>\<lambda>s. invs s \<and> is_PageTablePTE pte \<and> invalid_pte_at pt_t p s \<and>
+        pts_of s (the (pte_ref pte)) = Some (empty_pt NormalPT_T) \<and> the (pte_ref pte) \<noteq> table_base pt_t p \<and>
+        (\<exists>level asid vref. vs_lookup_slot level asid vref s = Some (level, p) \<and> vref \<in> user_region \<and>
+                           (\<forall>pt. pts_of s (table_base pt_t p) = Some pt \<and> pt_t = pt_type pt \<and> is_aligned p pte_bits \<longrightarrow>
+                                 P (\<lambda>x. if x = table_base (pt_type pt) p
+                                        then vs_refs_aux level (PageTable (pt_upd pt (table_index (pt_type pt) p) pte))
+                                        else state_vrefs s x)))\<rbrace>
+   store_pte pt_t p pte
+   \<lbrace>\<lambda>_ s. P (state_vrefs s)\<rbrace>"
+  unfolding store_pte_def set_pt_def
+  apply (wpsimp wp: set_object_wp)
+  apply (subst state_vrefs_store_PageTablePTE; simp?)
+   apply (fastforce simp: fun_upd_def fun_upd2_def obj_at_def state_vrefs_store_PageTablePTE split: if_splits)
+  apply (clarsimp simp: pts_of_Some aobjs_of_Some obj_at_def)
+  done
+
+lemma pt_apply_def2:
+  "pt_apply pt = (\<lambda>idx. case pt of NormalPT npt \<Rightarrow> npt (ucast idx) | VSRootPT vs \<Rightarrow> vs (ucast idx))"
+  by (fastforce simp: pt_apply_def)
+
+lemma pt_apply_upd_eq':
+  "pt_apply (pt_upd pt idx pte) idx' =
+   (if idx && mask (ptTranslationBits (pt_type pt)) = idx' && mask (ptTranslationBits (pt_type pt))
+    then pte else pt_apply pt idx')"
+  by (fastforce simp: pt_apply_def pt_upd_def ucast_ucast_mask vs_index_bits_def ptTranslationBits_def
+                dest: arg_cong[where f="UCAST(vs_index_len \<rightarrow> 64)"] arg_cong[where f="UCAST(9 \<rightarrow> 64)"]
+               intro: ucast_up_inj[where 'b=64]
+               split: pt.splits)
+
+(* FIXME AARCH64: replace vs_refs_aux with this definition *)
+lemma vs_refs_aux_def2:
+  "vs_refs_aux level = (\<lambda>ko. case ko of
+     ASIDPool pool \<Rightarrow> (\<lambda>(r,p). (p, ucast r, AASIDPool, Control)) ` graph_of (option_map ap_vspace o pool)
+   | PageTable pt \<Rightarrow> \<Union>(r,(p, sz, auth)) \<in> graph_of (pte_ref2 level o pt_apply pt).
+                       (\<lambda>(p, a). (p, r && mask (ptTranslationBits (pt_type pt)), APageTable (pt_type pt), a))
+                       ` (ptr_range p sz \<times> auth)
+   | _ \<Rightarrow> {})"
+  apply (rule ext)+
+  apply (rule equalityI)
+   apply (clarsimp simp: vs_refs_aux_def )
+   apply (case_tac ko; clarsimp)
+   apply (case_tac x2; clarsimp simp: pt_apply_def2)
+    apply (clarsimp simp: graph_of_def image_iff)
+    apply (rule_tac x="UCAST(vs_index_len \<rightarrow> 64) ac" in exI)
+    apply (fastforce simp: ucast_and_mask_drop ucast_ucast_id vs_index_bits_def ptTranslationBits_def)
+   apply (clarsimp simp: graph_of_def image_iff)
+   apply (rule_tac x="UCAST(9 \<rightarrow> 64) ac" in exI)
+   apply (fastforce simp: ucast_and_mask_drop ucast_ucast_id vs_index_bits_def ptTranslationBits_def)
+  apply (clarsimp simp: vs_refs_aux_def)
+  apply (case_tac ko; clarsimp)
+  apply (case_tac x2; clarsimp simp: pt_apply_def2)
+   apply (fastforce simp: graph_of_def image_iff ucast_ucast_mask vs_index_bits_def ptTranslationBits_def)
+  apply (fastforce simp: graph_of_def image_iff ucast_ucast_mask vs_index_bits_def ptTranslationBits_def)
+  done
+
+lemma perform_pt_inv_map_pas_refined[wp]:
+  "\<lbrace>pas_refined aag and invs and valid_pti (PageTableMap acap (a, b) pte p level)
+                    and K (authorised_page_table_inv aag (PageTableMap acap (a, b) pte p level))\<rbrace>
+   perform_pt_inv_map acap (a,b) pte p level
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding perform_pt_inv_map_def
+  apply (rule hoare_gen_asm)
+  apply (wpsimp simp: pas_refined_def state_objs_to_policy_def)
+    apply (wps | wpsimp wp: state_vrefs_store_PageTablePTE_wp arch_update_cap_invs_map
+                            vs_lookup_slot_lift set_cap_arch_obj_neg set_cap_state_vrefs
+                            hoare_vcg_ex_lift hoare_vcg_all_lift hoare_vcg_imp_lift')+
+  apply (clarsimp simp: invs_psp_aligned invs_vspace_objs invs_arch_state
+                        valid_pti_def cte_wp_at_cte_at)
+  apply (case_tac acap; clarsimp)
+  apply (intro conjI; (solves \<open>simp add: pas_refined_def\<close>)?)
+     apply (fastforce simp: cte_wp_at_caps_of_state vs_cap_ref_def
+                            is_arch_update_def cap_master_cap_def
+                     split: arch_cap.splits)
+    apply (clarsimp simp: cte_wp_at_caps_of_state)
+    apply (fastforce dest: caps_of_state_valid
+                    simp: vs_cap_ref_def is_arch_update_def cap_master_cap_def
+                          valid_cap_def cap_aligned_def valid_arch_cap_def
+                   split: cap.splits arch_cap.splits)
+   apply (clarsimp simp: vs_lookup_slot_def split: if_splits)
+    apply (fastforce dest: pool_for_asid_no_pte simp: vs_lookup_table_def invalid_pte_at_def)
+   apply (frule (2) vs_lookup_table_is_aligned; 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_and_type, simp, fastforce intro: valid_objs_caps)
+   apply (clarsimp simp: cte_wp_at_caps_of_state)
+   apply (clarsimp simp: is_cap_simps is_arch_update_def cap_master_cap_def
+                  split: cap.splits arch_cap.splits)
+   apply (drule (1) unique_table_refsD[rotated]; fastforce simp: table_cap_ref_def)
+  apply (intro exI conjI; (simp | clarsimp))
+  apply (intro conjI)
+    apply (clarsimp simp: pas_refined_def cte_wp_at_caps_of_state auth_graph_map_def)
+    apply (erule state_bits_to_policy.cases)
+          apply (clarsimp simp: is_arch_update_def cap_master_cap_def state_objs_to_policy_def
+                         split: if_splits cap.splits arch_cap.splits option.splits;
+                 fastforce dest: sbta_caps simp: cap_auth_conferred_def arch_cap_auth_conferred_def)
+         apply (fastforce dest: sbta_untyped simp: state_objs_to_policy_def split: if_splits)
+        apply (fastforce dest: sbta_ts simp: state_objs_to_policy_def)
+       apply (fastforce dest: sbta_bounds simp: state_objs_to_policy_def)
+      apply (clarsimp simp: state_objs_to_policy_def is_arch_update_def cap_master_cap_def)
+      apply (drule_tac caps="caps_of_state s" in sbta_cdt;
+             fastforce elim: is_transferable.cases split: if_splits)
+     apply (fastforce dest: sbta_cdt_transferable simp: state_objs_to_policy_def)
+    apply (clarsimp split: if_splits)
+     apply (clarsimp simp: authorised_page_table_inv_def split: arch_kernel_obj.splits)
+     apply (clarsimp simp: aag_cap_auth_def cap_auth_conferred_def arch_cap_auth_conferred_def)
+     apply (cases pte; clarsimp)
+     apply (clarsimp simp: vs_refs_aux_def2 graph_of_def)
+     apply (clarsimp simp: pt_apply_upd_eq' split: if_splits)
+      apply (clarsimp simp: pte_ref2_def pptr_from_pte_def)
+     apply (erule subsetD)
+     apply (clarsimp simp: auth_graph_map_def state_objs_to_policy_def)
+     apply (rule_tac x="table_base (pt_type pt) p" in exI, rule conjI, erule sym)
+     apply (rule exI, rule conjI, rule refl)
+     apply (rule sbta_vref)
+     apply (case_tac "level = asid_pool_level")
+      apply (fastforce dest: pool_for_asid_no_pte
+                       simp: vs_lookup_slot_def vs_lookup_table_def invalid_pte_at_def)
+     apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+     apply (erule state_vrefsD)
+       apply (fastforce simp: pts_of_Some vspace_objs_of_Some obj_at_def)
+      apply clarsimp
+     apply (fastforce simp: vs_refs_aux_def2 graph_of_def)
+    (* slow ~60s *)
+    apply (clarsimp simp: is_arch_update_def cap_master_cap_def
+                   split: cap.splits arch_cap.splits option.splits)
+    apply (fastforce dest: sbta_vref simp: pas_refined_def auth_graph_map_def state_objs_to_policy_def)
+   apply (clarsimp simp: pas_refined_def)
+   apply (erule state_asids_to_policy_aux.cases)
+     apply (clarsimp simp: cte_wp_at_caps_of_state split: if_splits)
+      apply (clarsimp simp: authorised_page_table_inv_def aag_cap_auth_def
+                            cap_auth_conferred_def arch_cap_auth_conferred_def
+                            cap_links_asid_slot_def label_owns_asid_slot_def)
+     apply (fastforce dest: sata_asid)
+    apply (clarsimp split: if_splits)
+     apply (fastforce dest!: state_asids_to_policy_aux.intros simp: vs_refs_aux_def split: pt.splits)
+    apply (fastforce dest!: sata_asid_lookup)
+   apply (fastforce dest!: sata_asidpool)
+  apply (clarsimp simp: pas_refined_def)
+  apply (erule state_irqs_to_policy_aux.cases)
+  apply (clarsimp split: if_splits)
+  apply (fastforce dest: sita_controlled)
+  done
+
+lemma perform_page_table_invocation_pas_refined:
+  "\<lbrace>pas_refined aag and invs and valid_pti iv and K (authorised_page_table_inv aag iv)\<rbrace>
+   perform_page_table_invocation iv
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding perform_page_table_invocation_def
+  apply wpsimp
+   apply (wpsimp wp: perform_pt_inv_unmap_pas_refined perform_pt_inv_map_pas_refined)+
+  apply (case_tac iv; clarsimp)
+  done
+
+(* FIXME move to AInvs *)
+lemma store_pte_ekheap[wp]:
+  "store_pte pt_t p pte \<lbrace>\<lambda>s. P (ekheap s)\<rbrace>"
+  apply (simp add: store_pte_def set_pt_def)
+  apply (wp get_object_wp)
+  apply simp
+  done
+
+lemma set_asid_pool_thread_st_auth[wp]:
+  "set_asid_pool p pool \<lbrace>\<lambda>s. P (thread_st_auth s)\<rbrace>"
+  apply (simp add: set_asid_pool_def)
+  apply (wpsimp wp: set_object_wp_strong)
+  apply (clarsimp simp: thread_st_auth_def obj_at_def get_tcb_def tcb_states_of_state_def
+                 elim!: rsubst[where P=P, OF _ ext]
+                 split: kernel_object.split_asm option.split)
+  done
+
+lemma set_asid_pool_thread_bound_ntfns[wp]:
+  "set_asid_pool p pool \<lbrace>\<lambda>s. P (thread_bound_ntfns s)\<rbrace>"
+  apply (simp add: set_asid_pool_def)
+  apply (wpsimp wp: set_object_wp_strong)
+  apply (clarsimp simp: thread_bound_ntfns_def obj_at_def get_tcb_def tcb_states_of_state_def
+                 elim!: rsubst[where P=P, OF _ ext]
+                 split: kernel_object.split_asm option.split)
+  done
+
+crunch set_asid_pool
+  for integrity_autarch: "integrity aag X st"
+  (wp: crunch_wps)
+
+lemma store_pte_respects:
+  "\<lbrace>integrity aag X st and K (is_subject aag (table_base pt_t p))\<rbrace>
+   store_pte pt_t p pte
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (simp add: store_pte_def set_pt_def)
+  apply (wp get_object_wp set_object_integrity_autarch)
+  apply simp
+  done
+
+lemma integrity_arch_state[iff]:
+  "arm_asid_table v = arm_asid_table (arch_state s)
+   \<Longrightarrow> integrity aag X st (s\<lparr>arch_state := v\<rparr>) = integrity aag X st s"
+  unfolding integrity_def by simp
+
+lemma integrity_riscv_kernel_vspace[iff]:
+  "integrity aag X st (s\<lparr>arch_state := ((arch_state s)\<lparr>arm_kernel_vspace := v\<rparr>)\<rparr>) =
+   integrity aag X st s"
+  unfolding integrity_def by simp
+
+lemma is_subject_trans:
+  "\<lbrakk> is_subject aag x; pas_refined aag s;
+     (pasObjectAbs aag x, Control, pasObjectAbs aag y) \<in> pasPolicy aag \<rbrakk>
+     \<Longrightarrow> is_subject aag y"
+  by (subst aag_has_Control_iff_owns[symmetric]; simp)
+
+lemma is_subject_asid_trans:
+  "\<lbrakk> is_subject_asid aag x; pas_refined aag s;
+     (pasASIDAbs aag x, Control, pasObjectAbs aag y) \<in> pasPolicy aag \<rbrakk>
+     \<Longrightarrow> is_subject aag y"
+  by (subst aag_has_Control_iff_owns[symmetric]; simp)
+
+lemma pt_walk_is_subject:
+  "\<lbrakk> pas_refined aag s; valid_vspace_objs s; valid_asid_table s; pspace_aligned s;
+     pt_walk level bot_level pt_ptr vptr (ptes_of s) = Some (level', pt);
+     vs_lookup_table level asid vptr s = Some (level, pt_ptr);
+     level \<le> max_pt_level; vptr \<in> user_region; is_subject aag pt_ptr \<rbrakk>
+     \<Longrightarrow> is_subject aag pt"
+  apply (induct level arbitrary: pt_ptr; clarsimp)
+  apply (erule_tac x="pptr_from_pte (the (ptes_of s (level_type level) (pt_slot_offset level pt_ptr vptr)))"
+                in meta_allE)
+  apply (subst (asm) pt_walk.simps)
+  apply (clarsimp simp: obind_def split: if_splits option.splits)
+  apply (drule meta_mp)
+   apply (erule vs_lookup_table_extend)
+    apply (subst pt_walk.simps, clarsimp simp: obind_def)
+   apply clarsimp
+  apply (erule meta_mp)
+  apply (subst (asm) ptes_of_Some)
+  apply (frule vs_lookup_table_is_aligned; clarsimp)
+  apply (erule (1) is_subject_trans)
+  apply (clarsimp simp: pas_refined_def auth_graph_map_def)
+  apply (erule subsetD, clarsimp)
+  apply (rule exI conjI refl sta_vref)+
+  apply (erule state_vrefsD)
+    apply (fastforce simp: vspace_objs_of_Some pts_of_Some)
+   apply clarsimp
+  apply (clarsimp simp: vs_refs_aux_def2  graph_of_def)
+  apply (rule_tac x="pt_index level vptr" in exI)
+  apply (fastforce simp: pptr_from_pte_def pte_ref2_def split: pte.splits)
+  done
+
+lemma pt_lookup_slot_from_level_is_subject:
+  "\<lbrakk> pas_refined aag s; valid_vspace_objs s; valid_asid_table s; pspace_aligned s;
+     pt_lookup_slot_from_level level bot_level pt_ptr vptr (ptes_of s) = Some (level', pt);
+     (\<exists>asid. vs_lookup_table level asid vptr s = Some (level, pt_ptr));
+     level \<le> max_pt_level; vptr \<in> user_region; is_subject aag pt_ptr \<rbrakk>
+     \<Longrightarrow> is_subject aag (table_base (level_type level') pt)"
+  apply (clarsimp simp: pt_lookup_slot_from_level_def)
+  apply (frule vs_lookup_table_is_aligned, fastforce+)
+  apply (frule pt_walk_is_aligned, fastforce+)
+  apply (frule pt_walk_is_subject, fastforce+)
+  done
+
+lemma pt_lookup_from_level_is_subject:
+  "\<lbrace>\<lambda>s. pas_refined aag s \<and> pspace_aligned s \<and> valid_vspace_objs s \<and> valid_asid_table s \<and>
+        is_subject aag pt_ptr \<and> level \<le> max_pt_level \<and> vref \<in> user_region \<and>
+        (\<exists>asid. vs_lookup_table level asid vref s = Some (level, pt_ptr))\<rbrace>
+   pt_lookup_from_level level pt_ptr vref pt
+   \<lbrace>\<lambda>(rv,lvl) _. is_subject aag (table_base (level_type lvl) rv)\<rbrace>, -"
+  apply (wpsimp wp: pt_lookup_from_level_wp)
+  apply (erule_tac level=level and bot_level=levela and pt_ptr=pt_ptr and vptr=vref
+                in pt_lookup_slot_from_level_is_subject)
+  by (auto simp: pt_lookup_slot_from_level_def obind_def)
+
+lemma unmap_page_table_respects:
+  "\<lbrace>integrity aag X st and pas_refined aag and invs
+                       and K (is_subject_asid aag asid \<and> vaddr \<in> user_region)\<rbrace>
+   unmap_page_table asid vaddr pt
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding unmap_page_table_def invalidate_tlb_by_asid_def
+  apply (wpsimp wp: dmo_no_mem_respects store_pte_respects Nondet_VCG.hoare_vcg_all_liftE
+              simp: imp_conjR
+         | rule hoare_strengthen_postE_R[OF pt_lookup_from_level_is_subject], fastforce
+         | rule hoare_vcg_conj_elimE hoare_vcg_conj_liftE_R hoare_drop_imps)+
+  apply (intro conjI; clarsimp?)
+   apply (rule aag_Control_into_owns[rotated], assumption)
+   apply (drule sym)
+   apply (clarsimp simp: vspace_for_asid_def entry_for_asid_def obj_at_def pas_refined_def)
+   apply (erule_tac A="state_asids_to_policy_aux _ _ _ _" in subsetD)
+   apply (rule sata_asid_lookup)
+    apply (simp add:  vspace_for_pool_def pool_for_asid_def)
+   apply (clarsimp simp: entry_for_pool_def vspace_for_pool_def)
+   apply (drule pool_for_asid_vs_lookupD)
+   apply (erule state_vrefsD)
+     apply (fastforce simp: vspace_objs_of_Some aobjs_of_Some asid_pools_of_ko_at obj_at_def)
+    apply assumption
+   apply (clarsimp simp: vs_refs_aux_def)
+   apply (fastforce simp: vs_refs_aux_def graph_of_def asid_low_bits_of_mask_eq[symmetric]
+                          word_size ucast_ucast_b is_up_def source_size_def target_size_def)
+  apply (fastforce dest: vs_lookup_table_vref_independent[OF vspace_for_asid_vs_lookup])
+  done
+
+lemma perform_page_table_invocation_respects:
+  "\<lbrace>integrity aag X st and pas_refined aag and invs and valid_pti page_table_invocation
+                       and K (authorised_page_table_inv aag page_table_invocation)\<rbrace>
+   perform_page_table_invocation page_table_invocation
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (rule hoare_gen_asm)
+  apply (simp add: perform_page_table_invocation_def perform_pt_inv_map_def perform_pt_inv_unmap_def
+             cong: page_table_invocation.case_cong option.case_cong prod.case_cong
+                   cap.case_cong arch_cap.case_cong)
+  apply (cases page_table_invocation; clarsimp)
+   apply (wpsimp wp: set_cap_integrity_autarch store_pte_respects
+               simp: authorised_page_table_inv_def cleanByVA_PoU_def)
+  apply (rename_tac cap fst_cslot_ptr snd_cslot_ptr)
+  apply (wpsimp wp: set_cap_integrity_autarch simp:cleanCacheRange_PoU_def)
+     apply (rule_tac I="\<lambda>s. integrity aag X st s \<and> is_subject aag fst_cslot_ptr \<and> is_PageTableCap cap"
+                  in mapM_x_inv_wp; clarsimp)
+      apply (rule_tac P="\<lambda>s. integrity aag X st s \<and> is_PageTableCap cap" in hoare_vcg_conj_lift)
+       apply (wpsimp wp: store_pte_respects)
+       apply (clarsimp simp: authorised_page_table_inv_def)
+       apply (case_tac cap; clarsimp)
+       apply (metis add_mask_fold)
+      apply (wpsimp wp: unmap_page_table_respects)+
+  apply (clarsimp simp: authorised_page_table_inv_def valid_pti_def valid_arch_cap_def
+                        wellformed_acap_def wellformed_mapdata_def
+                 split: arch_cap.splits)
+  done
+
+lemma perform_pg_inv_get_addr_pas_refined [wp]:
+  "\<lbrace>pas_refined aag and invs\<rbrace>
+   perform_pg_inv_get_addr ptr
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding perform_pg_inv_get_addr_def
+  by wp auto
+
+lemma store_pte_vmid_for_asid[wp]:
+  " store_pte pt_t p pte
+   \<lbrace>\<lambda>s. P (vmid_for_asid s asid)\<rbrace>"
+  apply (simp add: store_pte_def set_pt_def)
+  apply (wp get_object_wp set_object_wp)
+  by (auto simp: obj_at_def opt_map_def vmid_for_asid_def obind_def entry_for_pool_def
+          split: if_splits option.splits)
+
+lemma unmap_page_pas_refined:
+  "\<lbrace>pas_refined aag and invs and K (vptr \<in> user_region)\<rbrace>
+   unmap_page pgsz asid vptr pptr
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding unmap_page_def invalidate_tlb_by_asid_va_def cleanByVA_PoU_def
+  apply (clarsimp simp: conj_ac | wpsimp wp: set_cap_pas_refined_not_transferable hoare_vcg_all_lift
+                                             hoare_vcg_imp_lift' get_cap_wp store_pte_pas_refined
+                                             store_pte_valid_arch_state_unreachable)+
+  apply (frule (1) pt_lookup_slot_vs_lookup_slotI0)
+  apply (drule vs_lookup_slot_level)
+  apply (case_tac "x = asid_pool_level")
+   apply (fastforce dest: vs_lookup_slot_no_asid)
+  apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+  apply (intro conjI)
+    apply (clarsimp simp: reachable_page_table_not_global)
+   apply (frule vs_lookup_table_pt_at; clarsimp?)
+   apply (drule vs_lookup_table_valid_cap; clarsimp?)
+   apply (fastforce simp: valid_cap_def valid_arch_cap_def valid_arch_cap_ref_def obj_at_def
+                    dest: caps_of_state_valid split: cap.splits arch_cap.splits)
+  done
+
+definition authorised_slots :: "'a PAS \<Rightarrow> pte \<times> obj_ref \<times> vm_level \<Rightarrow> 's :: state_ext state \<Rightarrow>  bool" where
+ "authorised_slots aag m s \<equiv> case m of (pte, slot, lvl) \<Rightarrow>
+    (\<forall>level asid vref x.
+       vs_lookup_slot level asid vref s = Some (level, slot) \<longrightarrow>
+       vref \<in> user_region \<longrightarrow>
+       level \<le> max_pt_level \<longrightarrow>
+       pte_ref2 level pte = Some x \<longrightarrow>
+         (\<forall>a \<in> snd (snd x). \<forall>p \<in> ptr_range (fst x) (fst (snd x)). aag_has_auth_to aag a p)) \<and>
+    is_subject aag (table_base (level_type lvl) slot)"
+
+definition authorised_page_inv :: "'a PAS \<Rightarrow> page_invocation \<Rightarrow> 's :: state_ext state \<Rightarrow>  bool" where
+  "authorised_page_inv aag pgi s \<equiv> case pgi of
+     PageMap cap ptr slots \<Rightarrow> pas_cap_cur_auth aag (ArchObjectCap cap) \<and>
+                              is_subject aag (fst ptr) \<and> authorised_slots aag slots s
+   | PageUnmap cap ptr \<Rightarrow> pas_cap_cur_auth aag (ArchObjectCap cap) \<and> is_subject aag (fst ptr)
+   | _ \<Rightarrow> True"
+
+lemma perform_pg_inv_unmap_pas_refined:
+   "\<lbrace>pas_refined aag and invs and valid_page_inv (PageUnmap cap ct_slot)
+                     and authorised_page_inv aag (PageUnmap cap ct_slot)\<rbrace>
+    perform_pg_inv_unmap cap ct_slot
+    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding perform_pg_inv_unmap_def
+  apply (strengthen invs_psp_aligned invs_vspace_objs invs_arch_state
+         | wpsimp wp: unmap_page_pas_refined set_cap_pas_refined_not_transferable
+                      unmap_page_invs get_cap_wp hoare_vcg_all_lift hoare_vcg_imp_lift)+
+  apply (fastforce simp: authorised_page_inv_def valid_page_inv_def valid_arch_cap_def
+                         cte_wp_at_caps_of_state update_map_data_def aag_cap_auth_def
+                         cap_auth_conferred_def arch_cap_auth_conferred_def
+                         cap_links_asid_slot_def cap_links_irq_def wellformed_mapdata_def)
+  done
+
+lemma set_cap_vs_lookup_slot[wp]:
+  "set_cap param_a param_b \<lbrace>\<lambda>s. P (vs_lookup_slot level asid vref s)\<rbrace> "
+  apply (clarsimp simp: vs_lookup_slot_def obind_def)
+  apply (rule hoare_pre)
+   apply (rule hoare_lift_Pf3[where f="\<lambda>s level asid vref. vs_lookup_table level asid vref s"])
+    apply (clarsimp split: option.splits)
+    apply wpsimp
+   apply wpsimp
+  apply (auto split: if_splits)
+  done
+
+crunch set_cap
+  for level_of_table[wp]: "\<lambda>s. P (level_of_table p s)"
+  (simp: level_of_table_def)
+
+lemma set_cap_authorised_page_inv[wp]:
+  "set_cap param_a param_b \<lbrace>\<lambda>s. P (authorised_page_inv aag (PageMap cap ct_slot entries) s)\<rbrace> "
+  apply (clarsimp simp: authorised_page_inv_def authorised_slots_def)
+  apply (rule hoare_pre)
+   apply wps
+   apply wp
+  apply clarsimp
+  done
+
+lemma set_cap_same_ref[wp]:
+  "set_cap param_a param_b \<lbrace>\<lambda>s. P (same_ref pte_slot cap s)\<rbrace> "
+  apply (case_tac pte_slot; clarsimp)
+  apply (clarsimp simp: same_ref_def)
+  apply (rule hoare_pre)
+   apply wps
+   apply wp
+  apply clarsimp
+  done
+
+lemma perform_pg_inv_map_pas_refined:
+  "\<lbrace>pas_refined aag and invs and valid_page_inv (PageMap cap ct_slot (pte,slot,level))
+                    and authorised_page_inv aag (PageMap cap ct_slot (pte,slot,level))\<rbrace>
+   perform_pg_inv_map cap ct_slot pte slot level
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding perform_pg_inv_map_def invalidate_tlb_by_asid_va_def cleanCacheRange_PoU_def cleanByVA_PoU_def
+  apply wp
+        apply wpsimp
+       apply wp
+      apply (wpsimp wp: hoare_vcg_if_lift hoare_vcg_imp_lift)
+     apply (rule_tac Q'="\<lambda>_. pas_refined aag" in hoare_strengthen_post)
+      apply (simp add: pas_refined_def state_objs_to_policy_def)
+      apply wp
+      apply wps
+      apply (rule state_vrefs_store_NonPageTablePTE_wp)
+     apply (clarsimp simp: pas_refined_def)
+    apply (rule_tac Q'="\<lambda>_. invs and pas_refined aag and K (\<not> is_PageTablePTE pte)
+                                 and authorised_page_inv aag (PageMap cap ct_slot (pte,slot,level))
+                                 and same_ref (pte,slot,level) (ArchObjectCap cap)"
+                 in hoare_strengthen_post[rotated])
+     apply (clarsimp simp: pas_refined_def)
+     apply (rule conjI)
+      apply clarsimp
+      apply (intro exI, rule conjI, assumption)
+      apply clarsimp
+      apply (rule conjI)
+       prefer 2
+       apply clarsimp
+       apply (erule_tac A="state_asids_to_policy_aux _ _ _ _" in subsetD)
+       apply (erule state_asids_to_policy_aux.cases)
+         apply (fastforce dest: sata_asid)
+        apply (clarsimp simp: cte_wp_at_caps_of_state)
+        apply (clarsimp simp only: split: if_splits)
+         apply (clarsimp simp: vs_refs_aux_def split: pt.splits)
+        apply (erule sata_asid_lookup)
+        apply assumption
+       apply (fastforce dest: sata_asidpool)
+      apply (clarsimp simp: auth_graph_map_def authorised_page_inv_def)
+      apply (erule state_bits_to_policy.cases)
+            apply (fastforce dest: sbta_caps simp: state_objs_to_policy_def)
+           apply (fastforce dest: sbta_untyped simp: state_objs_to_policy_def)
+          apply (fastforce dest: sbta_ts simp: state_objs_to_policy_def)
+         apply (fastforce dest: sbta_bounds simp: state_objs_to_policy_def)
+        apply (fastforce dest: sbta_cdt simp: state_objs_to_policy_def)
+       apply (fastforce dest: sbta_cdt_transferable simp: state_objs_to_policy_def)
+      apply (clarsimp split: if_split_asm)
+       apply (clarsimp simp: vs_refs_aux_def)
+       apply (case_tac "levela = asid_pool_level")
+        apply (fastforce dest!: vs_lookup_slot_no_asid
+                          simp: ptes_of_Some pts_of_Some aobjs_of_Some obj_at_def)
+       apply (clarsimp simp: pt_upd_def split: pt.splits)
+        apply (clarsimp simp: graph_of_def split: if_split_asm)
+         apply (case_tac pte; clarsimp simp: authorised_slots_def)
+        apply (clarsimp simp: same_ref_def)
+        apply (drule (1) vs_lookup_slot_unique_level; clarsimp)
+        apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+        apply (erule subsetD)
+        apply (clarsimp simp: state_objs_to_policy_def)
+        apply (rule exI, rule conjI, rule refl)+
+        apply (rule sbta_vref)
+        apply (erule state_vrefsD)
+          apply (fastforce simp: ptes_of_Some pts_of_Some vspace_objs_of_Some obj_at_def)
+         apply fastforce
+        apply (fastforce simp: vs_refs_aux_def graph_of_def)
+       apply (clarsimp simp: graph_of_def split: if_split_asm)
+        apply (case_tac pte; clarsimp simp: authorised_slots_def level_type_def)
+       apply (clarsimp simp: same_ref_def)
+       apply (drule (1) vs_lookup_slot_unique_level; clarsimp)
+       apply (subst (asm) vs_lookup_slot_table_unfold; clarsimp)
+       apply (erule subsetD)
+       apply (clarsimp simp: state_objs_to_policy_def level_type_def)
+       apply (rule exI, rule conjI, rule refl)+
+       apply (rule sbta_vref)
+       apply (erule state_vrefsD)
+         apply (fastforce simp: ptes_of_Some pts_of_Some vspace_objs_of_Some obj_at_def)
+        apply fastforce
+       apply (fastforce simp: vs_refs_aux_def graph_of_def)
+      apply (fastforce dest: sbta_vref simp: state_objs_to_policy_def)
+     apply (clarsimp simp: same_ref_def)
+    apply (wpsimp wp: arch_update_cap_invs_map set_cap_pas_refined_not_transferable)
+   apply wp
+  apply (clarsimp simp: valid_page_inv_def authorised_page_inv_def cte_wp_at_caps_of_state
+                        is_frame_cap_def is_arch_update_def cap_master_cap_def
+                 split: arch_cap.splits)
+  apply (rule conjI)
+   apply (fastforce dest: vs_lookup_slot_unique_level simp: same_ref_def parent_for_refs_def)
+  apply (fastforce dest: vs_lookup_slot_unique_level caps_of_state_valid
+                   simp: valid_arch_cap_def valid_cap_def cap_aligned_def)
+  done
+
+lemma perform_page_invocation_pas_refined:
+  "\<lbrace>pas_refined aag and invs and authorised_page_inv aag pgi and valid_page_inv pgi\<rbrace>
+   perform_page_invocation pgi
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding perform_page_invocation_def perform_flush_def
+  apply (wpsimp wp: perform_pg_inv_map_pas_refined perform_pg_inv_unmap_pas_refined)
+  apply auto
+  done
+
+lemma unmap_page_respects:
+  "\<lbrace>integrity aag X st and pspace_aligned and valid_vspace_objs and valid_arch_state
+                       and K (is_subject_asid aag asid) and pas_refined aag
+                       and K (vptr \<in> user_region)\<rbrace>
+   unmap_page sz asid vptr pptr
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (rule hoare_gen_asm)
+  apply (simp add: unmap_page_def swp_def cong: vmpage_size.case_cong)
+  apply (rule hoare_pre)
+   apply (wpsimp wp: store_pte_respects
+                     hoare_drop_imps[where Q="\<lambda>rv. integrity aag X st"]
+               simp: is_aligned_mask[symmetric] cleanByVA_PoU_def
+                     invalidate_tlb_by_asid_va_def invalidateTranslationSingle_def
+          | wp (once) hoare_drop_imps
+          | wp (once) hoare_drop_imps[where Q'="\<lambda>rv s. rv"])+
+  apply (clarsimp simp: pt_lookup_slot_def)
+  apply (frule pt_lookup_slot_from_level_is_subject)
+          apply (fastforce simp: valid_arch_state_asid_table
+                           dest: vs_lookup_table_vref_independent[OF vspace_for_asid_vs_lookup])+
+   apply (erule (1) is_subject_asid_trans)
+   apply (clarsimp simp: pas_refined_def entry_for_asid_def entry_for_pool_def vspace_for_asid_def)
+   apply (erule subsetD[where A="state_asids_to_policy_aux _ _ _ _"])
+   apply (rule sata_asid_lookup)
+    apply (fastforce simp: pool_for_asid_def)
+   apply (frule pool_for_asid_vs_lookupD)
+   apply (erule state_vrefsD)
+     apply (fastforce simp: vspace_for_pool_def opt_map_def split: option.splits)
+    apply assumption
+   apply (fastforce simp: vs_refs_aux_def graph_of_def asid_low_bits_of_mask_eq[symmetric] word_size
+                          ucast_ucast_b ucast_up_ucast_id is_up_def source_size_def target_size_def)
+  apply simp
+  done
+
+lemma set_cap_vmid_for_asid[wp]:
+  "set_cap cap cslot
+   \<lbrace>\<lambda>s. P (vmid_for_asid s asid)\<rbrace>"
+  apply (simp add: set_cap_def)
+  apply (wpsimp wp: get_object_wp set_object_wp)
+  by (auto simp: obj_at_def opt_map_def vmid_for_asid_def obind_def entry_for_pool_def
+          split: if_splits option.splits)
+
+lemma perform_page_invocation_respects:
+  "\<lbrace>integrity aag X st and pas_refined aag and authorised_page_inv aag pgi
+                       and valid_page_inv pgi and valid_vspace_objs
+                       and pspace_aligned and valid_vspace_objs and valid_arch_state
+                       and is_subject aag  \<circ> cur_thread\<rbrace>
+   perform_page_invocation pgi
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+proof -
+  have set_tl_subset_mp: "\<And>xs a. a \<in> set (tl xs) \<Longrightarrow> a \<in> set xs" by (case_tac xs; clarsimp)
+  show ?thesis
+    apply (unfold authorised_page_inv_def)
+    apply (simp add: perform_page_invocation_def mapM_discarded swp_def valid_page_inv_def
+                     valid_unmap_def authorised_page_inv_def authorised_slots_def
+                     perform_pg_inv_map_def perform_pg_inv_unmap_def
+                     invalidate_tlb_by_asid_va_def invalidateTranslationSingle_def
+                     cleanByVA_PoU_def perform_flush_def do_flush_def
+              split: page_invocation.split sum.split
+                     arch_cap.split option.split, safe)
+        apply ((wp set_cap_integrity_autarch unmap_page_respects
+                   mapM_x_and_const_wp[OF store_pte_respects] store_pte_respects
+                   hoare_vcg_if_lift hoare_vcg_imp_lift hoare_vcg_ex_lift hoare_vcg_disj_lift
+               | elim conjE
+               | clarsimp dest!: set_tl_subset_mp split del: if_split
+               | wpc)+)
+      apply (rule conjI)
+       apply (case_tac m; clarsimp)
+       apply (clarsimp simp: aag_cap_auth_def cte_wp_at_caps_of_state)
+       apply (prop_tac "a \<in> acap_asid' (FrameCap r R sz dev (Some (a,b)))", clarsimp)
+       apply (drule (1) sata_asid[where aag=aag])
+       apply (clarsimp simp: pas_refined_def)
+       apply (drule (1) subsetD)
+       apply (fastforce dest: aag_wellformed_Control)
+      apply (fastforce simp: valid_arch_cap_def wellformed_mapdata_def split: if_splits)
+     apply (wpsimp wp: set_mrs_integrity_autarch set_message_info_integrity_autarch dmo_no_mem_respects
+                 simp: ipc_buffer_has_auth_def perform_pg_inv_get_addr_def)+
+    done
+qed
+
+lemma asid_table_entry_update_integrity:
+ "\<lbrace>\<lambda>s. integrity aag X st s \<and> atable = arm_asid_table (arch_state s)
+                            \<and> (\<forall>v. vopt = Some v \<longrightarrow> is_subject aag v)
+                            \<and> (\<forall>asid'. asid' \<noteq> 0 \<and> asid_high_bits_of asid' = asid_high_bits_of asid
+                                       \<longrightarrow> is_subject_asid aag asid')\<rbrace>
+  modify (\<lambda>s. s\<lparr>arch_state := arch_state s\<lparr>arm_asid_table := atable(asid_high_bits_of asid := vopt)\<rparr>\<rparr>)
+  \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  by (wpsimp simp: integrity_def)
+
+definition authorised_asid_control_inv :: "'a PAS \<Rightarrow> asid_control_invocation \<Rightarrow> bool" where
+ "authorised_asid_control_inv aag aci \<equiv>
+  case aci of MakePool frame slot parent base \<Rightarrow>
+    is_subject aag (fst slot) \<and> is_aligned frame pageBits \<and>
+    (\<forall>asid. is_subject_asid aag asid) \<and> is_subject aag (fst parent) \<and>
+            (\<forall>x \<in> {frame..frame + 2 ^ pageBits - 1}. is_subject aag x)"
+
+lemma perform_asid_control_invocation_respects:
+  "\<lbrace>integrity aag X st and invs and valid_aci aci and K (authorised_asid_control_inv aag aci)\<rbrace>
+   perform_asid_control_invocation aci
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (simp add: perform_asid_control_invocation_def)
+  apply (wpc, simp)
+   apply (wpsimp wp: hoare_weak_lift_imp set_cap_integrity_autarch asid_table_entry_update_integrity
+                     cap_insert_integrity_autarch retype_region_integrity[where sz=12]
+                     delete_objects_valid_vspace_objs delete_objects_valid_arch_state)
+  apply (clarsimp simp: authorised_asid_control_inv_def ptr_range_def add.commute range_cover_def
+                        obj_bits_api_def default_arch_object_def pageBits_def word_bits_def)
+  apply (subst is_aligned_neg_mask_eq[THEN sym], assumption)
+  apply (clarsimp simp: and_mask_eq_iff_shiftr_0 mask_zero word_size_bits_def)
+  apply (frule is_aligned_no_overflow_mask)
+  apply (clarsimp simp: mask_def)
+  done
+
+lemma state_vrefs_asid_pool_map:
+  "\<lbrakk> ako_at (ASIDPool Map.empty) frame s; asid_table s (asid_high_bits_of base) = None \<rbrakk>
+     \<Longrightarrow> state_vrefs (s\<lparr>arch_state := arch_state s\<lparr>arm_asid_table := \<lambda>a. if a = asid_high_bits_of base
+                                                                           then Some frame
+                                                                           else asid_table s a\<rparr>\<rparr>)
+         = state_vrefs s"
+  apply (rule all_ext)
+  apply clarsimp
+  apply safe
+   apply (subst (asm) state_vrefs_def, clarsimp)
+   apply (case_tac "asid_high_bits_of asid = asid_high_bits_of base")
+    apply (clarsimp simp: vs_lookup_table_def pool_for_asid_def vspace_for_pool_def entry_for_pool_def
+                          graph_of_def obj_at_def vs_refs_aux_def aobjs_of_Some vspace_objs_of_Some
+                   split: if_splits)
+   apply (subst (asm) asid_update.vs_lookup_table[simplified fun_upd_def])
+    apply (clarsimp simp: asid_update_def asid_pools_of_ko_at)
+   apply (clarsimp split: if_splits)
+   apply (erule (3) state_vrefsD)
+  apply (subst (asm) state_vrefs_def, clarsimp)
+  apply (case_tac "asid_high_bits_of asid = asid_high_bits_of base")
+   apply (clarsimp simp: vs_lookup_table_def pool_for_asid_def)
+  apply (rule_tac level=bot and asid=asid and vref=vref in state_vrefsD)
+     apply (subst asid_update.vs_lookup_table[simplified fun_upd_def])
+      apply (clarsimp simp: asid_update_def asid_pools_of_ko_at)
+     apply fastforce
+    apply (fastforce simp: aobjs_of_Some)
+   apply clarsimp
+  apply clarsimp
+  done
+
+lemma pas_refined_asid_control_helper:
+  "authorised_asid_control_inv aag (MakePool frame slot parent base) \<Longrightarrow>
+  \<lbrace>\<lambda>s. pas_refined aag s \<and> ko_at (ArchObj (ASIDPool Map.empty)) frame s
+                         \<and> asid_table s (asid_high_bits_of base) = None\<rbrace>
+  do asid_table <- gets asid_table;
+     asid_table' <- return (asid_table(asid_high_bits_of base \<mapsto> frame));
+     modify (\<lambda>s. s\<lparr>arch_state := arch_state s\<lparr>arm_asid_table := asid_table'\<rparr>\<rparr>)
+  od
+  \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding pas_refined_def
+  apply wpsimp
+  apply (rule conjI)
+   apply (clarsimp simp: auth_graph_map_def state_objs_to_policy_def)
+   apply (erule state_bits_to_policy.cases)
+         apply (fastforce dest: sbta_caps)
+        apply (fastforce dest: sbta_untyped)
+       apply (fastforce dest: sbta_ts)
+      apply (fastforce dest: sbta_bounds)
+     apply (fastforce dest: sbta_cdt)
+    apply (fastforce dest: sbta_cdt_transferable)
+   apply (fastforce dest: sbta_vref simp: state_vrefs_asid_pool_map)
+  apply clarsimp
+  apply (erule state_asids_to_policy_aux.cases)
+    apply (fastforce dest: sata_asid)
+  apply (subst (asm) state_vrefs_asid_pool_map; clarsimp)
+  apply (case_tac "asid_high_bits_of asid = asid_high_bits_of base")
+  apply (clarsimp simp: state_vrefs_def aobjs_of_Some vspace_objs_of_Some obj_at_def vs_refs_aux_def graph_of_def)
+  apply (drule sata_asid_lookup[rotated]; fastforce)
+  apply (clarsimp split: if_splits)
+  apply (fastforce simp: authorised_asid_control_inv_def is_aligned_no_overflow aag_wellformed_refl)
+  apply (fastforce dest: sata_asidpool)
+  done
+
+lemma perform_asid_control_invocation_pas_refined:
+  "\<lbrace>pas_refined aag and pas_cur_domain aag and invs and valid_aci aci and ct_active
+                    and K (authorised_asid_control_inv aag aci)\<rbrace>
+   perform_asid_control_invocation aci
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  apply (rule hoare_gen_asm)
+  apply (simp add: perform_asid_control_invocation_def )
+  apply wpc
+   apply (rule pas_refined_asid_control_helper bind_wp hoare_K_bind)+
+         apply (wp cap_insert_pas_refined' hoare_weak_lift_imp | simp)+
+      apply ((wp retype_region_pas_refined'[where sz=pageBits]
+                 hoare_vcg_ex_lift hoare_vcg_all_lift hoare_weak_lift_imp hoare_wp_combs hoare_drop_imp
+                 retype_region_invs_extras(1)[where sz = pageBits]
+                 retype_region_invs_extras(4)[where sz = pageBits]
+                 retype_region_invs_extras(6)[where sz = pageBits]
+                 retype_region_invs_extras(7)[where sz = pageBits]
+                 retype_region_cte_at_other'[where sz=pageBits]
+                 max_index_upd_invs_simple max_index_upd_caps_overlap_reserved
+                 hoare_vcg_ex_lift set_cap_cte_wp_at hoare_vcg_disj_lift set_free_index_valid_pspace
+                 set_cap_descendants_range_in set_cap_no_overlap get_cap_wp set_cap_caps_no_overlap
+                 hoare_vcg_all_lift hoare_weak_lift_imp retype_region_invs_extras
+                 set_cap_pas_refined_not_transferable arch_update_cap_valid_mdb
+             | simp add: do_machine_op_def region_in_kernel_window_def cte_wp_at_neg2)+)[3]
+   apply (rename_tac frame slot parent base )
+   apply (case_tac slot, rename_tac slot_ptr slot_idx)
+   apply (case_tac parent, rename_tac parent_ptr parent_idx)
+   apply (rule_tac Q'="\<lambda>rv s.
+             (\<exists>idx. cte_wp_at ((=) (UntypedCap False frame pageBits idx)) parent s) \<and>
+             (\<forall>x\<in>ptr_range frame pageBits. is_subject aag x) \<and>
+             pas_refined aag s \<and> pas_cur_domain aag s \<and>
+             pspace_no_overlap_range_cover frame pageBits s \<and>
+             invs s \<and> asid_table s (asid_high_bits_of base) = None \<and>
+             descendants_range_in {frame..(frame && ~~ mask pageBits) + 2 ^ pageBits - 1} parent s \<and>
+             range_cover frame pageBits (obj_bits_api (ArchObject ASIDPoolObj) 0) (Suc 0) \<and>
+             is_subject aag slot_ptr \<and> is_subject aag parent_ptr \<and> is_subject aag frame \<and>
+             pas_cap_cur_auth aag (ArchObjectCap (ASIDPoolCap frame base)) \<and>
+             (\<forall>x. asid_high_bits_of x = asid_high_bits_of base \<longrightarrow> is_subject_asid aag x)"
+             in hoare_strengthen_post)
+    apply (wp add: delete_objects_pspace_no_overlap hoare_vcg_ex_lift
+                   delete_objects_descendants_range_in delete_objects_invs_ex
+                   delete_objects_pas_refined
+              del: Untyped_AI.delete_objects_pspace_no_overlap
+           | simp add: )+
+   apply clarsimp
+   apply (rename_tac s idx)
+   apply (frule untyped_cap_aligned, simp add: invs_valid_objs)
+   apply (clarsimp simp: cte_wp_at_def aag_cap_auth_def ptr_range_def pas_refined_refl
+                         cap_links_asid_slot_def cap_links_irq_def obj_bits_api_def
+                         default_arch_object_def retype_addrs_def conj_ac
+                         invs_psp_aligned invs_valid_pspace invs_vspace_objs invs_arch_state)
+   apply (rule conjI, force intro: descendants_range_caps_no_overlapI simp: cte_wp_at_def)
+   apply (rule conjI, clarsimp simp: max_free_index_def)
+   apply (prop_tac "valid_cap (UntypedCap False frame pageBits idx) s")
+    apply (clarsimp simp: get_cap_caps_of_state)
+    apply (simp add: Untyped_AI.caps_of_state_valid)
+   apply (clarsimp simp: free_index_of_def max_free_index_def valid_cap_def)
+   apply (rule conjI)
+    apply (cut_tac s=s and ptr="(parent_ptr, parent_idx)" in cap_refs_in_kernel_windowD)
+      apply ((fastforce simp: caps_of_state_def cap_range_def)+)[3]
+   apply (fastforce simp: x_power_minus_1 is_aligned_no_overflow')
+  apply (clarsimp simp: valid_aci_def authorised_asid_control_inv_def cte_wp_at_caps_of_state)
+  apply (rule conjI)
+   apply (drule untyped_slots_not_in_untyped_range)
+        apply (erule empty_descendants_range_in)
+       apply (simp add: cte_wp_at_caps_of_state)
+      apply simp
+     apply simp
+    apply (rule subset_refl)
+   apply simp
+  apply (frule_tac x=x in bspec)
+   apply (simp add: is_aligned_no_overflow)
+  apply (clarsimp simp: ptr_range_def invs_psp_aligned invs_valid_objs aag_cap_auth_def
+                        descendants_range_def2 empty_descendants_range_in
+                        pas_refined_refl cap_links_asid_slot_def label_owns_asid_slot_def
+                        cap_links_irq_def range_cover_def obj_bits_api_def pageBits_def
+                        default_arch_object_def and_mask_eq_iff_shiftr_0 mask_zero)
+  apply (subst is_aligned_neg_mask_eq[THEN sym], assumption)
+  apply (intro conjI; fastforce intro: empty_descendants_range_in)
+  done
+
+definition authorised_asid_pool_inv :: "'a PAS \<Rightarrow> asid_pool_invocation \<Rightarrow> bool" where
+ "authorised_asid_pool_inv aag api \<equiv>
+  case api of Assign asid pool_ptr ct_slot \<Rightarrow>
+    is_subject aag pool_ptr \<and> is_subject aag (fst ct_slot) \<and> is_subject_asid aag asid"
+
+lemma perform_asid_pool_invocation_respects:
+  "\<lbrace>integrity aag X st and pas_refined aag and invs and valid_apinv api
+                       and K (authorised_asid_pool_inv aag api)\<rbrace>
+   perform_asid_pool_invocation api
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (unfold perform_asid_pool_invocation_def store_asid_pool_entry_def)
+  apply (wpsimp wp: set_asid_pool_integrity_autarch get_cap_wp
+                    set_cap_integrity_autarch hoare_drop_imps)
+  apply (clarsimp simp: authorised_asid_pool_inv_def)
+  done
+
+lemma store_pte_state_vrefs_unreachable:
+  "\<lbrace>\<lambda>s. P (state_vrefs s) \<and> pspace_aligned s \<and> valid_vspace_objs s \<and>
+        valid_asid_table s \<and> (\<forall>level. \<not> \<exists>\<rhd> (level, table_base pt_t p) s)\<rbrace>
+   store_pte pt_t p pte
+   \<lbrace>\<lambda>_ s. P (state_vrefs s)\<rbrace>"
+  supply fun_upd_apply[simp del]
+  apply (wpsimp simp: store_pte_def set_pt_def wp: set_object_wp)
+  apply (erule rsubst[where P=P])
+  apply (rule all_ext)
+  apply (rule allI, rename_tac x)
+  apply safe
+   apply (subst (asm) state_vrefs_def, clarsimp)
+   apply (rule state_vrefsD)
+      apply (subst vs_lookup_table_unreachable_upd_idem; fastforce)
+     apply (drule vs_lookup_level)
+     apply (prop_tac "x \<noteq> table_base pt_t p", clarsimp)
+     apply (fastforce simp: fun_upd_def aobjs_of_Some opt_map_def)
+    apply clarsimp
+   apply fastforce
+  apply (subst (asm) state_vrefs_def, clarsimp)
+  apply (rule state_vrefsD)
+     apply (subst (asm) vs_lookup_table_unreachable_upd_idem; fastforce)
+    apply (prop_tac "x \<noteq> table_base pt_t p")
+     apply (subst (asm) vs_lookup_table_unreachable_upd_idem; fastforce dest: vs_lookup_level)
+    apply (fastforce simp: fun_upd_def aobjs_of_Some)
+   apply clarsimp
+  apply clarsimp
+  done
+
+lemma store_asid_pool_entry_state_vrefs:
+  "\<lbrace>\<lambda>s. P (\<lambda>x. if x = pool_ptr
+               then vs_refs_aux asid_pool_level (ASIDPool (\<lambda>a. if a = asid_low_bits_of asid
+                                                               then Some (ASIDPoolVSpace None pt_base)
+                                                               else the (asid_pools_of s pool_ptr) a))
+               else if x = pt_base
+               then vs_refs_aux max_pt_level (the (vspace_objs_of s x))
+               else state_vrefs s x) \<and>
+        pspace_aligned s \<and> valid_vspace_objs s \<and> valid_asid_table s \<and>
+        pool_for_asid asid s = Some pool_ptr \<and>
+        (\<forall>pool. ako_at (ASIDPool pool) pool_ptr s \<longrightarrow> pool (asid_low_bits_of asid) = None) \<and>
+        (\<forall>level. \<not>\<exists>\<rhd> (level, pt_base) s) \<and>
+        (\<exists>pt. pts_of s pt_base = Some (empty_pt VSRootPT_T))\<rbrace>
+   store_asid_pool_entry pool_ptr asid (Some (ASIDPoolVSpace None pt_base))
+   \<lbrace>\<lambda>_ s. P (state_vrefs s)\<rbrace>"
+  unfolding store_asid_pool_entry_def set_asid_pool_def
+  apply (wpsimp wp: set_object_wp get_cap_wp)
+  apply (erule rsubst[where P=P])
+  apply (rule all_ext)
+  apply (clarsimp split del: if_split)
+  apply (prop_tac "is_aligned pt_base (pt_bits (pt_type (empty_pt VSRootPT_T)))")
+   apply (fastforce elim: pspace_aligned_pts_ofD dest: invs_psp_aligned)
+  apply safe
+   apply (clarsimp split: if_splits)
+     apply (frule pool_for_asid_vs_lookupD)
+     apply (rule_tac level=asid_pool_level in state_vrefsD)
+        apply (simp only: fun_upd_def)
+        apply (subst asid_pool_map.vs_lookup_table[simplified fun_upd_def])
+          apply (fastforce simp: asid_pool_map_def asid_pools_of_ko_at
+                                 valid_apinv_def asid_low_bits_of_def )
+         apply fastforce
+        apply fastforce
+       apply fastforce
+      apply (fastforce simp: ako_asid_pools_of)
+     apply (clarsimp simp: ako_asid_pools_of)
+    apply (rule_tac level=max_pt_level and vref=0 in state_vrefsD)
+       apply (simp only: fun_upd_def)
+       apply (subst asid_pool_map.vs_lookup_table[simplified fun_upd_def])
+         apply (fastforce simp: asid_pool_map_def asid_pools_of_ko_at
+                                valid_apinv_def asid_low_bits_of_def aobjs_of_Some)
+        apply clarsimp
+       apply fastforce
+      apply (fastforce simp: vspace_objs_of_Some pts_of_Some)
+     apply (fastforce simp: pts_of_Some)
+    apply (clarsimp simp: vspace_obj_of_def opt_map_def split: option.splits)
+   apply (clarsimp simp: obj_at_def)
+   apply (subst (asm) state_vrefs_def, clarsimp)
+   apply (rename_tac asida vref)
+   apply (rule_tac asid=asida in state_vrefsD)
+      apply (simp only: fun_upd_def)
+      apply (subst asid_pool_map.vs_lookup_table[simplified fun_upd_def])
+        apply (fastforce simp: asid_pool_map_def asid_pools_of_ko_at obj_at_def
+                               valid_apinv_def asid_low_bits_of_def aobjs_of_Some)
+       apply fastforce
+      apply (prop_tac "asid \<noteq> asida")
+       apply (fastforce simp: vs_lookup_table_def entry_for_pool_def vspace_for_pool_def
+                              asid_pools_of_ko_at obj_at_def
+                       split: if_splits)
+      apply fastforce
+     apply fastforce
+    apply fastforce
+   apply clarsimp
+  apply (subst (asm) state_vrefs_def, clarsimp split del: if_split)
+  apply (simp only: fun_upd_def)
+  apply (subst (asm) asid_pool_map.vs_lookup_table[simplified fun_upd_def])
+    apply (fastforce simp: asid_pool_map_def asid_pools_of_ko_at
+                           valid_apinv_def asid_low_bits_of_def aobjs_of_Some)
+   apply clarsimp
+  apply (case_tac "x = pool_ptr")
+   apply (prop_tac "asid_pools_of s pool_ptr = Some rv")
+    apply (clarsimp simp: asid_pools_of_ko_at obj_at_def)
+   apply (clarsimp simp: vs_refs_aux_def)
+  apply (case_tac "asida = asid \<and> bot \<le> max_pt_level"; clarsimp)
+  apply (clarsimp simp: vspace_obj_of_def opt_map_def split: option.splits)
+  apply (case_tac "x = pt_base")
+   apply (fastforce dest: vs_lookup_level)
+  apply clarsimp
+  apply (fastforce simp: state_vrefs_def vspace_obj_of_def opt_map_def split: option.splits)
+  done
+
+crunch store_asid_pool_entry
+  for irq_map_wellformed[wp]: "\<lambda>s. P (irq_map_wellformed aag s)"
+  and tcb_domain_map_wellformed[wp]: "\<lambda>s. P (tcb_domain_map_wellformed aag s)"
+  and state_irqs_to_policy[wp]: "\<lambda>s. P (state_irqs_to_policy aag s)"
+  and caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
+  and asid_table[wp]: "\<lambda>s. P (asid_table s)"
+  and cdt[wp]: "\<lambda>s. P (cdt s)"
+  and thread_st_auth[wp]: "\<lambda>s. P (thread_st_auth s)"
+  and thread_bound_ntfns[wp]: "\<lambda>s. P (thread_bound_ntfns s)"
+
+lemma store_asid_pool_entry_pas_refined:
+  "\<lbrace>\<lambda>s. pas_refined aag s \<and> pspace_aligned s \<and> valid_vspace_objs s \<and> valid_asid_table s \<and>
+        pool_for_asid asid s = Some pool_ptr \<and> is_subject aag pool_ptr \<and>
+        is_subject aag pt_base \<and> is_subject_asid aag asid \<and>
+        (\<forall>level. \<not>\<exists>\<rhd> (level, pt_base) s) \<and>
+        (\<forall>pool. ako_at (ASIDPool pool) pool_ptr s \<longrightarrow> pool (asid_low_bits_of asid) = None) \<and>
+        (\<exists>pt. pts_of s pt_base = Some (empty_pt VSRootPT_T))\<rbrace>
+   store_asid_pool_entry pool_ptr asid (Some (ASIDPoolVSpace None pt_base))
+   \<lbrace>\<lambda>_ s. pas_refined aag s\<rbrace>"
+  apply (clarsimp simp: pas_refined_def state_objs_to_policy_def)
+  apply (rule hoare_pre)
+   apply wps
+   apply (wp store_asid_pool_entry_state_vrefs store_asid_pool_entry_state_vrefs)
+  apply (clarsimp simp: auth_graph_map_def)
+  apply (frule (1) pool_for_asid_validD)
+  apply clarsimp
+  apply (rule conjI; clarsimp)
+   apply (erule state_bits_to_policy.cases)
+         apply (fastforce simp: state_objs_to_policy_def dest: sbta_caps)
+        apply (fastforce simp: state_objs_to_policy_def dest: sbta_untyped)
+       apply (fastforce simp: state_objs_to_policy_def dest: sbta_ts)
+      apply (fastforce simp: state_objs_to_policy_def dest: sbta_bounds)
+     apply (fastforce simp: state_objs_to_policy_def dest: sbta_cdt)
+    apply (fastforce simp: state_objs_to_policy_def dest: sbta_cdt_transferable)
+   apply (case_tac "ptr = pool_ptr")
+    apply (clarsimp simp: vs_refs_aux_def graph_of_def aag_wellformed_refl split: if_splits)
+    apply (erule subsetD)
+    apply clarsimp
+    apply (rule_tac x=pool_ptr in exI, clarsimp)
+    apply (rule exI, rule conjI, rule refl)
+    apply (rule sbta_vref)
+    apply (drule pool_for_asid_vs_lookupD)
+    apply (erule_tac vref=0 in state_vrefsD)
+      apply (fastforce simp: asid_pools_of_ko_at aobjs_of_ako_at_Some vspace_objs_of_Some)
+     apply clarsimp
+    apply (fastforce simp: vs_refs_aux_def graph_of_def)
+   apply (fastforce simp: vs_refs_aux_def empty_pt_def vspace_obj_of_def opt_map_def
+                          graph_of_def pts_of_Some pte_ref2_def
+                    dest: sbta_vref split: if_splits option.splits)
+  apply (erule state_asids_to_policy_aux.cases)
+    apply (erule subsetD[where A="state_asids_to_policy_aux _ _ _ _"])
+    apply (fastforce dest: sata_asid)
+   apply (case_tac "poolptr = pool_ptr")
+    apply (clarsimp simp: vs_refs_aux_def graph_of_def obj_at_def split: if_splits)
+     apply (clarsimp simp: pool_for_asid_def asid_pools_of_ko_at valid_asid_table_def inj_on_def)
+     apply (drule_tac x="asid_high_bits_of asid" in bspec, clarsimp)
+     apply (drule_tac x="asid_high_bits_of asida" in bspec, clarsimp)
+     apply clarsimp
+     apply (drule asid_high_low_inj[rotated])
+      apply (simp add: asid_low_bits_of_mask_eq[symmetric])
+      apply (prop_tac "is_up UCAST(9 \<rightarrow> 16) \<and> is_up UCAST(9 \<rightarrow> 64)")
+       apply (clarsimp simp: is_up_def source_size_def target_size_def word_size)
+      apply (clarsimp simp: ucast_ucast_b)
+      apply (metis ucast_up_ucast_id)
+     apply (fastforce simp: aag_wellformed_refl)
+    apply (erule subsetD[where A="state_asids_to_policy_aux _ _ _ _"])
+    apply (rule sata_asid_lookup, fastforce)
+    apply (frule pool_for_asid_vs_lookupD)
+    apply (erule_tac vref=0 in state_vrefsD)
+      apply (fastforce simp: asid_pools_of_ko_at aobjs_of_ako_at_Some vspace_objs_of_Some)
+     apply simp
+    apply (fastforce simp: vs_refs_aux_def graph_of_def)
+   apply (case_tac "poolptr = pt_base")
+    apply (fastforce simp: vs_refs_aux_def pts_of_Some empty_pt_def vspace_obj_of_def opt_map_def
+                    split: option.splits)
+   apply (erule subsetD[where A="state_asids_to_policy_aux _ _ _ _"])
+   apply (fastforce simp: sata_asid_lookup)
+  apply (erule subsetD[where A="state_asids_to_policy_aux _ _ _ _"])
+  apply (fastforce simp: sata_asidpool)
+  done
+
+lemma perform_asid_pool_invocation_pas_refined [wp]:
+  "\<lbrace>pas_refined aag and invs and valid_apinv api and K (authorised_asid_pool_inv aag api)\<rbrace>
+   perform_asid_pool_invocation api
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  apply (simp add: perform_asid_pool_invocation_def)
+  apply (strengthen invs_psp_aligned invs_vspace_objs valid_arch_state_asid_table invs_arch_state |
+         wpsimp simp: ako_asid_pools_of
+                  wp: store_asid_pool_entry_pas_refined set_cap_pas_refined get_cap_wp
+                      arch_update_cap_invs_map hoare_vcg_all_lift hoare_vcg_imp_lift')+
+  apply (clarsimp simp: cte_wp_at_caps_of_state valid_apinv_def cong: conj_cong)
+  apply (clarsimp simp: is_PageTableCap_def is_ArchObjectCap_def)
+  apply (clarsimp simp: authorised_asid_pool_inv_def is_arch_update_def update_map_data_def
+                        is_cap_simps cap_master_cap_def asid_bits_of_defs
+                 split: option.splits)
+  apply (intro conjI)
+      apply (fastforce dest: cap_cur_auth_caps_of_state pas_refined_refl
+                       simp: aag_cap_auth_def cap_auth_conferred_def arch_cap_auth_conferred_def
+                             cap_links_asid_slot_def label_owns_asid_slot_def cap_links_irq_def)
+     apply (fastforce dest: caps_of_state_valid
+                      simp: update_map_data_def valid_cap_def cap_aligned_def wellformed_mapdata_def)
+    apply (fastforce dest: cap_cur_auth_caps_of_state pas_refined_Control
+                     simp: aag_cap_auth_def cap_auth_conferred_def arch_cap_auth_conferred_def)
+   apply (frule (1) caps_of_state_valid)
+   apply (clarsimp simp: valid_cap_def)
+   apply (clarsimp simp: obj_at_def)
+   apply (rename_tac asid' pool_ptr a b acap_obj level asid vref pt)
+   apply (drule (1) vs_lookup_table_valid_cap; clarsimp)
+   apply (frule (1) cap_to_pt_is_pt_cap_and_type)
+     apply (simp add: pts_of_Some aobjs_of_Some)
+    apply (fastforce intro: valid_objs_caps)
+   apply (drule (1) unique_table_refsD[rotated]; clarsimp simp: is_cap_simps)
+  apply (fastforce dest: invs_valid_table_caps simp: valid_table_caps_def is_vsroot_cap_def )
+  done
+
+lemma perform_vspace_invocation_respects[wp]:
+  "perform_vspace_invocation iv \<lbrace>integrity aag X st\<rbrace>"
+  unfolding perform_vspace_invocation_def perform_flush_def
+  by (wpsimp wp: dmo_no_mem_respects)
+
+crunch perform_vspace_invocation
+  for pas_refined[wp]: "pas_refined aag"
+
+(* FIXME AARCH64: move these *)
+lemma tcb_states_of_state_fun_upd:
+  "map_option tcb_state (get_tcb p s) = (case val of TCB tcb \<Rightarrow> Some (tcb_state tcb) | _ \<Rightarrow> None)
+   \<Longrightarrow> tcb_states_of_state (s\<lparr>kheap := (kheap s)(p \<mapsto> val)\<rparr>) = tcb_states_of_state s"
+  by (fastforce simp: tcb_states_of_state_def get_tcb_def split: kernel_object.splits)
+
+lemma thread_st_auth_fun_upd:
+  "map_option tcb_state (get_tcb p s) = (case val of TCB tcb \<Rightarrow> Some (tcb_state tcb) | _ \<Rightarrow> None)
+   \<Longrightarrow> thread_st_auth (s\<lparr>kheap := (kheap s)(p \<mapsto> val)\<rparr>) = thread_st_auth s"
+  by (auto simp: tcb_states_of_state_fun_upd thread_st_auth_def)
+
+lemma thread_bound_ntfns_fun_upd:
+  "map_option tcb_bound_notification (get_tcb p s) =
+   (case val of TCB tcb \<Rightarrow> Some (tcb_bound_notification tcb) | _ \<Rightarrow> None)
+   \<Longrightarrow> thread_bound_ntfns (s\<lparr>kheap := (kheap s)(p \<mapsto> val)\<rparr>) = thread_bound_ntfns s"
+  by (fastforce simp: thread_bound_ntfns_def get_tcb_def split: kernel_object.splits)
+
+lemma vcpu_save_reg_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> option_map fst (arm_current_vcpu (arch_state s)) = Some vr\<rbrace>
+    vcpu_save_reg vr reg
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vcpu_save_reg_def vcpu_update_def
+  apply (wpsimp wp: set_vcpu_wp get_vcpu_wp hoare_vcg_all_lift hoare_vcg_imp_lift dmo_wp
+              simp: readVCPUHardwareReg_def)
+  apply (clarsimp simp: integrity_def)
+  apply (subst tcb_states_of_state_fun_upd, fastforce simp: get_tcb_def obj_at_def)+
+  apply (rule conjI)
+   apply (erule_tac x=vr in allE)+
+   apply (auto elim!: tro_trans_spec simp: in_opt_map_eq
+              intro!: tro_arch arch_troa_vcpu_save_reg)[1]
+  apply (rule ccontr)
+  apply (auto simp: in_opt_map_eq)
+  done
+
+lemma save_virt_timer_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> option_map fst (arm_current_vcpu (arch_state s)) = Some vr\<rbrace>
+   save_virt_timer vr
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+   (is "valid ?P _ _")
+  unfolding save_virt_timer_def vcpu_update_def
+  apply (wpsimp wp: set_vcpu_wp get_vcpu_wp hoare_vcg_all_lift hoare_vcg_imp_lift
+              simp: readVCPUHardwareReg_def read_cntpct_def)+
+         apply (wp dmo_wp)
+        apply (rule_tac Q'="K ?P" in hoare_strengthen_post[rotated])
+         apply (clarsimp simp: integrity_def simp del: fun_upd_apply)
+         apply (subst tcb_states_of_state_fun_upd; clarsimp simp: get_tcb_def obj_at_def)+
+         apply (rule conjI)
+          apply (erule_tac x=vr in allE)+
+          apply (auto elim!: tro_trans_spec simp: in_opt_map_eq
+                     intro!: tro_arch arch_troa_vcpu_save_virt_timer)[1]
+         apply (rule ccontr)
+         apply (auto simp: in_opt_map_eq)[1]
+  by (wpsimp wp: dmo_no_mem_respects vcpu_save_reg_respects)+
+
+lemma vgic_update_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> option_map fst (arm_current_vcpu (arch_state s)) = Some vr
+                              \<and> v = getf (machine_state s)
+                              \<and> (setf = vgic_hcr_update \<and> getf = gic_vcpu_ctrl_hcr_val \<or>
+                                 setf = vgic_vmcr_update \<and> getf = gic_vcpu_ctrl_vmcr_val \<or>
+                                 setf = vgic_apr_update \<and> getf = gic_vcpu_ctrl_apr_val)\<rbrace>
+    vgic_update vr (setf (\<lambda>_. v))
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vgic_update_def vcpu_update_def
+  apply (wpsimp wp: set_vcpu_wp get_vcpu_wp dmo_wp)
+  apply (clarsimp simp: integrity_def)
+  apply (subst tcb_states_of_state_fun_upd, fastforce simp: get_tcb_def obj_at_def)+
+  apply (rule conjI)
+   apply (erule_tac x=vr in allE)+
+   apply (auto elim!: tro_trans_spec simp: in_opt_map_eq
+              intro!: tro_arch arch_troa_vcpu_save_vgic)[1]
+  apply (rule ccontr)
+  apply (auto simp: in_opt_map_eq)
+  done
+
+lemmas vgic_updates_respect =
+  vgic_update_respects[where setf=vgic_hcr_update and getf=gic_vcpu_ctrl_hcr_val, simplified]
+  vgic_update_respects[where setf=vgic_vmcr_update and getf=gic_vcpu_ctrl_vmcr_val, simplified]
+  vgic_update_respects[where setf=vgic_apr_update and getf=gic_vcpu_ctrl_apr_val, simplified]
+
+lemma get_gic_vcpu_ctrl_rvs:
+  "\<lbrace>\<lambda>_. True\<rbrace> do_machine_op get_gic_vcpu_ctrl_hcr \<lbrace>\<lambda>rv s. rv = gic_vcpu_ctrl_hcr_val (machine_state s)\<rbrace>"
+  "\<lbrace>\<lambda>_. True\<rbrace> do_machine_op get_gic_vcpu_ctrl_vmcr \<lbrace>\<lambda>rv s. rv = gic_vcpu_ctrl_vmcr_val (machine_state s)\<rbrace>"
+  "\<lbrace>\<lambda>_. True\<rbrace> do_machine_op get_gic_vcpu_ctrl_apr \<lbrace>\<lambda>rv s. rv = gic_vcpu_ctrl_apr_val (machine_state s)\<rbrace>"
+  unfolding get_gic_vcpu_ctrl_hcr_def get_gic_vcpu_ctrl_vmcr_def get_gic_vcpu_ctrl_apr_def
+  by (wpsimp wp: dmo_wp)+
+
+lemma vcpu_disable_None_respects[wp]:
+  "vcpu_disable None \<lbrace>integrity aag X st\<rbrace>"
+  unfolding vcpu_disable_def
+  by (wpsimp wp: dmo_no_mem_respects)
+
+lemma vcpu_disable_Some_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> option_map fst (arm_current_vcpu (arch_state s)) = Some vcpu\<rbrace>
+   vcpu_disable (Some vcpu)
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vcpu_disable_def
+  by (wpsimp wp: dmo_no_mem_respects vcpu_save_reg_respects
+                 save_virt_timer_respects vgic_updates_respect get_gic_vcpu_ctrl_rvs)
+
+lemma vgic_update_lr_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> option_map fst (arm_current_vcpu (arch_state s)) = Some vr
+                             \<and> lr = gic_vcpu_ctrl_lr_val (word_of_nat vreg) (machine_state s)\<rbrace>
+   vgic_update_lr vr vreg lr
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vgic_update_lr_def vgic_update_def vcpu_update_def
+  apply (wpsimp wp: set_vcpu_wp get_vcpu_wp dmo_wp hoare_vcg_all_lift hoare_vcg_imp_lift)+
+  apply (clarsimp simp: integrity_def)
+  apply (subst tcb_states_of_state_fun_upd, fastforce simp: get_tcb_def obj_at_def)+
+  apply (rule conjI)
+   apply (erule_tac x=vr in allE)+
+   apply (auto elim!: tro_trans_spec simp: in_opt_map_eq
+              intro!: tro_arch arch_troa_vcpu_save_vgic)[1]
+  apply (rule ccontr)
+  apply (auto simp: in_opt_map_eq)
+  done
+
+lemma vcpu_save_reg_range_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> map_option fst (arm_current_vcpu (arch_state s)) = Some vr\<rbrace>
+   vcpu_save_reg_range vr from to
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vcpu_save_reg_range_def
+  apply (rule_tac Q'="\<lambda>_. P" and P=P for P in hoare_strengthen_post)
+  by (wpsimp wp: mapM_x_wp' vcpu_save_reg_respects)+
+
+lemma vcpu_save_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> arm_current_vcpu (arch_state s) = vb\<rbrace>
+   vcpu_save vb
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  by (wpsimp wp: vcpu_save_reg_range_respects mapM_wp' vgic_update_lr_respects
+                 vgic_updates_respect dmo_no_mem_respects get_gic_vcpu_ctrl_rvs
+                 save_virt_timer_respects vcpu_save_reg_respects
+           simp: vcpu_save_def get_gic_vcpu_ctrl_lr_def
+      | wp dmo_wp)+
+
+crunch vcpu_enable, vcpu_restore
+  for integrity_autarch: "integrity aag X st"
+  (wp: dmo_no_mem_respects mapM_wp' mapM_x_wp')
+
+lemma vcpu_switch_integrity:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> (\<forall>v. vcpu = Some v \<longrightarrow> is_subject aag v)\<rbrace>
+   vcpu_switch vcpu
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vcpu_switch_def
+  by (wpsimp wp: vcpu_restore_integrity_autarch vcpu_save_respects vcpu_enable_integrity_autarch
+                 vcpu_disable_Some_respects dmo_no_mem_respects)+
+
+lemma vcpu_restore_reg_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> (\<forall>v a. arm_current_vcpu (arch_state s) = Some (v,a) \<longrightarrow> v = vcpu)\<rbrace>
+   vcpu_restore_reg vcpu reg
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vcpu_restore_reg_def
+  by (wpsimp wp: dmo_no_mem_respects)
+
+lemma restore_virt_timer_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> option_map fst (arm_current_vcpu (arch_state s)) = Some vr\<rbrace>
+   restore_virt_timer vr
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  (is "valid ?P _ _")
+  unfolding restore_virt_timer_def vcpu_write_reg_def vcpu_update_def vcpu_read_reg_def read_cntpct_def
+  apply (wpsimp wp: vcpu_restore_reg_respects set_vcpu_wp get_vcpu_wp
+                    dmo_no_mem_respects dmo_wp hoare_vcg_imp_lift
+          simp_del: fun_upd_apply)
+    apply (rule_tac Q'="K ?P" in hoare_strengthen_post[rotated])
+     apply (clarsimp simp: integrity_def)
+     apply (subst tcb_states_of_state_fun_upd, fastforce simp: get_tcb_def obj_at_def)+
+     apply (rule conjI)
+      apply (erule_tac x=vr in allE)+
+      apply (auto elim!: tro_trans_spec simp: in_opt_map_eq
+                 intro!: tro_arch arch_troa_vcpu_restore_vtimer)[1]
+     apply (rule ccontr)
+     apply (auto simp: in_opt_map_eq)[1]
+    apply (wpsimp wp: vcpu_restore_reg_respects)+
+  done
+
+lemma vcpu_enable_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> option_map fst (arm_current_vcpu (arch_state s)) = Some vr\<rbrace>
+   vcpu_enable vr
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vcpu_enable_def
+  by (wpsimp wp: restore_virt_timer_respects vcpu_restore_reg_respects dmo_no_mem_respects)
+
+lemma vcpu_restore_respects:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> option_map fst (arm_current_vcpu (arch_state s)) = Some vr\<rbrace>
+   vcpu_restore vr
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vcpu_restore_def vcpu_restore_reg_range_def
+  by (wpsimp wp: vcpu_enable_respects vcpu_restore_reg_respects dmo_no_mem_respects mapM_x_wp' mapM_wp')
+
+lemma vcpu_switch_respects:
+  "vcpu_switch vcpu \<lbrace>integrity aag X st\<rbrace>"
+  unfolding vcpu_switch_def
+  by (wpsimp wp: vcpu_restore_respects vcpu_disable_Some_respects
+                 vcpu_save_respects vcpu_enable_respects dmo_no_mem_respects)
+
+lemma arch_thread_set_integrity_autarch:
+  "\<lbrace>integrity aag X st and K (is_subject aag ptr)\<rbrace>
+    arch_thread_set f ptr
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding arch_thread_set_def
+  by (wpsimp wp: set_object_integrity_autarch)
+
+lemma vcpu_invalidate_active_respects[wp]:
+  "vcpu_invalidate_active
+   \<lbrace>integrity aag X st\<rbrace>"
+  unfolding vcpu_invalidate_active_def
+  by wpsimp
+
+lemma dissociate_vcpu_tcb_respects:
+  "\<lbrace>integrity aag X st and K (is_subject aag vcpu \<and> is_subject aag tcb)\<rbrace>
+   dissociate_vcpu_tcb vcpu tcb
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding dissociate_vcpu_tcb_def set_vcpu_def get_vcpu_def arch_thread_get_def
+  by (wpsimp wp: as_user_integrity_autarch set_object_integrity_autarch
+                 arch_thread_set_integrity_autarch)
+
+crunch vcpu_invalidate_active
+  for vcpus_of[wp]: "\<lambda>s. P (vcpus_of s)"
+  (simp: vcpu_invalidate_active_def vcpu_disable_def)
+
+lemma thread_set_vcpus_of[wp]:
+  "thread_set f tptr \<lbrace>\<lambda>s. P (vcpus_of s)\<rbrace>"
+  unfolding thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (erule_tac P=P in rsubst)
+  apply (fastforce simp: get_tcb_def opt_map_def split: option.splits kernel_object.splits)
+  done
+
+lemma dissociate_vcpu_tcb_vcpus_of:
+  "\<lbrace>\<lambda>s. P ((vcpus_of s)(v := Some ((the (vcpus_of s v))\<lparr>vcpu_tcb := None\<rparr>)))\<rbrace>
+   dissociate_vcpu_tcb v tcb
+   \<lbrace>\<lambda>_ s. P (vcpus_of s)\<rbrace>"
+  unfolding dissociate_vcpu_tcb_def
+  by (wpsimp wp: as_user_wp_thread_set_helper hoare_drop_imps get_vcpu_wp simp: fun_upd_def)
+
+lemma associate_vcpu_tcb_respects:
+  "\<lbrace>integrity aag X st and K (is_subject aag vcpu) and K (is_subject aag tcb)\<rbrace>
+   associate_vcpu_tcb vcpu tcb
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding associate_vcpu_tcb_def
+  apply (wpsimp wp: vcpu_switch_integrity set_vcpu_integrity_autarch hoare_drop_imps
+                    arch_thread_set_integrity_autarch dissociate_vcpu_tcb_respects get_vcpu_wp)
+    apply (rule_tac Q'="\<lambda>a b. integrity aag X st b \<and> is_subject aag vcpu \<and> is_subject aag tcb \<and>
+                              (\<forall>v x. vcpus_of b vcpu = Some v \<and> vcpu_tcb v = Some x \<longrightarrow> is_subject aag x)"
+                 in hoare_strengthen_post)
+     apply (wpsimp wp: dissociate_vcpu_tcb_respects dissociate_vcpu_tcb_vcpus_of arch_thread_get_wp)+
+  apply (fastforce intro: associated_vcpu_is_subject associated_tcb_is_subject
+                    simp: get_tcb_def obj_at_def opt_map_def
+                   split: option.splits)
+  done
+
+lemma invoke_vcpu_inject_irq_respects:
+  "\<lbrace>integrity aag X st and K (is_subject aag vcpu)\<rbrace>
+   invoke_vcpu_inject_irq vcpu index vir
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding invoke_vcpu_inject_irq_def set_gic_vcpu_ctrl_lr_def vgic_update_lr_def vgic_update_def
+  by (wpsimp wp: vcpu_update_integrity_autarch)
+
+lemma invoke_vcpu_read_register_respects:
+  "invoke_vcpu_read_register vcpu reg \<lbrace>integrity aag X st\<rbrace>"
+  unfolding invoke_vcpu_read_register_def read_vcpu_register_def readVCPUHardwareReg_def
+  by wpsimp
+
+lemma invoke_vcpu_write_register_respects:
+  "\<lbrace>integrity aag X st and K (is_subject aag vcpu)\<rbrace>
+   invoke_vcpu_write_register vcpu reg val
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding invoke_vcpu_write_register_def write_vcpu_register_def
+            vcpu_write_reg_def writeVCPUHardwareReg_def
+  by (wpsimp wp: vcpu_update_integrity_autarch)
+
+lemma invoke_vcpu_ack_vppi_respects:
+  "\<lbrace>integrity aag X st and K (is_subject aag vcpu)\<rbrace>
+   invoke_vcpu_ack_vppi vcpu vppi
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding invoke_vcpu_ack_vppi_def
+  by (wpsimp wp: vcpu_update_integrity_autarch)
+
+
+definition authorised_vcpu_inv where
+  "authorised_vcpu_inv aag iv \<equiv>
+   case iv of VCPUSetTCB vcpu tcb \<Rightarrow> is_subject aag vcpu \<and> is_subject aag tcb
+            | VCPUInjectIRQ vcpu index vir \<Rightarrow> is_subject aag vcpu
+            | VCPUReadRegister vcpu reg \<Rightarrow> is_subject aag vcpu
+            | VCPUWriteRegister vcpu reg val \<Rightarrow> is_subject aag vcpu
+            | VCPUAckVPPI vcpu vppi \<Rightarrow> is_subject aag vcpu"
+
+lemma perform_vcpu_invocation_respects[wp]:
+  "\<lbrace>integrity aag X st and K (authorised_vcpu_inv aag iv) and pas_refined aag
+                       and invs and valid_vcpu_invocation iv and is_subject aag \<circ> cur_thread\<rbrace>
+   perform_vcpu_invocation iv
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding perform_vcpu_invocation_def
+  apply (wpsimp wp: associate_vcpu_tcb_respects invoke_vcpu_ack_vppi_respects invoke_vcpu_inject_irq_respects
+                    invoke_vcpu_read_register_respects invoke_vcpu_write_register_respects)
+  apply (auto simp: authorised_vcpu_inv_def)
+  done
+
+lemma set_vcpu_thread_bound_ntfns[wp]:
+  "set_vcpu ptr vcpu \<lbrace>\<lambda>s. P (thread_bound_ntfns s)\<rbrace>"
+  apply (wpsimp wp: set_vcpu_wp)
+  apply (erule_tac P=P in rsubst)
+  apply (rule ext)
+  apply (clarsimp simp: thread_bound_ntfns_def get_tcb_def obj_at_def)
+  done
+
+lemma arch_thread_set_thread_bound_ntfns[wp]:
+  "arch_thread_set f tptr \<lbrace>\<lambda>s. P (thread_bound_ntfns s)\<rbrace>"
+  apply (wpsimp wp: arch_thread_set_wp)
+  apply (erule_tac P=P in rsubst)
+  apply (rule ext)
+  apply (clarsimp simp: thread_bound_ntfns_def get_tcb_def obj_at_def)
+  done
+
+lemma set_vcpu_thread_st_auth[wp]:
+  "set_vcpu ptr vcpu \<lbrace>\<lambda>s. P (thread_st_auth s)\<rbrace>"
+  apply (wpsimp wp: set_vcpu_wp)
+  apply (erule_tac P=P in rsubst)
+  apply (rule ext)
+  apply (clarsimp simp: thread_st_auth_def tcb_states_of_state_def get_tcb_def obj_at_def)
+  done
+
+lemma arch_thread_thread_st_auth[wp]:
+  "arch_thread_set f tptr \<lbrace>\<lambda>s. P (thread_st_auth s)\<rbrace>"
+  apply (wpsimp wp: arch_thread_set_wp)
+  apply (erule_tac P=P in rsubst)
+  apply (rule ext)
+  apply (clarsimp simp: thread_st_auth_def tcb_states_of_state_def get_tcb_def obj_at_def)
+  done
+
+crunch perform_vcpu_invocation
+  for irq_map_wellformed[wp]: "irq_map_wellformed aag"
+  and state_irqs_to_policy[wp]: "\<lambda>s. P (state_irqs_to_policy aag s)"
+  and caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
+  and interrupt_irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
+  and domains_of_state[wp]: "\<lambda>s. P (domains_of_state s)"
+  and asid_table[wp]: "\<lambda>s. P (asid_table s)"
+  and cdt[wp]: "\<lambda>s. P (cdt s)"
+  and tcb_bound_notification[wp]: "\<lambda>s. P (thread_bound_ntfns s)"
+  and thread_st_auth[wp]: "\<lambda>s. P (thread_st_auth s)"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma set_vcpu_valid_asid_table[wp]:
+  "set_vcpu p v \<lbrace>valid_asid_table\<rbrace>"
+  apply (wpsimp wp: set_vcpu_wp)
+  apply (clarsimp simp: obj_at_def opt_map_def)
+  done
+
+lemma arch_thread_set_valid_asid_table[wp]:
+  "arch_thread_set f t \<lbrace>valid_asid_table\<rbrace>"
+  apply (wpsimp wp: arch_thread_set_wp)
+  apply (clarsimp simp: get_tcb_def obj_at_def opt_map_def
+                 split: option.splits kernel_object.splits)
+  done
+
+lemma as_user_asid_pools_of[wp]:
+  "as_user t f \<lbrace>\<lambda>s. P (asid_pools_of s)\<rbrace>"
+  unfolding as_user_def
+  apply (wpsimp wp: set_object_wp)
+  apply (erule_tac P=P in rsubst)
+  apply (fastforce simp: get_tcb_def opt_map_def split: option.splits)
+  done
+
+lemma as_user_valid_asid_table[wp]:
+  "as_user t f \<lbrace>valid_asid_table\<rbrace>"
+  apply (rule hoare_lift_Pf[where f=asid_table])
+   apply (rule hoare_lift_Pf[where f=asid_pools_of])
+    apply wpsimp+
+  done
+
+lemma set_vcpu_vspace_objs_of[wp]:
+  "set_vcpu p vcpu \<lbrace>\<lambda>s. P (vspace_objs_of s)\<rbrace>"
+  apply (wpsimp wp: set_vcpu_wp)
+  apply (clarsimp simp: opt_map_def typ_at_eq_kheap_obj)
+  done
+
+lemma thread_set_vspace_objs_of[wp]:
+  "thread_set f tptr \<lbrace>\<lambda>s. P (vspace_objs_of s)\<rbrace>"
+  unfolding thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (erule_tac P=P in rsubst)
+  apply (fastforce simp: get_tcb_def opt_map_def split: option.splits kernel_object.splits)
+  done
+
+lemma arch_thread_set_vspace_objs_of[wp]:
+  "arch_thread_set f tptr \<lbrace>\<lambda>s. P (vspace_objs_of s)\<rbrace>"
+  apply (wpsimp wp: arch_thread_set_wp)
+  apply (fastforce simp: get_tcb_def opt_map_def split: option.splits kernel_object.splits)
+  done
+
+(* FIXME AARCH64: weaken in ArchKHeap_AI *)
+lemma vs_lookup_vspace_objs_lift:
+  assumes "\<And>P. f \<lbrace>\<lambda>s. P (vspace_objs_of s)\<rbrace>"
+  assumes "\<And>P. f \<lbrace>\<lambda>s. P (asid_table s)\<rbrace>"
+  shows "f \<lbrace>\<lambda>s. P (vs_lookup s)\<rbrace>"
+  by (intro vs_lookup_lift vspace_objs_of_pts_lift vspace_objs_of_aps_lift assms)
+
+crunch dissociate_vcpu_tcb
+  for valid_asid_table[wp]: "valid_asid_table"
+  (wp: crunch_wps)
+
+crunch perform_vcpu_invocation
+  for vspace_objs_of[wp]: "\<lambda>s. P (vspace_objs_of s)"
+  (wp: crunch_wps as_user_wp_thread_set_helper)
+
+lemma perform_vcpu_invocation_state_vrefs[wp]:
+  "perform_vcpu_invocation iv \<lbrace>\<lambda>s. P (state_vrefs s)\<rbrace>"
+  unfolding state_vrefs_def
+  apply (rule hoare_lift_Pf[where f=vspace_objs_of] )
+   apply (rule vs_lookup_vspace_objs_lift)
+    apply wpsimp+
+  done
+
+crunch perform_vcpu_invocation
+  for pas_refined[wp]: "pas_refined aag"
+  (simp: pas_refined_def state_objs_to_policy_def ignore: perform_vcpu_invocation)
+
+
+definition authorised_arch_inv :: "'a PAS \<Rightarrow> arch_invocation \<Rightarrow> 's :: state_ext state \<Rightarrow> bool" where
+ "authorised_arch_inv aag ai s \<equiv> case ai of
+     InvokePageTable pti \<Rightarrow> authorised_page_table_inv aag pti
+   | InvokePage pgi \<Rightarrow> authorised_page_inv aag pgi s
+   | InvokeASIDControl aci \<Rightarrow> authorised_asid_control_inv aag aci
+   | InvokeASIDPool api \<Rightarrow> authorised_asid_pool_inv aag api
+   | InvokeVCPU vi \<Rightarrow> authorised_vcpu_inv aag vi
+   | InvokeVSpace vi \<Rightarrow> True"
+
+lemma invoke_arch_respects:
+  "\<lbrace>integrity aag X st and authorised_arch_inv aag ai and pas_refined aag and invs
+                       and valid_arch_inv ai and is_subject aag \<circ> cur_thread\<rbrace>
+   arch_perform_invocation ai
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (simp add: arch_perform_invocation_def)
+  apply (wpsimp wp: perform_page_table_invocation_respects perform_page_invocation_respects
+                    perform_asid_control_invocation_respects perform_asid_pool_invocation_respects
+                    perform_vspace_invocation_respects)
+  apply (auto simp: authorised_arch_inv_def valid_arch_inv_def)
+  done
+
+lemma invoke_arch_pas_refined:
+  "\<lbrace>pas_refined aag and pas_cur_domain aag and invs and ct_active
+                    and valid_arch_inv ai and authorised_arch_inv aag ai\<rbrace>
+   arch_perform_invocation ai
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  apply (simp add: arch_perform_invocation_def valid_arch_inv_def)
+  apply (wpsimp wp: perform_page_table_invocation_pas_refined perform_asid_pool_invocation_pas_refined
+                    perform_page_invocation_pas_refined perform_asid_control_invocation_pas_refined)+
+  apply (auto simp: authorised_arch_inv_def)
+  done
+
+lemma vspace_for_asid_is_subject:
+  "\<lbrakk> vspace_for_asid a s = Some xaa; pas_refined aag s; valid_asid_table s; is_subject_asid aag a \<rbrakk>
+     \<Longrightarrow> is_subject aag xaa"
+  apply (frule vspace_for_asid_vs_lookup)
+  apply (clarsimp simp: vspace_for_asid_def entry_for_asid_def)
+  apply (frule pool_for_asid_vs_lookupD)
+  apply (clarsimp simp: vspace_for_pool_def entry_for_pool_def pool_for_asid_def asid_pools_of_ko_at )
+  apply (frule_tac pdptr = "(ap_vspace v'a)" and vrefs="state_vrefs s" and a=Control in sata_asid_lookup)
+   apply (fastforce simp: vs_refs_aux_def graph_of_def asid_low_bits_of_mask_eq[symmetric]
+                          ucast_ucast_b is_up_def opt_map_def source_size_def target_size_def
+                          word_size pas_refined_def obj_at_def
+                    dest: aag_wellformed_Control
+                  intro!: state_vrefsD)+
+  done
+
+lemma decode_page_table_invocation_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (is_PageTableCap cap \<and> (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                                          aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                                          is_subject aag (fst slot) \<and>
+                                          (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v)))\<rbrace>
+   decode_page_table_invocation label msg slot cap excaps
+   \<lbrace>\<lambda>rv. authorised_arch_inv aag rv\<rbrace>, -"
+  apply (rule hoare_gen_asmE)
+  apply (clarsimp simp: is_PageTableCap_def)
+  apply (rename_tac x xa)
+  apply (unfold decode_page_table_invocation_def decode_pt_inv_map_def authorised_arch_inv_def)
+  apply (wpsimp simp: Let_def is_final_cap_def if_fun_split)
+  apply (clarsimp simp: cte_wp_at_caps_of_state)
+  apply (rename_tac x t m s)
+  apply (prop_tac "\<forall>y \<in> set [x, x + 2 ^ pte_bits .e. x + 2 ^ pt_bits t - 1]. table_base t y = x")
+   apply (drule (1) caps_of_state_aligned_page_table)
+   apply (clarsimp simp only: is_aligned_neg_mask_eq' add_mask_fold)
+   apply (drule subsetD[OF upto_enum_step_subset], clarsimp)
+   apply (drule_tac n="pt_bits t" in neg_mask_mono_le)
+   apply (drule_tac n="pt_bits t" in neg_mask_mono_le)
+   apply (fastforce dest: plus_mask_AND_NOT_mask_eq)
+  apply (intro conjI; clarsimp)
+   apply (clarsimp simp: authorised_page_table_inv_def)
+   apply (case_tac excaps; clarsimp)
+   apply (rule conjI)
+    apply (clarsimp simp: pt_lookup_slot_def pt_lookup_slot_from_level_def)
+    apply (subst table_base_pt_slot_offset)
+     apply (fastforce simp: cte_wp_at_caps_of_state
+                      dest: caps_of_state_aligned_page_table pt_walk_is_aligned)
+    apply (frule vs_lookup_table_vref_independent[OF vspace_for_asid_vs_lookup, simplified])
+    apply (erule pt_walk_is_subject[rotated 4]; fastforce intro: vspace_for_asid_is_subject
+                                                           simp: user_vtop_leq_canonical_user
+                                                                 user_region_def)
+   apply (clarsimp simp: aag_cap_auth_def cap_auth_conferred_def arch_cap_auth_conferred_def
+                         cap_links_asid_slot_def label_owns_asid_slot_def cap_links_irq_def)
+  apply (auto simp: caps_of_state_pasObjectAbs_eq authorised_page_table_inv_def
+                    cap_auth_conferred_def arch_cap_auth_conferred_def)
+  done
+
+lemma decode_fr_inv_flush_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (is_FrameCap cap \<and> (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                                     aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                                     is_subject aag (fst slot) \<and>
+                                     (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v)))\<rbrace>
+   decode_fr_inv_flush label msg slot cap excaps
+   \<lbrace>\<lambda>rv. authorised_arch_inv aag rv\<rbrace>,-"
+  unfolding authorised_arch_inv_def authorised_page_inv_def decode_fr_inv_flush_def Let_def
+  by wpsimp
+
+lemma decode_asid_control_invocation_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (cap = ASIDControlCap \<and> (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                                           aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                                           is_subject aag (fst slot) \<and>
+                                           (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v)))\<rbrace>
+   decode_asid_control_invocation label msg slot cap excaps
+   \<lbrace>authorised_arch_inv aag\<rbrace>, -"
+  unfolding decode_asid_control_invocation_def authorised_arch_inv_def authorised_asid_control_inv_def
+  apply wpsimp
+  apply (cases excaps; cases "tl excaps"; clarsimp simp: aag_cap_auth_def cte_wp_at_caps_of_state)
+  apply (fastforce dest: caps_of_state_valid[where cap="UntypedCap _ _ _ _"] pas_refined_Control
+                   simp: valid_cap_def cap_aligned_def is_cap_simps cap_auth_conferred_def)
+  done
+
+lemma decode_asid_pool_invocation_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (is_ASIDPoolCap cap \<and> (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                                         aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                                         is_subject aag (fst slot) \<and>
+                                         (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v)))\<rbrace>
+   decode_asid_pool_invocation label msg slot cap excaps
+   \<lbrace>authorised_arch_inv aag\<rbrace>, -"
+  unfolding decode_asid_pool_invocation_def authorised_arch_inv_def Let_def
+  apply wpsimp
+  apply (erule swap[where P="authorised_asid_pool_inv _ _"])
+  apply (cases excaps; clarsimp)
+  apply (clarsimp simp: authorised_asid_pool_inv_def is_ASIDPoolCap_def
+                        pas_refined_def state_objs_to_policy_def auth_graph_map_def)
+  apply (rule conjI)
+   apply (drule subsetD)
+    apply (fastforce dest!: sbta_caps
+                      simp: obj_refs_def cte_wp_at_caps_of_state
+                            cap_auth_conferred_def arch_cap_auth_conferred_def)
+   apply (fastforce dest: aag_wellformed_Control)
+  apply (erule allE, erule mp)
+  apply (fastforce dest: caps_of_state_valid asid_high_bits_of_add_ucast
+                   simp: cte_wp_at_caps_of_state valid_cap_def)
+  done
+
+lemma decode_fr_inv_map_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (is_FrameCap cap \<and> (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                                     aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                                     is_subject aag (fst slot) \<and>
+                                     (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v)))\<rbrace>
+   decode_fr_inv_map label msg slot cap excaps
+   \<lbrace>\<lambda>rv. authorised_arch_inv aag rv\<rbrace>,-"
+  unfolding decode_fr_inv_map_def Let_def fun_app_def
+  apply (wpsimp wp: check_vp_wpR whenE_throwError_wp)+
+  apply (subst imp_conjL[symmetric])
+  apply (subst imp_disjL[symmetric])
+  apply (rule impI)
+  apply clarsimp
+  apply (prop_tac "msg ! 0 \<in> user_region")
+   apply (prop_tac "\<not> user_vtop < msg ! 0 + mask (pageBitsForSize xb) \<longrightarrow> msg!0 \<in> user_region")
+    apply (fastforce intro: dual_order.trans user_vtop_leq_canonical_user is_aligned_no_overflow_mask
+                      simp: user_region_def vmsz_aligned_def not_less)
+   apply (fastforce dest: cte_wp_valid_cap simp: valid_cap_def wellformed_mapdata_def)
+  apply (cases excaps, clarsimp)
+  apply (drule_tac x="excaps ! 0" in bspec, clarsimp)+
+  apply (clarsimp simp: authorised_arch_inv_def authorised_page_inv_def authorised_slots_def
+                        aag_cap_auth_def cap_links_asid_slot_def cap_links_irq_def pte_ref2_def
+                        make_user_pte_def cap_auth_conferred_def arch_cap_auth_conferred_def)
+  apply (rule conjI)
+   apply (frule (1) pt_lookup_slot_vs_lookup_slotI, clarsimp)
+   apply (drule (1) vs_lookup_slot_unique_level; clarsimp)
+   apply (fastforce simp: cte_wp_at_caps_of_state make_user_pte_def pte_ref2_def
+                          vspace_cap_rights_to_auth_def validate_vm_rights_def
+                          mask_vm_rights_def vm_read_only_def vm_kernel_only_def
+                   split: if_splits)
+  apply (fastforce elim: pt_lookup_slot_from_level_is_subject[rotated 4]
+                  intro: vs_lookup_table_vref_independent[OF vspace_for_asid_vs_lookup]
+                         pas_refined_Control[symmetric]
+                   simp: pt_lookup_slot_def)
+  done
+
+lemma decode_frame_invocation_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (is_FrameCap cap \<and> (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                                     aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                                     is_subject aag (fst slot) \<and>
+                                     (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v)))\<rbrace>
+   decode_frame_invocation label msg slot cap excaps
+   \<lbrace>\<lambda>rv. authorised_arch_inv aag rv\<rbrace>,-"
+  unfolding decode_frame_invocation_def
+  by (wpsimp wp: decode_fr_inv_flush_authorised decode_fr_inv_map_authorised
+           simp: authorised_arch_inv_def authorised_page_inv_def)
+
+lemma decode_vspace_invocation_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (is_PageTableCap cap \<and> (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                                          aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                                          is_subject aag (fst slot) \<and>
+                                          (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v)))\<rbrace>
+   decode_vspace_invocation label msg slot cap excaps
+   \<lbrace>\<lambda>rv. authorised_arch_inv aag rv\<rbrace>, -"
+  unfolding decode_vspace_invocation_def decode_vs_inv_flush_def authorised_arch_inv_def Let_def
+  by wpsimp
+
+lemma decode_vcpu_invocation_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (is_VCPUCap cap \<and> (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                                          aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                                          is_subject aag (fst slot) \<and>
+                                          (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v)))\<rbrace>
+   decode_vcpu_invocation label msg cap excaps
+   \<lbrace>\<lambda>rv. authorised_arch_inv aag rv\<rbrace>, -"
+  unfolding decode_vcpu_invocation_def decode_vcpu_set_tcb_def
+            decode_vcpu_inject_irq_def decode_vcpu_read_register_def
+            decode_vcpu_write_register_def decode_vcpu_ack_vppi_def authorised_arch_inv_def
+  apply (rule hoare_gen_asmE)
+  apply (rule_tac Q'="\<lambda>rv s. \<exists>x. rv = InvokeVCPU x \<and> authorised_vcpu_inv aag x"
+               in hoare_strengthen_postE_R[rotated], clarsimp)
+  apply wpsimp
+  apply (fastforce elim: caps_of_state_pasObjectAbs_eq
+                   simp: authorised_vcpu_inv_def cte_wp_at_caps_of_state
+                         cap_auth_conferred_def arch_cap_auth_conferred_def)
+  done
+
+lemma decode_arch_invocation_authorised:
+  "\<lbrace>invs and pas_refined aag and cte_wp_at ((=) (ArchObjectCap cap)) slot
+         and (\<lambda>s. \<forall>(cap, slot) \<in> set excaps. cte_wp_at ((=) cap) slot s)
+         and K (\<forall>(cap, slot) \<in> {(ArchObjectCap cap, slot)} \<union> set excaps.
+                  aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \<and>
+                  is_subject aag (fst slot) \<and>
+                  (\<forall>v \<in> cap_asid' cap. is_subject_asid aag v))\<rbrace>
+   arch_decode_invocation label msg x_slot slot cap excaps
+   \<lbrace>authorised_arch_inv aag\<rbrace>, -"
+  unfolding arch_decode_invocation_def
+  apply (wpsimp wp: decode_page_table_invocation_authorised decode_asid_pool_invocation_authorised
+                    decode_asid_control_invocation_authorised decode_frame_invocation_authorised
+                    decode_vcpu_invocation_authorised decode_vspace_invocation_authorised)
+  apply auto
+  done
+
+lemma authorised_arch_inv_sa_update:
+  "authorised_arch_inv aag i (scheduler_action_update (\<lambda>_. act) s) =
+   authorised_arch_inv aag i s"
+  by (clarsimp simp: authorised_arch_inv_def authorised_page_inv_def authorised_slots_def
+              split: arch_invocation.splits page_invocation.splits)
+
+lemma set_thread_state_authorised_arch_inv[wp]:
+  "set_thread_state ref ts \<lbrace>authorised_arch_inv aag i\<rbrace>"
+  unfolding set_thread_state_def
+  apply (wpsimp wp: dxo_wp_weak)
+     apply (clarsimp simp: authorised_arch_inv_def authorised_page_inv_def authorised_slots_def
+                    split: arch_invocation.splits page_invocation.splits)
+    apply (wpsimp wp: set_object_wp)+
+  apply (clarsimp simp: authorised_arch_inv_def)
+  apply (case_tac i; clarsimp)
+  apply (clarsimp simp: authorised_page_inv_def authorised_slots_def split: page_invocation.splits)
+  apply (erule_tac x=level in allE)
+  apply (erule_tac x=asid in allE)
+  apply (erule_tac x=vref in allE)
+  apply (drule mp)
+   apply (fastforce elim: subst[OF vs_lookup_table_eq_lift, rotated -1]
+                    simp: vs_lookup_slot_table get_tcb_def opt_map_def
+                   split: option.splits kernel_object.splits if_splits)+
+  done
+
+end
+
+
+context begin interpretation Arch .
+
+requalify_facts
+  invoke_arch_pas_refined
+  invoke_arch_respects
+  decode_arch_invocation_authorised
+  authorised_arch_inv_sa_update
+  set_thread_state_authorised_arch_inv
+
+requalify_consts
+  authorised_arch_inv
+
+end
+
+declare authorised_arch_inv_sa_update[simp]
+declare set_thread_state_authorised_arch_inv[wp]
+
+end
diff --git a/proof/access-control/AARCH64/ArchCNode_AC.thy b/proof/access-control/AARCH64/ArchCNode_AC.thy
new file mode 100644
index 0000000000..3bab3f2231
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchCNode_AC.thy
@@ -0,0 +1,309 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchCNode_AC
+imports CNode_AC
+begin
+
+section\<open>Arch-specific CNode AC.\<close>
+
+context Arch begin global_naming AARCH64
+
+declare arch_post_modify_registers_def[simp]
+declare arch_post_cap_deletion_def[simp]
+declare arch_cap_cleanup_opt_def[simp]
+declare arch_mask_irq_signal_def[simp]
+
+named_theorems CNode_AC_assms
+
+lemma sata_cdt_update[CNode_AC_assms, simp]:
+  "state_asids_to_policy aag (cdt_update f s) = state_asids_to_policy aag s"
+  by simp
+
+lemma sata_is_original_cap_update[CNode_AC_assms, simp]:
+  "state_asids_to_policy aag (is_original_cap_update f s) = state_asids_to_policy aag s"
+  by simp
+
+lemma sata_interrupt_states_update[CNode_AC_assms, simp]:
+  "state_asids_to_policy aag (interrupt_states_update f s) = state_asids_to_policy aag s"
+  by simp
+
+lemma sata_machine_state_update[CNode_AC_assms, simp]:
+  "state_asids_to_policy aag (machine_state_update f s) = state_asids_to_policy aag s"
+  by simp
+
+lemma sata_update[CNode_AC_assms]:
+  "\<lbrakk> pas_wellformed aag;
+     cap_links_asid_slot aag (pasObjectAbs aag (fst ptr)) cap;
+     state_asids_to_policy_arch aag caps as vrefs \<subseteq> pasPolicy aag \<rbrakk>
+     \<Longrightarrow> state_asids_to_policy_arch aag (caps(ptr \<mapsto> cap)) as vrefs \<subseteq> pasPolicy aag"
+  by (fastforce intro: state_asids_to_policy_aux.intros
+                 elim!: state_asids_to_policy_aux.cases
+                 simp: cap_links_asid_slot_def label_owns_asid_slot_def
+                split: if_split_asm)
+
+lemma sata_update2[CNode_AC_assms]:
+  "\<lbrakk> pas_wellformed aag;
+     cap_links_asid_slot aag (pasObjectAbs aag (fst ptr)) cap;
+     cap_links_asid_slot aag (pasObjectAbs aag (fst ptr')) cap';
+     state_asids_to_policy_arch aag caps as vrefs \<subseteq> pasPolicy aag \<rbrakk>
+     \<Longrightarrow> state_asids_to_policy_arch aag (caps(ptr \<mapsto> cap, ptr' \<mapsto> cap')) as vrefs \<subseteq> pasPolicy aag"
+  by (fastforce intro: state_asids_to_policy_aux.intros
+                elim!: state_asids_to_policy_aux.cases
+                 simp: cap_links_asid_slot_def label_owns_asid_slot_def
+                split: if_split_asm)
+
+lemma set_cap_state_vrefs[CNode_AC_assms, wp]:
+  "set_cap cap slot \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
+  apply (simp add: set_cap_def set_object_def)
+  apply (wpsimp wp: get_object_wp)
+  apply safe
+        apply (all \<open>subst state_vrefs_eqI\<close>)
+  by (fastforce simp: valid_arch_state_def obj_at_def opt_map_def
+               split: option.splits kernel_object.splits)+
+
+declare maskInterrupt_underlying_memory_inv[CNode_AC_assms, wp]
+        maskInterrupt_device_state_inv[CNode_AC_assms, wp]
+
+crunch set_cdt
+  for state_vrefs[CNode_AC_assms, wp]: "\<lambda>s. P (state_vrefs s)"
+  and state_asids_to_policy[CNode_AC_assms, wp]: "\<lambda>s. P (state_asids_to_policy aag s)"
+
+crunch prepare_thread_delete, arch_finalise_cap
+  for cur_domain[CNode_AC_assms, wp]:"\<lambda>s. P (cur_domain s)"
+  (wp: crunch_wps hoare_vcg_if_lift2 simp: unless_def)
+
+lemma state_vrefs_tcb_upd[CNode_AC_assms]:
+  "tcb_at t s \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(t \<mapsto> TCB tcb)\<rparr>) = state_vrefs s"
+  apply (rule state_vrefs_eqI)
+  by (fastforce simp: opt_map_def obj_at_def is_obj_defs valid_arch_state_def)+
+
+lemma state_vrefs_simple_type_upd[CNode_AC_assms]:
+  "\<lbrakk> ko_at ko ptr s; is_simple_type ko; a_type ko = a_type (f val) \<rbrakk>
+     \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(ptr \<mapsto> f val)\<rparr>) = state_vrefs s"
+  apply (case_tac ko; case_tac "f val"; clarsimp)
+  by (fastforce intro!: state_vrefs_eqI simp: opt_map_def obj_at_def is_obj_defs valid_arch_state_def)+
+
+lemma a_type_arch_object_not_tcb[CNode_AC_assms, simp]:
+  "a_type (ArchObj arch_kernel_obj) \<noteq> ATCB"
+  by auto
+
+lemma arch_post_cap_deletion_cur_domain[CNode_AC_assms, wp]:
+  "arch_post_cap_deletion acap \<lbrace>\<lambda>s. P (cur_domain s)\<rbrace>"
+  by wpsimp
+
+lemma arch_post_cap_deletion_integrity[CNode_AC_assms]:
+  "arch_post_cap_deletion acap \<lbrace>integrity aag X st\<rbrace>"
+  by wpsimp
+
+end
+
+
+context is_extended begin interpretation Arch .
+
+lemma list_integ_lift[CNode_AC_assms]:
+  assumes li:
+    "\<lbrace>list_integ (cdt_change_allowed aag {pasSubject aag} (cdt st) (tcb_states_of_state st)) st and Q\<rbrace>
+     f
+     \<lbrace>\<lambda>_. list_integ (cdt_change_allowed aag {pasSubject aag}  (cdt st) (tcb_states_of_state st)) st\<rbrace>"
+  assumes ekh: "\<And>P. f \<lbrace>\<lambda>s. P (ekheap s)\<rbrace>"
+  assumes rq: "\<And>P. f \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace>"
+  shows "\<lbrace>integrity aag X st and Q\<rbrace> f \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (rule hoare_pre)
+   apply (unfold integrity_def[abs_def] integrity_asids_def)
+   apply (simp only: integrity_cdt_list_as_list_integ)
+   apply (rule hoare_lift_Pf2[where f="ekheap"])
+    apply (simp add: tcb_states_of_state_def get_tcb_def)
+    apply (wp li[simplified tcb_states_of_state_def get_tcb_def] ekh rq)+
+  apply (simp only: integrity_cdt_list_as_list_integ)
+  apply (simp add: tcb_states_of_state_def get_tcb_def)
+  done
+
+end
+
+
+global_interpretation CNode_AC_1?: CNode_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact CNode_AC_assms)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma integrity_asids_set_cap_Nullcap[CNode_AC_assms]:
+  "\<lbrace>(=) s\<rbrace> set_cap NullCap slot \<lbrace>\<lambda>_. integrity_asids aag subjects x a s\<rbrace>"
+  unfolding integrity_asids_def by wpsimp
+
+crunch set_original
+  for state_asids_to_policy[CNode_AC_assms, wp]: "\<lambda>s. P (state_asids_to_policy aag s)"
+  and state_objs_to_policy[CNode_AC_assms, wp]: "\<lambda>s. P (state_objs_to_policy s)"
+  (simp: state_objs_to_policy_def)
+
+crunch set_cdt_list, update_cdt_list
+  for state_vrefs[CNode_AC_assms, wp]: "\<lambda>s. P (state_vrefs s)"
+  and state_asids_to_policy[CNode_AC_assms, wp]: "\<lambda>s. P (state_asids_to_policy aag s)"
+  (simp: set_cdt_list_def)
+
+end
+
+
+global_interpretation CNode_AC_2?: CNode_AC_2
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact CNode_AC_assms)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma arch_post_cap_deletion_pas_refined[CNode_AC_assms, wp]:
+  "arch_post_cap_deletion irqopt \<lbrace>pas_refined aag\<rbrace>"
+  by (wpsimp simp: post_cap_deletion_def)
+
+lemma aobj_ref'_same_aobject[CNode_AC_assms]:
+  "same_aobject_as ao' ao \<Longrightarrow> aobj_ref' ao = aobj_ref' ao'"
+  by (cases ao; clarsimp split: arch_cap.splits)
+
+crunch set_untyped_cap_as_full
+  for valid_arch_state[CNode_AC_assms, wp]: valid_arch_state
+
+end
+
+
+context is_extended begin interpretation Arch .
+
+lemma pas_refined_tcb_domain_map_wellformed[CNode_AC_assms, wp]:
+  assumes tdmw: "f \<lbrace>tcb_domain_map_wellformed aag\<rbrace>"
+  shows "f \<lbrace>pas_refined aag\<rbrace>"
+  apply (simp add: pas_refined_def)
+  apply (wp tdmw)
+   apply (wp lift_inv)
+   apply simp+
+  done
+
+end
+
+
+global_interpretation CNode_AC_3?: CNode_AC_3
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact CNode_AC_assms)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma arch_derive_cap_auth_derived[CNode_AC_assms]:
+  "\<lbrace>\<lambda>s. cte_wp_at (auth_derived (ArchObjectCap cap)) src_slot s\<rbrace>
+   arch_derive_cap cap
+   \<lbrace>\<lambda>rv s. cte_wp_at (auth_derived rv) src_slot s\<rbrace>, -"
+  apply (rule hoare_pre)
+   apply (wp | wpc | simp add: arch_derive_cap_def)+
+  apply (clarsimp simp: cte_wp_at_caps_of_state)
+  apply (safe)
+  apply (clarsimp simp: auth_derived_def arch_cap_auth_conferred_def cap_auth_conferred_def)
+  done
+
+lemma cap_asid'_cap_rights_update[CNode_AC_assms, simp]:
+  "acap_asid' (acap_rights_update rights ao) = acap_asid' ao"
+  by (cases ao; clarsimp simp: cap_rights_update_def acap_rights_update_def)
+
+lemma untyped_range_cap_rights_update[CNode_AC_assms, simp]:
+  "untyped_range (cap_rights_update rights (ArchObjectCap ao)) = untyped_range (ArchObjectCap ao)"
+  by (cases ao; clarsimp simp: cap_rights_update_def)
+
+lemma obj_refs_cap_rights_update[CNode_AC_assms, simp]:
+  "aobj_ref' (acap_rights_update rights ao) = aobj_ref' ao"
+  by (cases ao; clarsimp simp: cap_rights_update_def acap_rights_update_def)
+
+lemma auth_derived_arch_update_cap_data[CNode_AC_assms]:
+  "auth_derived (ArchObjectCap ao) cap' \<Longrightarrow> auth_derived (arch_update_cap_data pres w ao) cap'"
+  by (simp add: update_cap_data_def is_cap_simps arch_update_cap_data_def
+                  split del: if_split cong: if_cong)
+
+lemma acap_auth_conferred_acap_rights_update[CNode_AC_assms]:
+  "arch_cap_auth_conferred (acap_rights_update (acap_rights acap \<inter> R) acap)
+   \<subseteq> arch_cap_auth_conferred acap"
+  by (auto simp: arch_cap_auth_conferred_def vspace_cap_rights_to_auth_def acap_rights_update_def
+                 validate_vm_rights_def vm_kernel_only_def vm_read_only_def
+          split: arch_cap.splits)
+
+lemma arch_derive_cap_clas[CNode_AC_assms]:
+  "\<lbrace>\<lambda>s. cap_links_asid_slot aag p (ArchObjectCap acap)\<rbrace>
+   arch_derive_cap acap
+   \<lbrace>\<lambda>rv s. cap_links_asid_slot aag p rv\<rbrace>, -"
+  apply (simp add: arch_derive_cap_def cong: cap.case_cong)
+  apply (rule hoare_pre)
+  apply (wp | wpc)+
+  apply (auto simp: is_cap_simps cap_links_asid_slot_def)
+  done
+
+lemma arch_derive_cap_obj_refs_auth[CNode_AC_assms]:
+  "\<lbrace>K (\<forall>r\<in>obj_refs_ac (ArchObjectCap cap).
+       \<forall>auth\<in>cap_auth_conferred (ArchObjectCap cap). aag_has_auth_to aag auth r)\<rbrace>
+   arch_derive_cap cap
+   \<lbrace>(\<lambda>x s. \<forall>r\<in>obj_refs_ac x. \<forall>auth\<in>cap_auth_conferred x. aag_has_auth_to aag auth r)\<rbrace>, -"
+  unfolding arch_derive_cap_def
+  apply (rule hoare_pre)
+   apply (wp | wpc)+
+  apply (clarsimp simp: cap_auth_conferred_def arch_cap_auth_conferred_def)
+  done
+
+(* FIXME: move *)
+lemma arch_derive_cap_obj_refs_subset[CNode_AC_assms]:
+  "\<lbrace>\<lambda>s. (\<forall>x \<in> aobj_ref' acap. P x s)\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv s. \<forall>x \<in> obj_refs_ac rv. P x s\<rbrace>, -"
+  by (wpsimp simp: arch_derive_cap_def) fastforce
+
+lemma arch_derive_cap_clip[CNode_AC_assms]:
+  "\<lbrace>K (cap_links_irq aag l (ArchObjectCap ac))\<rbrace>
+   arch_derive_cap ac
+   \<lbrace>\<lambda>x s. cap_links_irq aag l x\<rbrace>, -"
+  by (wpsimp simp: arch_derive_cap_def comp_def cli_no_irqs)
+
+(* FIXME: move *)
+lemma arch_derive_cap_untyped_range_subset[CNode_AC_assms]:
+  "\<lbrace>\<lambda>s. \<forall>x \<in> untyped_range (ArchObjectCap acap). P x s\<rbrace>
+   arch_derive_cap acap
+   \<lbrace>\<lambda>rv s. \<forall>x \<in> untyped_range rv. P x s\<rbrace>, -"
+  by (wpsimp simp: arch_derive_cap_def)
+
+lemma arch_update_cap_obj_refs_subset[CNode_AC_assms]:
+  "\<lbrakk> x \<in> obj_refs_ac (arch_update_cap_data pres data cap) \<rbrakk> \<Longrightarrow> x \<in> aobj_ref' cap"
+  by (simp add: arch_update_cap_data_def)
+
+lemma arch_update_cap_untyped_range_empty[CNode_AC_assms, simp]:
+  "untyped_range (arch_update_cap_data pres data cap) = {}"
+  by (simp add: arch_update_cap_data_def)
+
+lemma arch_update_cap_irqs_controlled_empty[CNode_AC_assms, simp]:
+  "cap_irqs_controlled (arch_update_cap_data pres data cap) = {}"
+  by (simp add: arch_update_cap_data_def)
+
+lemma arch_update_cap_links_asid_slot[CNode_AC_assms]:
+  "cap_links_asid_slot aag p (arch_update_cap_data pres w acap) =
+   cap_links_asid_slot aag p (ArchObjectCap acap)"
+  by (simp add: arch_update_cap_data_def)
+
+lemma arch_update_cap_cap_auth_conferred_subset[CNode_AC_assms]:
+  "y \<in> cap_auth_conferred (arch_update_cap_data b w acap) \<Longrightarrow> y \<in> arch_cap_auth_conferred acap"
+  by (simp add: arch_update_cap_data_def cap_auth_conferred_def)
+
+end
+
+
+global_interpretation CNode_AC_4?: CNode_AC_4
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact CNode_AC_assms)
+qed
+
+
+end
diff --git a/proof/access-control/AARCH64/ArchDomainSepInv.thy b/proof/access-control/AARCH64/ArchDomainSepInv.thy
new file mode 100644
index 0000000000..75be93b3ce
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchDomainSepInv.thy
@@ -0,0 +1,173 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchDomainSepInv
+imports
+  "DomainSepInv"
+begin
+
+context Arch begin global_naming AARCH64
+
+named_theorems DomainSepInv_assms
+
+crunch arch_post_cap_deletion, set_pt, set_asid_pool, init_arch_objects
+  for domain_sep_inv[DomainSepInv_assms, wp]: "domain_sep_inv irqs st"
+  (wp: domain_sep_inv_triv crunch_wps set_asid_pool_cte_wp_at set_pt_cte_wp_at)
+
+crunch vcpu_update
+  for domain_sep_inv[wp]: "domain_sep_inv irqs st"
+  (wp: domain_sep_inv_triv crunch_wps set_asid_pool_cte_wp_at set_pt_cte_wp_at)
+
+crunch vcpu_save_reg, vcpu_invalidate_active, dissociate_vcpu_tcb, fpu_thread_delete
+  for interrupt_states[wp]: "\<lambda>s. P (interrupt_states s)"
+  (wp: crunch_wps)
+
+crunch prepare_thread_delete
+  for domain_sep_inv[DomainSepInv_assms, wp]: "domain_sep_inv irqs st"
+  (wp: domain_sep_inv_triv crunch_wps)
+
+crunch arch_finalise_cap
+  for domain_sep_inv[DomainSepInv_assms, wp]: "domain_sep_inv irqs st"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma arch_finalise_cap_rv[DomainSepInv_assms]:
+  "\<lbrace>\<lambda>_. P (NullCap,NullCap)\<rbrace> arch_finalise_cap c x \<lbrace>\<lambda>rv _. P rv\<rbrace>"
+  unfolding arch_finalise_cap_def by wpsimp
+
+lemma arch_derive_cap_domain_sep_inv[DomainSepInv_assms, wp]:
+  "\<lbrace>\<top>\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv _. domain_sep_inv_cap irqs rv\<rbrace>,-"
+  unfolding arch_derive_cap_def
+  by wpsimp
+
+lemma arch_post_modify_registers_domain_sep_inv[DomainSepInv_assms, wp]:
+  "arch_post_modify_registers cur t \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  unfolding arch_post_modify_registers_def by wpsimp
+
+crunch handle_vm_fault, handle_vm_fault, perform_pg_inv_unmap,
+       perform_pg_inv_get_addr, perform_pt_inv_map, perform_pt_inv_unmap,
+       handle_arch_fault_reply, arch_mask_irq_signal, arch_switch_to_thread,
+       arch_switch_to_idle_thread, arch_activate_idle_thread, store_asid_pool_entry
+  for domain_sep_inv[DomainSepInv_assms, wp]: "domain_sep_inv irqs st"
+  (wp: crunch_wps)
+
+end
+
+
+global_interpretation DomainSepInv_1?: DomainSepInv_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; (fact DomainSepInv_assms)?)
+qed
+
+context Arch begin global_naming AARCH64
+
+crunch perform_pg_inv_map, perform_flush
+  for domain_sep_inv[wp]: "domain_sep_inv irqs st"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma perform_page_invocation_domain_sep_inv:
+  "\<lbrace>domain_sep_inv irqs st and valid_page_inv pgi\<rbrace>
+   perform_page_invocation pgi
+   \<lbrace>\<lambda>_ (s :: det_ext state). domain_sep_inv irqs st s\<rbrace>"
+  apply (rule hoare_pre)
+   apply (wp mapM_wp[OF _ subset_refl] set_cap_domain_sep_inv mapM_x_wp[OF _ subset_refl]
+             perform_page_invocation_domain_sep_inv_get_cap_helper
+          | simp add: perform_page_invocation_def o_def | wpc)+
+  done
+
+lemma perform_page_table_invocation_domain_sep_inv:
+  "\<lbrace>domain_sep_inv irqs st and valid_pti pgi\<rbrace>
+   perform_page_table_invocation pgi
+   \<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
+  apply (rule hoare_pre)
+   apply (simp add: perform_page_table_invocation_def)
+   apply (wpsimp wp: perform_page_invocation_domain_sep_inv_get_cap_helper
+                     crunch_wps set_cap_domain_sep_inv)
+  apply (clarsimp simp: valid_pti_def)
+  done
+
+lemma perform_asid_control_invocation_domain_sep_inv:
+  "perform_asid_control_invocation iv \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  unfolding perform_asid_control_invocation_def
+  apply (rule hoare_pre)
+  apply (wp modify_wp cap_insert_domain_sep_inv' set_cap_domain_sep_inv
+            get_cap_domain_sep_inv_cap[where st=st] hoare_vcg_imp_lift
+         | wpc | simp )+
+  done
+
+lemma perform_asid_pool_invocation_domain_sep_inv:
+  "perform_asid_pool_invocation iv \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  apply (simp add: perform_asid_pool_invocation_def)
+  apply (rule hoare_pre)
+  apply (wp set_cap_domain_sep_inv get_cap_wp | wpc | simp)+
+  done
+
+lemma perform_vspace_invocation_domain_sep_inv[wp]:
+  "perform_vspace_invocation iv \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  by (wpsimp simp: perform_vspace_invocation_def)
+
+crunch invoke_vcpu_inject_irq, invoke_vcpu_read_register, invoke_vcpu_write_register, invoke_vcpu_ack_vppi
+  for domain_sep_inv[wp]: "domain_sep_inv irqs st"
+
+lemma associate_vcpu_tcb_domain_sep_inv[wp]:
+  "associate_vcpu_tcb a b \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  unfolding associate_vcpu_tcb_def
+  by (wpsimp | wp domain_sep_inv_triv)+
+
+lemma perform_vcpu_invocation_domain_sep_inv[wp]:
+  "perform_vcpu_invocation vcpu \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  unfolding perform_vcpu_invocation_def
+  by wpsimp
+
+lemma arch_perform_invocation_domain_sep_inv[DomainSepInv_assms]:
+  "\<lbrace>domain_sep_inv irqs st and valid_arch_inv ai\<rbrace>
+   arch_perform_invocation ai
+   \<lbrace>\<lambda>_ (s :: det_ext state). domain_sep_inv irqs st s\<rbrace>"
+  unfolding arch_perform_invocation_def
+  apply (wpsimp wp: perform_page_table_invocation_domain_sep_inv
+                    perform_page_invocation_domain_sep_inv
+                    perform_asid_control_invocation_domain_sep_inv
+                    perform_asid_pool_invocation_domain_sep_inv)
+  apply (clarsimp simp: valid_arch_inv_def split: arch_invocation.splits)
+  done
+
+lemma arch_invoke_irq_handler_domain_sep_inv[DomainSepInv_assms, wp]:
+  "arch_invoke_irq_handler ihi \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  by (cases ihi; wpsimp)
+
+lemma arch_invoke_irq_control_domain_sep_inv[DomainSepInv_assms]:
+  "\<lbrace>domain_sep_inv irqs st and arch_irq_control_inv_valid ivk\<rbrace>
+   arch_invoke_irq_control ivk
+   \<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
+  apply (cases ivk)
+  apply (wpsimp wp: cap_insert_domain_sep_inv' simp: set_irq_state_def)
+   apply (rule_tac Q'="\<lambda>_. domain_sep_inv irqs st and arch_irq_control_inv_valid ivk"
+                in hoare_strengthen_post[rotated])
+    apply (fastforce simp: domain_sep_inv_def domain_sep_inv_cap_def arch_irq_control_inv_valid_def)
+   apply (wpsimp wp: do_machine_op_domain_sep_inv simp: arch_irq_control_inv_valid_def)+
+  done
+
+crunch handle_reserved_irq, handle_hypervisor_fault
+  for domain_sep_inv[wp]:
+  "\<lambda>s :: det_ext state. domain_sep_inv irqs (st :: 's :: state_ext state) s"
+  (wp: crunch_wps simp: crunch_simps vcpu_update_def valid_vcpu_def valid_fault_def)
+
+\<comment> \<open>Remove the parentheses\<close>
+declare handle_reserved_irq_domain_sep_inv[simplified and_assoc, DomainSepInv_assms]
+declare handle_hypervisor_fault_domain_sep_inv[simplified and_assoc, DomainSepInv_assms]
+
+end
+
+
+global_interpretation DomainSepInv_2?: DomainSepInv_2
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact DomainSepInv_assms)
+qed
+
+end
diff --git a/proof/access-control/AARCH64/ArchFinalise_AC.thy b/proof/access-control/AARCH64/ArchFinalise_AC.thy
new file mode 100644
index 0000000000..b852399327
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchFinalise_AC.thy
@@ -0,0 +1,417 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchFinalise_AC
+imports Finalise_AC
+begin
+
+context Arch begin global_naming AARCH64
+
+named_theorems Finalise_AC_assms
+
+lemma state_vrefs_clear_asid_table:
+  "state_vrefs (s\<lparr>arch_state := arch_state s\<lparr>arm_asid_table := \<lambda>a. if a = asid_high_bits_of base
+                                                                     then None
+                                                                     else asid_table s a\<rparr>\<rparr>) x
+   \<subseteq> state_vrefs s x"
+  by (fastforce simp: state_vrefs_def dest: vs_lookup_clear_asid_table[simplified fun_upd_def])
+
+lemma state_vrefs_clear_asid_pool:
+  assumes "asid_table s (asid_high_bits_of asid) = Some pool_ptr"
+  and "ako_at (ASIDPool pool) pool_ptr s"
+  shows "state_vrefs (s\<lparr>kheap := (kheap s)(pool_ptr \<mapsto> ArchObj
+           (ASIDPool (\<lambda>a. if a = asid_low_bits_of asid then None else pool a)))\<rparr>) x
+           \<subseteq> state_vrefs s x"
+  apply (rule state_vrefs_subseteq)
+  using assms
+  by (auto simp: vspace_for_pool_def entry_for_pool_def opt_map_def obind_def obj_at_def)
+
+lemma pas_refined_arm_next_vmid[simp]:
+  "pas_refined aag (s\<lparr>arch_state := arch_state s\<lparr>arm_next_vmid := v\<rparr>\<rparr>) = pas_refined aag s"
+  by (auto simp: pas_refined_def state_objs_to_policy_def state_vrefs_def)
+
+lemma pas_refined_arm_vmid_table[simp]:
+  "pas_refined aag (s\<lparr>arch_state := arch_state s\<lparr>arm_vmid_table := v\<rparr>\<rparr>) = pas_refined aag s"
+  by (auto simp: pas_refined_def state_objs_to_policy_def state_vrefs_def)
+
+crunch invalidate_vmid_entry
+  for pas_refined[wp]: "pas_refined aag"
+
+lemma set_vcpu_state_vrefs[wp]:
+  "set_vcpu ptr vcpu \<lbrace>\<lambda>s. P (state_vrefs s)\<rbrace>"
+  apply (wpsimp wp: set_vcpu_wp)
+  apply (erule_tac P=P in rsubst)
+  apply (fastforce intro: state_vrefs_eqI simp: opt_map_def typ_at_eq_kheap_obj)
+  done
+
+lemma state_vrefs_set_asid_pool_vmid:
+  assumes "pool_for_asid asid s = Some pool_ptr"
+      and "asid_pools_of s pool_ptr = Some pool"
+      and "pool (asid_low_bits_of asid) = Some entry"
+    shows "state_vrefs
+            (s\<lparr>kheap := (kheap s)
+                 (pool_ptr \<mapsto>
+                  ArchObj
+                   (ASIDPool
+                     (\<lambda>a. if a = asid_low_bits_of asid
+                           then Some (ASIDPoolVSpace vmid (ap_vspace entry)) else pool a)))\<rparr>)
+            x
+           \<subseteq> state_vrefs s x"
+  (is "state_vrefs ?s' _ \<subseteq> state_vrefs _ _")
+  apply (rule state_vrefs_subseteq)
+  using assms
+  by (auto simp: vspace_for_pool_def entry_for_pool_def opt_map_def obind_def obj_at_def
+          split: option.splits)
+
+lemma update_asid_pool_entry_vmid_pas_refined[wp]:
+  "update_asid_pool_entry (\<lambda>entry. Some (ASIDPoolVSpace vmid (ap_vspace entry))) asid \<lbrace>pas_refined aag\<rbrace>"
+  unfolding update_asid_pool_entry_def set_asid_pool_def
+  apply (wpsimp wp: set_object_wp)+
+  apply (erule pas_refined_subseteq; clarsimp?)
+     apply (rule caps_of_state_fun_upd)
+     apply (clarsimp simp: obj_at_def opt_map_def split: option.splits)
+    apply (erule rev_subsetD, rule state_vrefs_subseteq)
+       apply (auto simp: vspace_for_pool_def entry_for_pool_def opt_map_def obind_def
+                  split: option.splits kernel_object.splits)[4]
+   apply (rule thread_st_auth_fun_upd)
+   apply (clarsimp simp: obj_at_def asid_pools_of_ko_at get_tcb_def)
+  apply (rule thread_bound_ntfns_fun_upd)
+  apply (clarsimp simp: asid_pools_of_ko_at get_tcb_def obj_at_def)
+  done
+
+lemma tcb_vcpu_update_pas_refined[wp]:
+  "arch_thread_set v t \<lbrace>pas_refined aag\<rbrace>"
+  apply (wpsimp wp: arch_thread_set_wp)
+  apply (erule pas_refined_subseteq; clarsimp?)
+     apply (rule caps_of_state_fun_upd)
+     apply (clarsimp simp: obj_at_def get_tcb_def tcb_cap_cases_def
+                    split: option.splits kernel_object.splits)
+    apply (erule rev_subsetD, rule state_vrefs_subseteq)
+       apply (auto simp: vspace_for_pool_def entry_for_pool_def opt_map_def obind_def get_tcb_def
+                  split: option.splits kernel_object.splits)[4]
+   apply (rule thread_st_auth_fun_upd)
+   apply (clarsimp simp: obj_at_def asid_pools_of_ko_at get_tcb_def)
+  apply (rule thread_bound_ntfns_fun_upd)
+  apply (clarsimp simp: obj_at_def asid_pools_of_ko_at get_tcb_def)
+  done
+
+lemma set_vcpu_pas_refined[wp]:
+  "set_vcpu ptr vcpu \<lbrace>\<lambda>s. pas_refined aag s\<rbrace>"
+  apply (wpsimp wp: set_vcpu_wp)
+  apply (erule pas_refined_subseteq; clarsimp?)
+     apply (fastforce simp: caps_of_state_fun_upd obj_at_def)
+    apply (erule rev_subsetD, rule state_vrefs_subseteq)
+       apply (auto simp: vspace_for_pool_def entry_for_pool_def opt_map_def obind_def obj_at_def)[4]
+   apply (fastforce simp: thread_st_auth_fun_upd obj_at_def asid_pools_of_ko_at get_tcb_def)
+  apply (fastforce simp: thread_bound_ntfns_fun_upd obj_at_def asid_pools_of_ko_at get_tcb_def)
+  done
+
+lemma vcpu_update_pas_refined:
+  "vcpu_update vr f \<lbrace>\<lambda>s. pas_refined aag s\<rbrace>"
+  unfolding vcpu_update_def
+  by (wpsimp wp: get_vcpu_wp)
+
+crunch set_vm_root, invalidate_asid_entry
+  for pas_refined[wp]: "pas_refined aag"
+  (wp: crunch_wps ignore: update_asid_pool_entry)
+
+lemma delete_asid_pool_pas_refined[wp]:
+  "delete_asid_pool base ptr \<lbrace>pas_refined aag\<rbrace>"
+  apply (wpsimp simp: delete_asid_pool_def)
+      apply (rule_tac Q'="\<lambda>_ s. pas_refined aag s \<and> asid_low_bits_of base = 0 \<and>
+                                arm_asid_table (arch_state s) = asid_table \<and> asid_pool_at ptr s"
+                   in hoare_strengthen_post[rotated], clarsimp)
+       apply (erule pas_refined_subseteq; clarsimp?)
+       apply (erule rev_subsetD, rule state_vrefs_subseteq)
+          apply (auto simp: pool_for_asid_def)[4]
+      apply (wpsimp wp: mapM_wp')+
+  apply (clarsimp simp: asid_pools_at_eq)
+  done
+
+lemma delete_asid_pas_refined[wp]:
+  "delete_asid asid pt \<lbrace>pas_refined aag\<rbrace>"
+  apply (wpsimp wp: set_object_wp simp: delete_asid_def set_asid_pool_def simp_del: fun_upd_apply)
+      apply (rule_tac Q'="\<lambda>_ s. pas_refined aag s \<and> pool_for_asid asid s = Some x2 \<and> asid_pool_at x2 s"
+                   in hoare_strengthen_post[rotated])
+       apply (clarsimp simp: asid_pools_at_eq)
+       apply (erule pas_refined_subseteq; clarsimp?)
+          apply (rule caps_of_state_fun_upd)
+          apply (clarsimp simp: obj_at_def opt_map_def split: option.splits)
+         apply (erule rev_subsetD, rule state_vrefs_subseteq)
+            apply (auto simp: vspace_for_pool_def entry_for_pool_def opt_map_def obind_def
+                       split: option.splits)[4]
+        apply (rule thread_st_auth_fun_upd)
+        apply (clarsimp simp: obj_at_def get_tcb_def opt_map_def split: option.splits)
+       apply (rule thread_bound_ntfns_fun_upd)
+       apply (clarsimp simp: obj_at_def get_tcb_def opt_map_def split: option.splits)
+      apply wpsimp+
+  apply (clarsimp simp: asid_pools_at_eq)
+  done
+
+lemma state_vrefs_set_current_vcpu[simp]:
+  "state_vrefs (s\<lparr>arch_state := arch_state s\<lparr>arm_current_vcpu := vcpu\<rparr>\<rparr>)
+   = state_vrefs s"
+  by (fastforce simp: state_vrefs_def dest: vs_lookup_clear_asid_table[simplified fun_upd_def])
+
+lemma pas_refined_arm_current_vcpu_upd[simp]:
+  "pas_refined aag (s\<lparr>arch_state := arch_state s\<lparr>arm_current_vcpu := v\<rparr>\<rparr>)
+   = pas_refined aag s"
+  by (fastforce elim: pas_refined_by_subsets simp: state_objs_to_policy_def)
+
+crunch vcpu_invalidate_active
+  for pas_refined[wp]: "pas_refined aag"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma dissociate_vcpu_tcb_pas_refined[wp]:
+  "dissociate_vcpu_tcb vr t \<lbrace>pas_refined aag\<rbrace>"
+  unfolding dissociate_vcpu_tcb_def
+  by (wpsimp wp: get_vcpu_wp arch_thread_get_wp)
+
+lemma vcpu_finalise_cap_pas_refined[wp]:
+  "vcpu_finalise vr \<lbrace>pas_refined aag\<rbrace>"
+  unfolding vcpu_finalise_def
+  by (wpsimp wp: get_vcpu_wp)
+
+lemma arch_finalise_cap_pas_refined[Finalise_AC_assms, wp]:
+  "\<lbrace>pas_refined aag and invs and valid_arch_cap c\<rbrace> arch_finalise_cap c x \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  unfolding arch_finalise_cap_def
+  apply (wpsimp wp: unmap_page_pas_refined unmap_page_table_pas_refined)
+  apply (auto simp: valid_arch_cap_def wellformed_mapdata_def)
+  done
+
+crunch prepare_thread_delete
+  for pas_refined[Finalise_AC_assms, wp]: "pas_refined aag"
+
+lemma prepare_thread_delete_integrity[Finalise_AC_assms, wp]:
+  "\<lbrace>integrity aag X st and K (is_subject aag t)\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding prepare_thread_delete_def
+  apply (wpsimp wp: dissociate_vcpu_tcb_respects arch_thread_get_wp
+                    dmo_no_mem_respects hoare_vcg_all_lift hoare_vcg_imp_lift
+              simp: fpu_thread_delete_def)
+  using associated_vcpu_is_subject get_tcb_Some_ko_at by blast
+
+lemma sbn_st_vrefs[Finalise_AC_assms]:
+  "set_bound_notification t st \<lbrace>\<lambda>s. P (state_vrefs s)\<rbrace>"
+  apply (simp add: set_bound_notification_def)
+  apply (wpsimp wp: set_object_wp dxo_wp_weak)
+  apply (subst state_vrefs_tcb_upd)
+   apply (auto simp: tcb_at_def valid_arch_state_def)
+  done
+
+lemma arch_finalise_cap_auth'[Finalise_AC_assms]:
+  "\<lbrace>pas_refined aag\<rbrace> arch_finalise_cap x12 final \<lbrace>\<lambda>rv s. pas_cap_cur_auth aag (fst rv)\<rbrace>"
+  unfolding arch_finalise_cap_def
+  by (wp | wpc | simp add: comp_def hoare_TrueI[where P = \<top>] split del: if_split)+
+
+lemma arch_finalise_cap_obj_refs[Finalise_AC_assms]:
+  "\<lbrace>\<lambda>s. \<forall>x \<in> aobj_ref' acap. P x\<rbrace>
+   arch_finalise_cap acap slot
+   \<lbrace>\<lambda>rv s. \<forall>x \<in> obj_refs_ac (fst rv). P x\<rbrace>"
+  by (wpsimp simp: arch_finalise_cap_def)
+
+lemma arch_finalise_cap_makes_halted[Finalise_AC_assms]:
+  "\<lbrace>\<top>\<rbrace> arch_finalise_cap arch_cap ex \<lbrace>\<lambda>rv s. \<forall>t\<in>obj_refs_ac (fst rv). halted_if_tcb t s\<rbrace>"
+  apply (case_tac arch_cap, simp_all add: arch_finalise_cap_def)
+  by (wpsimp simp: valid_cap_def split: option.split bool.split)+
+
+lemma arch_cap_cleanup_wf[Finalise_AC_assms]:
+  "\<lbrakk> arch_cap_cleanup_opt acap \<noteq> NullCap; \<not> is_arch_cap (arch_cap_cleanup_opt acap) \<rbrakk>
+     \<Longrightarrow> (\<exists>irq. arch_cap_cleanup_opt acap = IRQHandlerCap irq \<and> is_subject_irq aag irq)"
+  by simp
+
+lemma update_asid_pool_entry_vmid_integrity:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> (vmid = None \<or> vmid_for_asid s asid = None)\<rbrace>
+   update_asid_pool_entry (\<lambda>entry. Some (ASIDPoolVSpace vmid (ap_vspace entry))) asid
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding update_asid_pool_entry_def set_asid_pool_def
+  apply (wpsimp wp: set_object_wp simp_del: fun_upd_apply)
+  apply (clarsimp simp: integrity_def)
+  apply (subst tcb_states_of_state_fun_upd, fastforce simp: get_tcb_def asid_pools_of_ko_at obj_at_def)+
+  apply (intro conjI; clarsimp?)
+   apply (erule_tac allE, erule tro_trans_spec)
+   apply (force intro!: tro_arch arch_troa_asidpool_vmid
+                 simp: asid_pools_of_ko_at vmid_for_asid_def entry_for_pool_def pool_for_asid_def
+                       obj_at_def obind_def opt_map_def
+                split: option.splits if_splits)
+  apply (erule_tac x=asid in allE, auto simp: pool_for_asid_def)
+  done
+
+lemma store_vmid_Some_integrity:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> vmid_for_asid s asid = None\<rbrace>
+   store_vmid asid vmid
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding store_vmid_def
+  by (wpsimp wp: update_asid_pool_entry_vmid_integrity)
+
+crunch find_free_vmid
+  for respects[wp]: "integrity aag X st"
+  (wp: update_asid_pool_entry_vmid_integrity dmo_no_mem_respects ignore: update_asid_pool_entry)
+
+lemma get_vmid_respects[wp]:
+  "get_vmid asid \<lbrace>integrity aag X st\<rbrace>"
+  unfolding get_vmid_def
+  by (wpsimp wp: store_vmid_Some_integrity)
+
+crunch arm_context_switch, set_global_user_vspace, set_vm_root,
+       invalidate_vmid_entry, invalidate_asid_entry, invalidate_tlb_by_asid
+  for respects[wp]: "integrity aag X st"
+  (wp: dmo_no_mem_respects ignore: update_asid_pool_entry)
+
+lemma delete_asid_pool_respects[wp]:
+  "\<lbrace>integrity aag X st and
+    K (\<forall>asid'. asid' \<noteq> 0 \<and> asid_high_bits_of asid' = asid_high_bits_of x
+               \<longrightarrow> is_subject_asid aag asid')\<rbrace>
+   delete_asid_pool x y
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  by (wpsimp simp: delete_asid_pool_def wp: asid_table_entry_update_integrity mapM_wp')
+
+crunch set_asid_pool
+  for is_original_cap[wp]: "\<lambda>s. P (is_original_cap s x)"
+
+lemma set_asid_pool_tcb_states_of_state[wp]:
+  "set_asid_pool p pool \<lbrace>\<lambda>s. P (tcb_states_of_state s)\<rbrace>"
+  apply (wpsimp wp: set_object_wp_strong simp: obj_at_def set_asid_pool_def)
+  apply (erule_tac P=P in rsubst)
+  apply (fastforce simp: tcb_states_of_state_def get_tcb_def split: kernel_object.splits)
+  done
+
+lemma set_asid_pool_integrity_objs:
+  "\<lbrace>integrity_obj_state aag activate subjects st and
+    (\<lambda>s. \<forall>pool'. ako_at (ASIDPool pool') ptr s \<longrightarrow> asid_pool_integrity subjects aag pool' pool)\<rbrace>
+   set_asid_pool ptr pool
+   \<lbrace>\<lambda>_. integrity_obj_state aag activate subjects st\<rbrace>"
+  apply (wpsimp wp: set_object_wp_strong simp: obj_at_def set_asid_pool_def)
+  by (fastforce elim: tro_trans_spec
+               intro: tro_arch arch_troa_asidpool_clear
+                simp: a_type_def aa_type_def
+               split: if_splits kernel_object.splits arch_kernel_obj.splits)
+
+lemma set_asid_pool_integrity_autarch:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> pas_refined aag s \<and> invs s \<and>
+        (\<exists>asid pool. pool_for_asid asid s = Some pool_ptr \<and> asid_pools_of s pool_ptr = Some pool \<and>
+                     pool' = pool (asid_low_bits_of asid := None) \<and>
+                     (\<forall>entry. pool (asid_low_bits_of asid) = Some entry
+                              \<longrightarrow> is_subject aag (ap_vspace entry)))\<rbrace>
+   set_asid_pool pool_ptr pool'
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding integrity_def conj_assoc[symmetric]
+  apply (wp set_object_wp_strong set_asid_pool_integrity_objs dmo_wp hoare_vcg_all_lift
+         | wps | simp add: obj_at_def set_asid_pool_def)+
+  apply (intro conjI impI; clarsimp)
+   apply (fastforce simp: opt_map_def asid_pool_integrity_def aag_has_Control_iff_owns)
+  apply (erule_tac x=pool_ptr in allE)+
+  apply (erule_tac x=asid in allE)+
+  apply (fastforce simp: asid_pools_of_ko_at obj_at_def pool_for_asid_def)
+  done
+
+lemma delete_asid_respects:
+  "\<lbrace>integrity aag X st and pas_refined aag and invs and K (0 < asid \<and> is_subject aag pd)\<rbrace>
+   delete_asid asid pd
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (simp add: delete_asid_def)
+  apply (wpsimp wp: set_asid_pool_integrity_autarch)
+      apply (rule_tac Q'="\<lambda>_ s. integrity aag X st s \<and> pas_refined aag s \<and> invs s \<and>
+                                is_subject aag pd \<and> pool_for_asid asid s = Some x2 \<and>
+                                vspace_for_asid asid s = Some pd" in hoare_strengthen_post[rotated])
+       apply (fastforce simp: vspace_for_asid_def obind_def entry_for_asid_def entry_for_pool_def
+                       split: if_splits)
+      apply (wpsimp wp: set_asid_pool_integrity_autarch invalidate_tlb_by_asid_invs)+
+  apply (clarsimp simp: vspace_for_asid_def entry_for_asid_def entry_for_pool_def in_obind_eq)
+  done
+
+lemma vcpu_finalise_integrity_autarch:
+  "\<lbrace>integrity aag X st and K (is_subject aag vr)\<rbrace>
+   vcpu_finalise vr
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vcpu_finalise_def
+  apply (wpsimp wp: dissociate_vcpu_tcb_respects get_vcpu_wp)
+  apply (erule (2) associated_tcb_is_subject)
+  done
+
+lemma arch_finalise_cap_respects[Finalise_AC_assms, wp]:
+  "\<lbrace>integrity aag X st and invs and pas_refined aag and valid_cap (ArchObjectCap cap)
+                       and K (pas_cap_cur_auth aag (ArchObjectCap cap))\<rbrace>
+   arch_finalise_cap cap final
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (simp add: arch_finalise_cap_def)
+  apply (wpsimp wp: unmap_page_respects unmap_page_table_respects
+                    delete_asid_respects delete_asid_pool_respects vcpu_finalise_integrity_autarch)
+  apply (auto simp: cap_auth_conferred_def arch_cap_auth_conferred_def wellformed_mapdata_def
+                    aag_cap_auth_def pas_refined_all_auth_is_owns valid_cap_simps
+                    cap_links_asid_slot_def label_owns_asid_slot_def
+             intro: pas_refined_Control_into_is_subject_asid)
+  done
+
+declare prepare_thread_delete_st_tcb_at_halted[Finalise_AC_assms]
+declare finalise_cap_valid_list[Finalise_AC_assms]
+declare finalise_cap_replaceable[Finalise_AC_assms]
+
+end
+
+
+global_interpretation Finalise_AC_1?: Finalise_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Finalise_AC_assms)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma cap_revoke_respects'[Finalise_AC_assms]:
+  "s \<turnstile> \<lbrace>(\<lambda>s. trp \<longrightarrow> integrity aag X st s) and K (is_subject aag (fst slot))
+                                           and pas_refined aag and einvs and simple_sched_action\<rbrace>
+       cap_revoke slot
+       \<lbrace>\<lambda>_. (\<lambda>s. trp \<longrightarrow> integrity aag X st s) and pas_refined aag\<rbrace>,
+       \<lbrace>\<lambda>_. (\<lambda>s. trp \<longrightarrow> integrity aag X st s) and pas_refined aag\<rbrace>"
+proof (induct rule: cap_revoke.induct[where ?a1.0=s])
+  case (1 slot s)
+  show ?case
+    apply (subst cap_revoke.simps)
+    apply (rule hoare_pre_spec_validE)
+     apply (wp "1.hyps")
+            apply ((wp preemption_point_inv' | simp add: integrity_subjects_def pas_refined_def)+)[1]
+           apply (wp select_ext_weak_wp cap_delete_respects cap_delete_pas_refined
+                  | simp split del: if_split | wp (once) hoare_vcg_const_imp_lift hoare_drop_imps)+
+    by (auto simp: emptyable_def descendants_of_def
+             dest: reply_slot_not_descendant
+            intro: cca_owned)
+qed
+
+lemma finalise_cap_caps_of_state_nullinv[Finalise_AC_assms]:
+  "\<lbrace>\<lambda>s. P (caps_of_state s) \<and> (\<forall>p. P ((caps_of_state s)(p \<mapsto> NullCap)))\<rbrace>
+   finalise_cap cap final
+   \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
+  by (cases cap;
+      wpsimp wp: suspend_caps_of_state unbind_notification_caps_of_state
+                 unbind_notification_cte_wp_at
+                 hoare_vcg_all_lift hoare_drop_imps
+                 deleting_irq_handler_caps_of_state_nullinv
+           simp: fun_upd_def[symmetric] if_apply_def2 split_del: if_split)
+
+lemma finalise_cap_fst_ret[Finalise_AC_assms]:
+  "\<lbrace>\<lambda>_. P NullCap \<and> (\<forall>a b c. P (Zombie a b c))\<rbrace>
+   finalise_cap cap is_final
+   \<lbrace>\<lambda>rv _. P (fst rv)\<rbrace>"
+  including classic_wp_pre
+  apply (cases cap, simp_all add: arch_finalise_cap_def split del: if_split)
+  apply (wp | simp add: comp_def split del: if_split | fastforce)+
+  apply (rule hoare_pre)
+  apply (wp | simp | (rule hoare_pre, wpc))+
+  done
+
+end
+
+
+global_interpretation Finalise_AC_2?: Finalise_AC_2
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Finalise_AC_assms)
+qed
+
+end
\ No newline at end of file
diff --git a/proof/access-control/AARCH64/ArchInterrupt_AC.thy b/proof/access-control/AARCH64/ArchInterrupt_AC.thy
new file mode 100644
index 0000000000..6adcccd797
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchInterrupt_AC.thy
@@ -0,0 +1,111 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchInterrupt_AC
+imports
+  Interrupt_AC
+begin
+
+context Arch begin global_naming AARCH64
+
+named_theorems Interrupt_AC_assms
+
+definition arch_authorised_irq_ctl_inv ::
+  "'a PAS \<Rightarrow> Invocations_A.arch_irq_control_invocation \<Rightarrow> bool" where
+  "arch_authorised_irq_ctl_inv aag cinv \<equiv>
+     case cinv of (ARMIRQControlInvocation irq x1 x2 trigger) \<Rightarrow>
+       is_subject aag (fst x1) \<and> is_subject aag (fst x2) \<and>
+       (pasSubject aag, Control, pasIRQAbs aag irq) \<in> pasPolicy aag"
+
+lemma arch_invoke_irq_control_pas_refined[Interrupt_AC_assms]:
+  "\<lbrace>pas_refined aag and valid_mdb and arch_irq_control_inv_valid irq_ctl_inv
+                    and K (arch_authorised_irq_ctl_inv aag irq_ctl_inv)\<rbrace>
+   arch_invoke_irq_control irq_ctl_inv
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  apply (cases irq_ctl_inv; simp)
+  apply (wpsimp wp: cap_insert_pas_refined_not_transferable)
+  apply (clarsimp simp: cte_wp_at_caps_of_state clas_no_asid cap_links_irq_def
+                        arch_authorised_irq_ctl_inv_def aag_cap_auth_def
+                        arch_irq_control_inv_valid_def)
+  done
+
+lemma arch_invoke_irq_handler_pas_refined[Interrupt_AC_assms]:
+  "\<lbrace>pas_refined aag and invs and (\<lambda>s. interrupt_states s x1 \<noteq> IRQInactive)\<rbrace>
+   arch_invoke_irq_handler (ACKIrq x1)
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  by wpsimp
+
+lemma arch_invoke_irq_control_respects[Interrupt_AC_assms]:
+  "\<lbrace>integrity aag X st and pas_refined aag and K (arch_authorised_irq_ctl_inv aag acinv)\<rbrace>
+   arch_invoke_irq_control acinv
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (case_tac acinv, clarsimp simp add: setIRQTrigger_def arch_authorised_irq_ctl_inv_def)
+  apply (wpsimp wp: cap_insert_integrity_autarch aag_Control_into_owns_irq
+                    dmo_mol_respects do_machine_op_pas_refined)
+  done
+
+lemma integrity_irq_masks [iff]:
+  "integrity aag X st (s\<lparr>machine_state := machine_state s \<lparr>irq_masks := v\<rparr>\<rparr>) =
+   integrity aag X st s"
+  unfolding integrity_def by simp
+
+lemma arch_invoke_irq_handler_respects[Interrupt_AC_assms]:
+  "\<lbrace>integrity aag X st and pas_refined aag and einvs\<rbrace>
+   arch_invoke_irq_handler (ACKIrq x1)
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  by (wpsimp wp: dmo_wp mol_respects simp: maskInterrupt_def plic_complete_claim_def)
+
+crunch arch_check_irq for inv[Interrupt_AC_assms, wp]: P
+
+end
+
+
+context begin interpretation Arch .
+
+requalify_consts arch_authorised_irq_ctl_inv
+
+end
+
+
+global_interpretation Interrupt_AC_1?: Interrupt_AC_1 "arch_authorised_irq_ctl_inv"
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; (fact Interrupt_AC_assms | wp)?)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma arch_decode_irq_control_invocation_authorised[Interrupt_AC_assms]:
+  "\<lbrace>pas_refined aag and
+    K (is_subject aag (fst slot) \<and> (\<forall>cap \<in> set caps. pas_cap_cur_auth aag cap) \<and>
+       (args \<noteq> [] \<longrightarrow> (pasSubject aag, Control, pasIRQAbs aag (ucast (args ! 0))) \<in> pasPolicy aag))\<rbrace>
+   arch_decode_irq_control_invocation info_label args slot caps
+   \<lbrace>\<lambda>x _. arch_authorised_irq_ctl_inv aag x\<rbrace>, -"
+  unfolding decode_irq_control_invocation_def arch_decode_irq_control_invocation_def Let_def
+            authorised_irq_ctl_inv_def arch_authorised_irq_ctl_inv_def arch_check_irq_def
+  apply (rule hoare_gen_asmE)
+  apply (wpsimp wp: weak_if_wp)
+  apply (cases args, simp_all)
+  apply (cases caps, simp_all)
+  apply (auto simp: is_cap_simps cap_auth_conferred_def
+                    pas_refined_wellformed
+                    pas_refined_all_auth_is_owns aag_cap_auth_def)
+  done
+
+end
+
+
+global_interpretation Interrupt_AC_2?: Interrupt_AC_2 "arch_authorised_irq_ctl_inv"
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Interrupt_AC_assms)
+qed
+
+
+end
diff --git a/proof/access-control/AARCH64/ArchIpc_AC.thy b/proof/access-control/AARCH64/ArchIpc_AC.thy
new file mode 100644
index 0000000000..575161da53
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchIpc_AC.thy
@@ -0,0 +1,233 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchIpc_AC
+imports Ipc_AC
+begin
+
+context Arch begin global_naming AARCH64
+
+named_theorems Ipc_AC_assms
+
+lemma make_fault_message_inv[Ipc_AC_assms, wp]:
+  "make_fault_msg ft t \<lbrace>P\<rbrace>"
+  apply (cases ft, simp_all split del: if_split)
+  by (wp as_user_inv getRestartPC_inv mapM_wp' make_arch_fault_msg_inv | simp add: getRegister_def)+
+
+declare handle_arch_fault_reply_typ_at[Ipc_AC_assms]
+
+crunch cap_insert_ext
+  for integrity_asids[Ipc_AC_assms, wp]: "integrity_asids aag subjects x a st"
+
+lemma arch_derive_cap_auth_derived[Ipc_AC_assms]:
+  "\<lbrace>\<top>\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv _. rv \<noteq> NullCap \<longrightarrow> auth_derived rv (ArchObjectCap acap)\<rbrace>, -"
+  by (case_tac acap;
+      simp add: derive_cap_def arch_derive_cap_def;
+      wpc?;
+      wp?;
+      simp add: auth_derived_def cap_auth_conferred_def arch_cap_auth_conferred_def)
+
+lemma lookup_ipc_buffer_has_auth[Ipc_AC_assms, wp]:
+  "\<lbrace>pas_refined aag and valid_objs\<rbrace>
+   lookup_ipc_buffer True receiver
+   \<lbrace>\<lambda>rv _. ipc_buffer_has_auth aag receiver rv\<rbrace>"
+  apply (rule hoare_pre)
+   apply (simp add: lookup_ipc_buffer_def)
+   apply (wp get_cap_wp thread_get_wp' | wpc)+
+  apply (clarsimp simp: cte_wp_at_caps_of_state ipc_buffer_has_auth_def get_tcb_ko_at[symmetric])
+  apply (frule caps_of_state_tcb_cap_cases [where idx="tcb_cnode_index 4"])
+   apply (simp add: dom_tcb_cap_cases)
+  apply (frule (1) caps_of_state_valid_cap)
+  apply (rule conjI)
+   apply (clarsimp simp: valid_cap_simps cap_aligned_def)
+   apply (erule aligned_add_aligned)
+    apply (rule is_aligned_andI1)
+    apply (drule (1) valid_tcb_objs)
+    apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def
+                   split: if_splits)
+   apply (rule order_trans [OF _ pbfs_atleast_pageBits])
+   apply (simp add: msg_align_bits pageBits_def)
+  apply simp
+  apply (drule (1) cap_auth_caps_of_state)
+  apply (clarsimp simp: aag_cap_auth_def cap_auth_conferred_def arch_cap_auth_conferred_def
+                        vspace_cap_rights_to_auth_def vm_read_write_def)
+  apply (drule bspec)
+   apply (erule (3) ipcframe_subset_page)
+  apply simp
+  done
+
+lemma tcb_context_no_change[Ipc_AC_assms]:
+  "\<exists>ctxt. tcb = tcb\<lparr>tcb_arch := arch_tcb_context_set ctxt (tcb_arch tcb)\<rparr>"
+  apply (cases tcb, clarsimp)
+  apply (case_tac tcb_arch)
+  apply (auto simp: arch_tcb_context_set_def)
+  done
+
+end
+
+
+global_interpretation Ipc_AC_1?: Ipc_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; (fact Ipc_AC_assms)?)
+qed
+
+
+context Arch begin global_naming AARCH64
+
+lemma store_word_offs_respects_in_ipc[Ipc_AC_assms]:
+  "\<lbrace>integrity_tcb_in_ipc aag X receiver epptr TRContext st and
+    K ((\<not> is_subject aag receiver \<longrightarrow> auth_ipc_buffers st receiver = ptr_range buf msg_align_bits)
+        \<and> is_aligned buf msg_align_bits \<and> r < 2 ^ (msg_align_bits - word_size_bits))\<rbrace>
+   store_word_offs buf r v
+   \<lbrace>\<lambda>_. integrity_tcb_in_ipc aag X receiver epptr TRContext st\<rbrace>"
+  apply (simp add: store_word_offs_def storeWord_def pred_conj_def)
+  apply (wp dmo_wp)
+  apply (clarsimp simp: integrity_tcb_in_ipc_def)
+  apply (erule integrity_trans)
+  apply (clarsimp simp: integrity_def)
+  apply (subgoal_tac "\<forall>i \<in> set [0..7].
+                      buf + of_nat r * of_nat word_size + of_int i \<in> ptr_range buf msg_align_bits")
+   apply (fastforce simp: word_rsplit_0 upto.simps atLeastAtMost_upto)
+  apply (fastforce simp add: unat_def word_size_def of_nat_nat[symmetric] word_of_nat_less
+                   simp del: of_nat_nat intro: ptr_range_off_off_mems)
+  done
+
+crunch set_extra_badge
+  for respects_in_ipc[Ipc_AC_assms, wp]: "integrity_tcb_in_ipc aag X receiver epptr TRContext st"
+  (wp: store_word_offs_respects_in_ipc)
+
+crunch handle_arch_fault_reply
+  for pas_refined[Ipc_AC_assms, wp]: "pas_refined aag"
+
+lemma set_mrs_respects_in_ipc[Ipc_AC_assms]:
+  "\<lbrace>integrity_tcb_in_ipc aag X receiver epptr TRContext st and
+    K ((\<not> is_subject aag receiver \<longrightarrow>
+        (case recv_buf of None \<Rightarrow> True | Some buf' \<Rightarrow> auth_ipc_buffers st receiver =
+                                                     ptr_range buf' msg_align_bits)) \<and>
+       (case recv_buf of None \<Rightarrow> True | Some buf' \<Rightarrow> is_aligned buf' msg_align_bits))\<rbrace>
+     set_mrs receiver recv_buf msgs
+   \<lbrace>\<lambda>rv. integrity_tcb_in_ipc aag X receiver epptr TRContext st\<rbrace>"
+  unfolding set_mrs_def set_object_def get_object_def
+  apply (rule hoare_gen_asm)
+  apply (wp mapM_x_wp' store_word_offs_respects_in_ipc
+         | wpc
+         | simp split del: if_split add: zipWithM_x_mapM_x split_def)+
+   apply (clarsimp simp add: set_zip nth_append simp: msg_align_bits' msg_max_length_def
+                   split: if_split_asm)
+   apply (simp add: msg_registers_def msgRegisters_def upto_enum_def fromEnum_def enum_register)
+   apply arith
+   apply simp
+   apply wp+
+  apply (clarsimp simp: arch_tcb_set_registers_def)
+  apply (rule update_tcb_context_in_ipc [unfolded fun_upd_def]; fastforce simp: arch_tcb_context_set_def)
+  done
+
+lemma lookup_ipc_buffer_ptr_range_in_ipc[Ipc_AC_assms]:
+  "\<lbrace>valid_objs and integrity_tcb_in_ipc aag X thread epptr tst st\<rbrace>
+   lookup_ipc_buffer True thread
+   \<lbrace>\<lambda>rv _. \<not> is_subject aag thread \<longrightarrow>
+           (case rv of None \<Rightarrow> True | Some buf' \<Rightarrow> auth_ipc_buffers st thread =
+                                                   ptr_range buf' msg_align_bits)\<rbrace>"
+  unfolding lookup_ipc_buffer_def
+  apply (rule hoare_pre)
+   apply (wp get_cap_wp thread_get_wp' | wpc)+
+  apply (clarsimp simp: cte_wp_at_caps_of_state ipc_buffer_has_auth_def get_tcb_ko_at [symmetric])
+  apply (frule caps_of_state_tcb_cap_cases [where idx = "tcb_cnode_index 4"])
+   apply (simp add: dom_tcb_cap_cases)
+  apply (clarsimp simp: auth_ipc_buffers_def get_tcb_ko_at [symmetric] integrity_tcb_in_ipc_def)
+  apply (drule get_tcb_SomeD)
+  apply (erule(1) valid_objsE)
+  apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def case_bool_if
+                 split: if_split_asm)
+  apply (erule tcb_in_ipc.cases; clarsimp simp: get_tcb_def vm_read_write_def)
+  done
+
+lemma lookup_ipc_buffer_aligned[Ipc_AC_assms]:
+  "\<lbrace>valid_objs\<rbrace>
+   lookup_ipc_buffer True thread
+   \<lbrace>\<lambda>rv _. (case rv of None \<Rightarrow> True | Some buf' \<Rightarrow> is_aligned buf' msg_align_bits)\<rbrace>"
+  unfolding lookup_ipc_buffer_def
+  apply (rule hoare_pre)
+   apply (wp get_cap_wp thread_get_wp' | wpc)+
+  apply (clarsimp simp: cte_wp_at_caps_of_state get_tcb_ko_at [symmetric])
+  apply (frule caps_of_state_tcb_cap_cases [where idx = "tcb_cnode_index 4"])
+   apply (simp add: dom_tcb_cap_cases)
+  apply (frule (1) caps_of_state_valid_cap)
+  apply (clarsimp simp: valid_cap_simps cap_aligned_def)
+  apply (erule aligned_add_aligned)
+   apply (rule is_aligned_andI1)
+   apply (drule (1) valid_tcb_objs)
+   apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def
+                  split: if_splits)
+  apply (rule order_trans [OF _ pbfs_atleast_pageBits])
+  apply (simp add: msg_align_bits pageBits_def)
+  done
+
+lemma handle_arch_fault_reply_respects[Ipc_AC_assms]:
+  "\<lbrace>integrity aag X st and K (is_subject aag thread)\<rbrace>
+   handle_arch_fault_reply fault thread x y
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  by (wpsimp simp: handle_arch_fault_reply_def)
+
+lemma auth_ipc_buffers_kheap_update[Ipc_AC_assms]:
+  "\<lbrakk> x \<in> auth_ipc_buffers st thread; kheap st thread = Some (TCB tcb);
+     kheap s thread = Some (TCB tcb'); tcb_ipcframe tcb = tcb_ipcframe tcb' \<rbrakk>
+     \<Longrightarrow> x \<in> auth_ipc_buffers (s\<lparr>kheap := (kheap s)(thread \<mapsto> TCB tcb)\<rparr>) thread"
+  by (clarsimp simp: auth_ipc_buffers_member_def get_tcb_def caps_of_state_tcb)
+
+lemma auth_ipc_buffers_machine_state_update[Ipc_AC_assms, simp]:
+  "auth_ipc_buffers (machine_state_update f s) = auth_ipc_buffers s"
+  by (clarsimp simp: auth_ipc_buffers_def get_tcb_def)
+
+lemma cap_insert_ext_integrity_asids_in_ipc[Ipc_AC_assms, wp]:
+  "cap_insert_ext src_parent src_slot dest_slot src_p dest_p
+   \<lbrace>\<lambda>s. integrity_asids aag subjects x asid st
+          (s\<lparr>kheap := \<lambda>a. if a = receiver then kheap st receiver else kheap s a\<rparr>)\<rbrace>"
+  by wpsimp
+
+declare handle_arch_fault_reply_inv[Ipc_AC_assms]
+declare arch_get_sanitise_register_info_inv[Ipc_AC_assms]
+
+end
+
+
+context is_extended begin interpretation Arch .
+
+lemma list_integ_lift_in_ipc[Ipc_AC_assms]:
+  assumes li:
+   "\<lbrace>list_integ (cdt_change_allowed aag {pasSubject aag} (cdt st) (tcb_states_of_state st)) st and Q\<rbrace>
+    f
+    \<lbrace>\<lambda>_. list_integ (cdt_change_allowed aag {pasSubject aag} (cdt st) (tcb_states_of_state st)) st\<rbrace>"
+  assumes ekh: "\<And>P. \<lbrace>\<lambda>s. P (ekheap s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
+  assumes rq: "\<And>P. \<lbrace> \<lambda>s. P (ready_queues s) \<rbrace> f \<lbrace> \<lambda>rv s. P (ready_queues s) \<rbrace>"
+  shows "\<lbrace>integrity_tcb_in_ipc aag X receiver epptr ctxt st and Q\<rbrace>
+         f
+         \<lbrace>\<lambda>_. integrity_tcb_in_ipc aag X receiver epptr ctxt st\<rbrace>"
+  apply (unfold integrity_tcb_in_ipc_def integrity_def[abs_def] pool_for_asid_def)
+  apply (simp del:split_paired_All)
+  apply (rule hoare_pre)
+   apply (simp only: integrity_cdt_list_as_list_integ)
+   apply (rule hoare_lift_Pf2[where f="ekheap"])
+    apply (simp add: tcb_states_of_state_def get_tcb_def)
+    apply (wp li[simplified tcb_states_of_state_def get_tcb_def] ekh rq)+
+  apply (simp only: integrity_cdt_list_as_list_integ)
+  apply (simp add: tcb_states_of_state_def get_tcb_def)
+  apply (fastforce simp: opt_map_def)
+  done
+
+end
+
+
+global_interpretation Ipc_AC_2?: Ipc_AC_2
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Ipc_AC_assms)
+qed
+
+end
diff --git a/proof/access-control/AARCH64/ArchRetype_AC.thy b/proof/access-control/AARCH64/ArchRetype_AC.thy
new file mode 100644
index 0000000000..c0845be336
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchRetype_AC.thy
@@ -0,0 +1,385 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchRetype_AC
+imports Retype_AC
+begin
+
+
+lemma invs_mdb_cte':
+  "invs s \<Longrightarrow> mdb_cte_at (\<lambda>p. \<exists>c. caps_of_state s p = Some c \<and> NullCap \<noteq> c) (cdt s)"
+  by (drule invs_mdb) (simp add: valid_mdb_def2)
+
+
+context retype_region_proofs begin interpretation Arch .
+
+lemma state_vrefs_eq:
+  "\<lbrakk> valid_vspace_objs s; valid_arch_state s \<rbrakk>
+     \<Longrightarrow> state_vrefs s' = state_vrefs s"
+  apply (insert dev vp)
+  apply (intro ext subset_antisym subsetI)
+   apply (clarsimp simp: state_vrefs_def)
+   apply (frule vs_lookup_level)
+   apply (simp add: vs_lookup_table')
+   apply (prop_tac "kheap s x = kheap s' x")
+    apply (clarsimp simp: s'_def ps_def split: if_splits)
+    apply (case_tac "lvl > max_pt_level")
+     apply (fastforce simp: valid_arch_state_def opt_map_def orthr
+                      dest: vs_lookup_asid_pool
+                     split: option.splits)
+    apply (fastforce simp: valid_arch_state_def valid_pspace_def obj_at_def orthr
+                    dest!: vs_lookup_table_pt_at )
+   apply (fastforce simp: opt_map_def)
+  apply (clarsimp simp: state_vrefs_def)
+  apply (frule vs_lookup_level)
+  apply (prop_tac "kheap s x = kheap s' x")
+   apply (clarsimp simp: s'_def ps_def split: if_splits)
+   apply (case_tac "lvl > max_pt_level")
+    apply (fastforce simp: valid_arch_state_def opt_map_def orthr
+                     dest: vs_lookup_asid_pool
+                    split: option.splits)
+   apply (fastforce simp: valid_arch_state_def valid_pspace_def obj_at_def orthr
+                   dest!: vs_lookup_table_pt_at )
+  apply (fastforce simp: opt_map_def vs_lookup_table'[symmetric])
+  done
+
+end
+
+
+context retype_region_proofs' begin interpretation Arch .
+
+lemma pas_refined:
+  "\<lbrakk> invs s; pas_refined aag s \<rbrakk> \<Longrightarrow> pas_refined aag s'"
+  apply (erule pas_refined_state_objs_to_policy_subset)
+      apply (simp add: state_objs_to_policy_def refs_eq  mdb_and_revokable)
+      apply (subst state_vrefs_eq; fastforce?)
+      apply (rule subsetI, rename_tac x, case_tac x, simp)
+      apply (erule state_bits_to_policy.cases)
+            apply (solves \<open>auto intro!: sbta_caps intro: caps_retype split: cap.split\<close>)
+           apply (solves \<open>auto intro!: sbta_untyped intro: caps_retype split: cap.split\<close>)
+          apply (blast intro: state_bits_to_policy.intros)
+         apply (blast intro: state_bits_to_policy.intros)
+        apply (force intro!: sbta_cdt
+                       dest: caps_of_state_pres invs_mdb_cte'[THEN mdb_cte_atD[rotated]])
+       apply (force intro!: sbta_cdt_transferable
+                      dest: caps_of_state_pres invs_mdb_cte'[THEN mdb_cte_atD[rotated]])
+      apply (blast intro: state_bits_to_policy.intros)
+     apply (subst state_vrefs_eq; fastforce?)
+     apply (force elim!: state_asids_to_policy_aux.cases
+                 intro: state_asids_to_policy_aux.intros caps_retype
+                 split: cap.split
+                 dest: sata_asid[OF caps_retype, rotated])
+    apply clarsimp
+    apply (erule state_irqs_to_policy_aux.cases)
+    apply (solves\<open>auto intro!: sita_controlled intro: caps_retype split: cap.split\<close>)
+   apply (rule domains_of_state)
+  apply simp
+  done
+
+end
+
+
+context Arch begin global_naming AARCH64
+
+named_theorems Retype_AC_assms
+
+declare retype_region_proofs'.pas_refined[Retype_AC_assms]
+
+lemma aobjs_of_detype[simp]:
+  "(aobjs_of (detype S s) p = Some aobj) = (p \<notin> S \<and> aobjs_of s p = Some aobj)"
+  by (simp add: in_omonad detype_def)
+
+lemma pts_of_detype[simp]:
+  "(pts_of (detype S s) p = Some pt) = (p \<notin> S \<and> pts_of s p = Some pt)"
+  by (simp add: in_omonad detype_def)
+
+lemma ptes_of_detype_Some[simp]:
+  "(ptes_of (detype S s) pt_t p = Some pte) = (table_base pt_t p \<notin> S \<and> ptes_of s pt_t p = Some pte)"
+  by (simp add: in_omonad ptes_of_def detype_def)
+
+lemma asid_pools_of_detype:
+  "asid_pools_of (detype S s) = (\<lambda>p. if p\<in>S then None else asid_pools_of s p)"
+  by (rule ext) (simp add: detype_def opt_map_def)
+
+lemma asid_pools_of_detype_Some[simp]:
+  "(asid_pools_of (detype S s) p = Some ap) = (p \<notin> S \<and> asid_pools_of s p = Some ap)"
+  by (simp add: in_omonad detype_def)
+
+lemma pool_for_asid_detype_Some[simp]:
+  "(pool_for_asid asid (detype S s) = Some p) = (pool_for_asid asid s = Some p)"
+  by (simp add: pool_for_asid_def)
+
+lemma vspace_for_pool_detype_Some[simp]:
+  "(vspace_for_pool ap asid (\<lambda>p. if p \<in> S then None else pools p) = Some p) =
+   (ap \<notin> S \<and> vspace_for_pool ap asid pools = Some p)"
+  by (simp add: entry_for_pool_def vspace_for_pool_def obind_def split: option.splits)
+
+lemma vspace_for_asid_detype_Some[simp]:
+  "(vspace_for_asid asid (detype S s) = Some p) =
+   ((\<exists>ap. pool_for_asid asid s = Some ap \<and> ap \<notin> S) \<and> vspace_for_asid asid s = Some p)"
+  by (auto simp: entry_for_asid_def entry_for_pool_def pool_for_asid_def
+                 vspace_for_asid_def obind_def asid_pools_of_detype
+          split: option.splits)
+
+lemma pt_walk_detype:
+  "pt_walk level bot_level pt_ptr vref (ptes_of (detype S s)) = Some (bot_level, p) \<Longrightarrow>
+   pt_walk level bot_level pt_ptr vref (ptes_of s) = Some (bot_level, p)"
+  apply (induct level arbitrary: pt_ptr)
+   apply (subst pt_walk.simps, simp)
+  apply (subst pt_walk.simps)
+  apply (subst (asm) (3) pt_walk.simps)
+  apply (clarsimp simp: in_omonad split: if_split_asm)
+  apply (erule disjE; clarsimp)
+  apply (drule meta_spec, drule (1) meta_mp)
+  apply fastforce
+  done
+
+lemma vs_lookup_table:
+  "vs_lookup_table level asid vref (detype S s) = Some (level, p) \<Longrightarrow>
+   vs_lookup_table level asid vref s = Some (level, p)"
+  apply (clarsimp simp: vs_lookup_table_def in_omonad obind_def asid_pools_of_detype
+                 split: if_split_asm option.split_asm)
+  apply (rule conjI)
+   apply clarsimp
+  apply (subst pt_walk_detype)
+   apply simp
+  apply simp
+  done
+
+lemma state_vrefs_detype[Retype_AC_assms, dest]:
+  "x \<in> state_vrefs (detype R s) p \<Longrightarrow> x \<in> state_vrefs s p"
+  apply (clarsimp simp: state_vrefs_def)
+  apply (frule vs_lookup_level)
+  apply (drule vs_lookup_table)
+  apply (fastforce simp: vspace_objs_of_Some)
+  done
+
+lemma sata_detype[Retype_AC_assms]:
+  "state_asids_to_policy aag (detype R s) \<subseteq> state_asids_to_policy aag s"
+  apply (clarsimp)
+  apply (erule state_asids_to_policy_aux.induct)
+  apply (auto intro: state_asids_to_policy_aux.intros split: if_split_asm)
+  done
+
+lemma word_size_bits_untyped_min_bits[Retype_AC_assms]: "word_size_bits \<le> untyped_min_bits"
+  by (simp add: word_size_bits_def untyped_min_bits_def)
+
+lemma word_size_bits_resetChunkBits[Retype_AC_assms]: "word_size_bits \<le> resetChunkBits"
+  by (simp add: word_size_bits_def Kernel_Config.resetChunkBits_def)
+
+lemma clas_default_cap[Retype_AC_assms]:
+  "tp \<noteq> ArchObject ASIDPoolObj \<Longrightarrow> cap_links_asid_slot aag p (default_cap tp p' sz dev)"
+  unfolding cap_links_asid_slot_def
+  apply (cases tp, simp_all)
+  apply (rename_tac aobject_type)
+  apply (case_tac aobject_type, simp_all add: arch_default_cap_def)
+  done
+
+lemma cli_default_cap[Retype_AC_assms]:
+  "tp \<noteq> ArchObject ASIDPoolObj \<Longrightarrow> cap_links_irq aag p (default_cap tp p' sz dev)"
+  unfolding cap_links_irq_def
+  apply (cases tp, simp_all)
+  done
+
+lemma aobj_refs'_default'[Retype_AC_assms]:
+  "is_aligned oref (obj_bits_api (ArchObject tp) sz)
+   \<Longrightarrow> aobj_ref' (arch_default_cap tp oref sz dev) \<subseteq> ptr_range oref (obj_bits_api (ArchObject tp) sz)"
+  by (cases tp; simp add: arch_default_cap_def ptr_range_memI obj_bits_api_def default_arch_object_def)
+
+crunch init_arch_objects
+  for pas_refined[wp]: "pas_refined aag"
+  and integrity_autarch[wp]: "integrity aag X st"
+  (wp: crunch_wps dmo_no_mem_respects)
+
+lemma region_in_kernel_window_preserved:
+  assumes "\<And>P. f \<lbrace>\<lambda>s. P (arch_state s)\<rbrace>"
+  shows "\<And>S. f \<lbrace>region_in_kernel_window S\<rbrace>"
+  apply (clarsimp simp: valid_def region_in_kernel_window_def)
+  apply (erule use_valid)
+  apply (rule assms)
+  apply fastforce
+  done
+
+(* proof clagged from Retype_AI.clearMemory_vms *)
+lemma freeMemory_vms:
+  "valid_machine_state s \<Longrightarrow>
+   \<forall>x\<in>fst (freeMemory ptr bits (machine_state s)). valid_machine_state (s\<lparr>machine_state := snd x\<rparr>)"
+  apply (clarsimp simp: valid_machine_state_def disj_commute[of "in_user_frame p s" for p s])
+  apply (drule_tac x=p in spec, simp)
+  apply (drule_tac P4="\<lambda>m'. underlying_memory m' p = 0"
+                in use_valid[where P=P and Q="\<lambda>_. P" for P], simp_all)
+  apply (simp add: freeMemory_def machine_op_lift_def machine_rest_lift_def split_def)
+  apply (wp hoare_drop_imps | simp | wp mapM_x_wp_inv)+
+   apply (simp add: storeWord_def | wp)+
+   apply (simp add: word_rsplit_0 upto.simps word_bits_def)
+  apply simp
+  done
+
+lemma dmo_freeMemory_vms:
+  "do_machine_op (freeMemory ptr bits) \<lbrace>valid_machine_state\<rbrace>"
+  apply (unfold do_machine_op_def)
+  apply (wp modify_wp freeMemory_vms | simp add: split_def)+
+  done
+
+lemma freeMemory_valid_irq_states:
+  "freeMemory ptr bits \<lbrace>\<lambda>ms. valid_irq_states (s\<lparr>machine_state := ms\<rparr>)\<rbrace>"
+  unfolding freeMemory_def
+  by (wp mapM_x_wp[OF _ subset_refl] storeWord_valid_irq_states)
+
+crunch freeMemory
+  for pspace_respects_device_region[wp]: "\<lambda>ms. P (device_state ms)"
+  (wp: crunch_wps)
+
+lemma dmo_freeMemory_invs[Retype_AC_assms]:
+  "do_machine_op (freeMemory ptr bits) \<lbrace>invs\<rbrace>"
+  apply (simp add: do_machine_op_def invs_def valid_state_def cur_tcb_def | wp | wpc)+
+  apply (clarsimp)
+  apply (frule_tac P1="(=) (device_state (machine_state s))"
+                in use_valid[OF _ freeMemory_pspace_respects_device_region])
+   apply simp
+  apply simp
+  apply (rule conjI)
+   apply (erule use_valid[OF _ freeMemory_valid_irq_states], simp)
+  apply (drule freeMemory_vms)
+  apply auto
+  done
+
+crunch delete_objects
+  for global_refs[wp]: "\<lambda>s. P (global_refs s)"
+  (ignore: do_machine_op freeMemory)
+
+lemma init_arch_objects_pas_cur_domain[Retype_AC_assms, wp]:
+  "init_arch_objects tp dev ptr n us refs \<lbrace>pas_cur_domain aag\<rbrace>"
+  by wp
+
+lemma retype_region_pas_cur_domain[Retype_AC_assms, wp]:
+  "retype_region ptr n us tp dev \<lbrace>pas_cur_domain aag\<rbrace>"
+  by wp
+
+lemma reset_untyped_cap_pas_cur_domain[Retype_AC_assms, wp]:
+  "reset_untyped_cap src_slot \<lbrace>pas_cur_domain aag\<rbrace>"
+  by wp
+
+lemma arch_data_to_obj_type_not_ASIDPoolObj[Retype_AC_assms, simp]:
+  "arch_data_to_obj_type v \<noteq> Some ASIDPoolObj"
+  by (clarsimp simp: arch_data_to_obj_type_def)
+
+lemma data_to_nat_of_nat[Retype_AC_assms, simp]:
+  "of_nat (data_to_nat x) = x"
+  by simp
+
+lemma nonzero_data_to_nat_simp[Retype_AC_assms]:
+  "0 < data_to_nat x \<Longrightarrow> 0 < x"
+  by (auto dest: word_of_nat_less)
+
+lemma storeWord_integrity_autarch:
+  "\<lbrace>\<lambda>ms. integrity aag X st (s\<lparr>machine_state := ms\<rparr>) \<and>
+         (is_aligned p word_size_bits \<longrightarrow> (\<forall>p' \<in> ptr_range p word_size_bits. is_subject aag p'))\<rbrace>
+   storeWord p v
+   \<lbrace>\<lambda>_ ms. integrity aag X st (s\<lparr>machine_state := ms\<rparr>)\<rbrace>"
+  unfolding storeWord_def
+  apply wp
+  by (auto simp: upto.simps integrity_def is_aligned_mask [symmetric] word_size_bits_def word_bits_def
+            intro!: trm_lrefl ptr_range_memI ptr_range_add_memI)
+
+(* TODO: proof has mainly been copied from dmo_clearMemory_respects *)
+lemma dmo_freeMemory_respects[Retype_AC_assms]:
+  "\<lbrace>integrity aag X st and K (is_aligned ptr bits \<and> bits < word_bits \<and> word_size_bits \<le> bits \<and>
+                              (\<forall>p \<in> ptr_range ptr bits. is_subject aag p))\<rbrace>
+   do_machine_op (freeMemory ptr bits)
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding do_machine_op_def freeMemory_def
+  apply (simp add: split_def)
+  apply wp
+  apply clarsimp
+  apply (erule use_valid)
+   apply (wpsimp wp: mol_respects mapM_x_wp' storeWord_integrity_autarch)
+   apply (clarsimp simp: word_size_def word_size_bits_def word_bits_def
+                         upto_enum_step_shift_red[where us=3, simplified])
+   apply (erule bspec)
+   apply (erule set_mp [rotated])
+   apply (rule ptr_range_subset)
+      apply simp
+     apply (simp add: is_aligned_mult_triv2 [where n = 3, simplified])
+    apply assumption
+   apply (erule word_less_power_trans_ofnat [where k = 3, simplified])
+    apply assumption
+   apply simp
+  apply simp
+  done
+
+lemma storeWord_respects:
+  "\<lbrace>\<lambda>ms. integrity aag X st (s\<lparr>machine_state := ms\<rparr>) \<and>
+         (\<forall>p' \<in> ptr_range p word_size_bits. aag_has_auth_to aag Write p')\<rbrace>
+   storeWord p v
+   \<lbrace>\<lambda>_ ms. integrity aag X st (s\<lparr>machine_state := ms\<rparr>)\<rbrace>"
+  unfolding storeWord_def word_size_bits_def
+  apply wp
+  by (auto simp: upto.simps integrity_def is_aligned_mask [symmetric] word_bits_def
+            intro!: trm_write ptr_range_memI ptr_range_add_memI)
+
+lemma dmo_clearMemory_respects'[Retype_AC_assms]:
+  "\<lbrace>integrity aag X st and
+    K (is_aligned ptr bits \<and> bits < word_bits \<and> word_size_bits \<le> bits \<and>
+       (\<forall>p \<in> ptr_range ptr bits. aag_has_auth_to aag Write p))\<rbrace>
+   do_machine_op (clearMemory ptr (2 ^ bits))
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding do_machine_op_def clearMemory_def
+  apply (simp add: split_def )
+  apply wp
+  apply clarsimp
+  apply (erule use_valid)
+    apply (wp mol_respects mapM_x_wp' storeWord_respects)+
+   apply (simp add: word_size_bits_def)
+   apply (clarsimp simp: word_size_def word_bits_def upto_enum_step_shift_red[where us=3, simplified])
+   apply (erule bspec)
+   apply (erule set_mp [rotated])
+   apply (rule ptr_range_subset)
+      apply simp
+     apply (simp add: is_aligned_mult_triv2 [where n = 3, simplified])
+    apply assumption
+   apply (erule word_less_power_trans_ofnat [where k = 3, simplified])
+    apply assumption
+   apply simp
+  apply simp
+  done
+
+lemma integrity_asids_detype[Retype_AC_assms]:
+  assumes refs: "\<forall>r\<in>refs. pasObjectAbs aag r \<in> subjects"
+  shows
+    "integrity_asids aag subjects x a (detype refs s) s' =
+     integrity_asids aag subjects x a s s'"
+    "integrity_asids aag subjects x a s (detype refs s') =
+     integrity_asids aag subjects x a s s'"
+  by (auto simp: detype_def refs opt_map_def)
+
+lemma retype_region_integrity_asids[Retype_AC_assms]:
+  "\<lbrakk> range_cover ptr sz (obj_bits_api typ o_bits) n; typ \<noteq> Untyped;
+     \<forall>x\<in>up_aligned_area ptr sz. is_subject aag x; integrity_asids aag {pasSubject aag} x a s st \<rbrakk>
+     \<Longrightarrow> integrity_asids aag {pasSubject aag} x a s
+           (st\<lparr>kheap := \<lambda>a. if a \<in> (\<lambda>x. ptr_add ptr (x * 2 ^ obj_bits_api typ o_bits)) ` {0 ..< n}
+                            then Some (default_object typ dev o_bits)
+                            else kheap s a\<rparr>)"
+  apply (clarsimp simp: opt_map_def)
+  apply (case_tac "x \<in> up_aligned_area ptr sz"; clarsimp)
+  apply (fastforce intro: tro_lrefl tre_lrefl
+                    dest: retype_addrs_subset_ptr_bits[simplified retype_addrs_def]
+                    simp: image_def p_assoc_help power_sub)
+  done
+
+end
+
+
+global_interpretation Retype_AC_1?: Retype_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; (fact Retype_AC_assms | wpsimp))
+qed
+
+requalify_facts AARCH64.storeWord_respects
+
+end
diff --git a/proof/access-control/AARCH64/ArchSyscall_AC.thy b/proof/access-control/AARCH64/ArchSyscall_AC.thy
new file mode 100644
index 0000000000..92a64193db
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchSyscall_AC.thy
@@ -0,0 +1,352 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchSyscall_AC
+imports Syscall_AC
+begin
+
+context Arch begin global_naming AARCH64
+
+named_theorems Syscall_AC_assms
+
+crunch set_original
+  for idle_thread[wp]: "\<lambda>s. P (idle_thread s)"
+  and cur_thread[wp]: "\<lambda>s. P (cur_thread s)"
+
+crunch prepare_thread_delete
+  for idle_thread[Syscall_AC_assms, wp]: "\<lambda>s. P (idle_thread s)"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma cap_move_idle_thread[Syscall_AC_assms, wp]:
+  "cap_move new_cap src_slot dest_slot \<lbrace>\<lambda>s. P (idle_thread s)\<rbrace>"
+  unfolding cap_move_def
+  by (wpsimp wp: dxo_wp_weak)
+
+lemma cancel_badged_sends_idle_thread[Syscall_AC_assms, wp]:
+  "cancel_badged_sends epptr badge \<lbrace>\<lambda>s. P (idle_thread s)\<rbrace>"
+  unfolding cancel_badged_sends_def
+  by (wpsimp wp: dxo_wp_weak mapM_wp_inv get_simple_ko_wp simp: filterM_mapM)
+
+declare arch_finalise_cap_idle_thread[Syscall_AC_assms]
+
+lemma invs_irq_state_update[Syscall_AC_assms, simp]:
+  "invs (s\<lparr>machine_state := irq_state_update f sa\<rparr>) = invs (s\<lparr>machine_state := sa\<rparr>)"
+  apply (rule iffI)
+   apply (subst invs_irq_state_independent[where f=f, symmetric])
+   apply (erule back_subst[where P=invs])
+   apply clarsimp
+  apply (subst (asm) invs_irq_state_independent[where f=f, symmetric])
+  apply clarsimp
+  apply (erule back_subst[where P=invs])
+  apply clarsimp
+  done
+
+crunch prepare_thread_delete, arch_finalise_cap
+  for cur_thread[Syscall_AC_assms, wp]: "\<lambda>s. P (cur_thread s)"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma cap_move_cur_thread[Syscall_AC_assms, wp]:
+  "cap_move new_cap src_slot dest_slot \<lbrace>\<lambda>s. P (cur_thread s)\<rbrace>"
+  unfolding cap_move_def
+  by (wpsimp wp: dxo_wp_weak)
+
+lemma cancel_badged_sends_cur_thread[Syscall_AC_assms, wp]:
+  "cancel_badged_sends epptr badge \<lbrace>\<lambda>s. P (cur_thread s)\<rbrace>"
+  unfolding cancel_badged_sends_def
+  by (wpsimp wp: dxo_wp_weak filterM_preserved crunch_wps)
+
+crunch arch_mask_irq_signal
+  for pas_refined[Syscall_AC_assms, wp]: "pas_refined aag"
+  (wp: crunch_wps simp: crunch_simps)
+
+crunch handle_vm_fault
+  for pas_refined[Syscall_AC_assms, wp]: "pas_refined aag"
+  and cur_thread[Syscall_AC_assms, wp]: "\<lambda>s. P (cur_thread s)"
+  and state_refs_of[Syscall_AC_assms, wp]: "\<lambda>s. P (state_refs_of s)"
+
+lemma handle_vm_fault_integrity[Syscall_AC_assms]:
+  "\<lbrace>integrity aag X st and K (is_subject aag thread)\<rbrace>
+   handle_vm_fault thread vmfault_type
+   \<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
+  unfolding handle_vm_fault_def addressTranslateS1_def
+  by (cases vmfault_type; wpsimp wp: dmo_no_mem_respects as_user_integrity_autarch )
+
+crunch ackInterrupt, resetTimer
+  for underlying_memory_inv[Syscall_AC_assms, wp]: "\<lambda>s. P (underlying_memory s)"
+  (simp: maskInterrupt_def)
+
+crunch arch_mask_irq_signal
+  for integrity[Syscall_AC_assms, wp]: "integrity aag X st"
+  (wp: dmo_no_mem_respects)
+
+lemma set_thread_state_restart_to_running_respects[Syscall_AC_assms]:
+  "\<lbrace>integrity aag X st and st_tcb_at ((=) Restart) thread and K (pasMayActivate aag)\<rbrace>
+   do pc \<leftarrow> as_user thread getRestartPC;
+            as_user thread $ setNextPC pc;
+            set_thread_state thread Structures_A.thread_state.Running
+   od
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (simp add: set_thread_state_def as_user_def split_def setNextPC_def
+                   getRestartPC_def setRegister_def bind_assoc getRegister_def)
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: in_monad fun_upd_def[symmetric] cong: if_cong)
+  apply (cases "is_subject aag thread")
+   apply (cut_tac aag=aag in integrity_update_autarch, simp+)
+  apply (erule integrity_trans)
+  apply (clarsimp simp: integrity_def obj_at_def st_tcb_at_def integrity_asids_kh_upds opt_map_def)
+  apply (clarsimp dest!: get_tcb_SomeD)
+  apply (rule_tac tro_tcb_activate[OF refl refl])
+    apply (simp add: tcb_bound_notification_reset_integrity_def ctxt_IP_update_def
+              split: user_context.splits)+
+  done
+
+lemma getActiveIRQ_inv[Syscall_AC_assms]:
+  "\<forall>f s. P s \<longrightarrow> P (irq_state_update f s)
+   \<Longrightarrow> \<lbrace>P\<rbrace> getActiveIRQ irq \<lbrace>\<lambda>rv. P\<rbrace>"
+  by (wpsimp simp: irq_state_independent_def)
+
+lemma getActiveIRQ_rv_None[Syscall_AC_assms]:
+  "\<lbrace>\<top>\<rbrace> getActiveIRQ True \<lbrace>\<lambda>rv ms. (rv \<noteq> None \<longrightarrow> the rv \<notin> non_kernel_IRQs)\<rbrace>"
+  by (wpsimp simp: getActiveIRQ_def)
+
+lemma arch_activate_idle_thread_respects[Syscall_AC_assms, wp]:
+  "arch_activate_idle_thread t \<lbrace>integrity aag X st\<rbrace>"
+  unfolding arch_activate_idle_thread_def by wpsimp
+
+lemma arch_activate_idle_thread_pas_refined[Syscall_AC_assms, wp]:
+  "arch_activate_idle_thread t \<lbrace>pas_refined aag\<rbrace>"
+  unfolding arch_activate_idle_thread_def by wpsimp
+
+crunch arch_switch_to_thread, arch_switch_to_idle_thread
+  for integrity[Syscall_AC_assms, wp]: "integrity aag X st"
+  and pas_refined[Syscall_AC_assms, wp]: "pas_refined aag"
+  (wp: crunch_wps vcpu_switch_respects simp: crunch_simps)
+
+lemma handle_reserved_irq_arch_state[Syscall_AC_assms, wp]:
+  "handle_reserved_irq irq \<lbrace>\<lambda>s :: det_ext state. P (arch_state s)\<rbrace>"
+  unfolding handle_reserved_irq_def by wpsimp
+
+crunch arch_post_cap_deletion
+  for ct_active[Syscall_AC_assms, wp]: "ct_active"
+  (wp: crunch_wps filterM_preserved unless_wp simp: crunch_simps ignore: do_extended_op)
+
+crunch
+  arch_post_modify_registers, arch_invoke_irq_control,
+  arch_invoke_irq_handler, arch_perform_invocation, arch_mask_irq_signal,
+   handle_vm_fault,  handle_arch_fault_reply
+  for cur_thread[Syscall_AC_assms, wp]: "\<lambda>s. P (cur_thread s)"
+  and idle_thread[Syscall_AC_assms, wp]: "\<lambda>s. P (idle_thread s)"
+  and cur_domain[Syscall_AC_assms, wp]:  "\<lambda>s. P (cur_domain s)"
+  (wp: crunch_wps simp: crunch_simps)
+
+crunch handle_hypervisor_fault
+  for idle_thread[Syscall_AC_assms, wp]: "\<lambda>s :: det_ext state. P (idle_thread s)"
+  (wp: crunch_wps  simp: crunch_simps)
+
+crunch handle_reserved_irq
+  for idle_thread[Syscall_AC_assms, wp]: "\<lambda>s :: det_ext state. P (idle_thread s)"
+  (wp: crunch_wps simp: crunch_simps)
+
+crunch set_extra_badge
+ for cur_domain[Syscall_AC_assms, wp]:  "\<lambda>s :: det_ext state. P (cur_domain s)"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma transfer_caps_loop_cur_domain[wp]:
+  "transfer_caps_loop ep rcv_buffer n caps slots mi \<lbrace>\<lambda>s :: det_ext state. P (cur_domain s)\<rbrace>"
+  supply if_split[split del]
+  apply (induct caps arbitrary: slots n mi)
+   apply (wpsimp | assumption)+
+  done
+
+crunch handle_hypervisor_fault
+  for cur_domain[Syscall_AC_assms, wp]:  "\<lambda>s :: det_ext state. P (cur_domain s)"
+  (wp: crunch_wps simp: crunch_simps ignore_del: possible_switch_to)
+
+crunch handle_reserved_irq
+  for cur_domain[Syscall_AC_assms, wp]:  "\<lambda>s :: det_ext state. P (cur_domain s)"
+  (wp: crunch_wps simp: crunch_simps)
+
+crunch vgic_update_lr, vgic_update
+  for integrity_autarch[Syscall_AC_assms, wp]: "integrity aag X st"
+
+lemma vgic_maintenance_integrity_autarch:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> pas_refined aag s \<and> is_subject aag (cur_thread s) \<and> invs s\<rbrace>
+   vgic_maintenance
+   \<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
+  (is "\<lbrace>?P\<rbrace> _ \<lbrace>_\<rbrace>")
+  unfolding vgic_maintenance_def vgic_update_lr_def get_gic_vcpu_ctrl_misr_def
+            get_gic_vcpu_ctrl_eisr0_def get_gic_vcpu_ctrl_eisr1_def
+  apply (wpsimp wp: handle_fault_integrity_autarch gts_wp dmo_no_mem_respects split_del: if_split
+         | wpsimp wp: hoare_vcg_all_lift hoare_drop_imps)+
+  apply (frule invs_cur)
+  apply (frule invs_valid_cur_vcpu)
+  apply (clarsimp simp: valid_fault_def cur_tcb_def tcb_at_def)
+  apply (fastforce intro: associated_vcpu_is_subject
+                    simp: valid_cur_vcpu_def pred_tcb_at_def obj_at_def active_cur_vcpu_of_def get_tcb_def)
+  done
+
+lemma vppi_event_integrity_autarch:
+  "\<lbrace>\<lambda>s.  integrity aag X st s \<and> pas_refined aag s \<and> (is_subject aag (cur_thread s)) \<and> invs s\<rbrace>
+   vppi_event irq
+   \<lbrace>\<lambda>_ s. integrity aag X st s\<rbrace>"
+  unfolding vppi_event_def
+  apply (wpsimp wp: handle_fault_integrity_autarch maskInterrupt_invs dmo_no_mem_respects
+                    vcpu_update_integrity_autarch vcpu_update_pas_refined vcpu_update_trivial_invs
+              simp: if_fun_split
+         | wpsimp wp: hoare_vcg_all_lift hoare_drop_imps)+
+  apply (frule invs_cur)
+  apply (frule invs_valid_cur_vcpu)
+  apply (clarsimp simp: valid_fault_def cur_tcb_def tcb_at_def)
+  apply (fastforce intro: associated_vcpu_is_subject
+                    simp: valid_cur_vcpu_def pred_tcb_at_def obj_at_def active_cur_vcpu_of_def get_tcb_def)
+  done
+
+lemma handle_reserved_irq_integrity_autarch[Syscall_AC_assms]:
+    "\<lbrace>integrity aag X st and pas_refined aag and invs and (\<lambda>s. is_subject aag (cur_thread s))\<rbrace>
+     handle_reserved_irq irq
+     \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding handle_reserved_irq_def
+  by (wpsimp wp: vppi_event_integrity_autarch vgic_maintenance_integrity_autarch)
+
+lemma vppi_event_pas_refined:
+  "\<lbrace>\<lambda>s. pas_refined aag s \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s)) \<and> invs s\<rbrace>
+   vppi_event irq
+   \<lbrace>\<lambda>_ s. pas_refined aag s\<rbrace>"
+  unfolding vppi_event_def
+  apply (wpsimp wp: handle_fault_pas_refined gts_wp vcpu_update_pas_refined)
+       apply (rule hoare_lift_Pf2[where f="cur_thread", rotated])
+        apply wpsimp
+       apply (wpsimp wp: vcpu_update_pas_refined vcpu_update_trivial_invs
+                         hoare_vcg_all_lift hoare_vcg_imp_lift)
+      apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s)) \<and> invs s"
+                   in hoare_strengthen_post[rotated])
+       apply (clarsimp simp: valid_fault_def ct_in_state_def pred_tcb_at_def obj_at_def runnable_eq)
+      apply (wpsimp wp: maskInterrupt_invs  hoare_vcg_imp_lift)+
+  done
+
+lemma vgic_maintenance_pas_refined:
+  "\<lbrace>\<lambda>s. pas_refined aag s \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s)) \<and> invs s\<rbrace>
+   vgic_maintenance
+   \<lbrace>\<lambda>_ s. pas_refined aag s\<rbrace>"
+  unfolding vgic_maintenance_def vgic_update_lr_def vgic_update_def
+            get_gic_vcpu_ctrl_misr_def get_gic_vcpu_ctrl_eisr1_def get_gic_vcpu_ctrl_eisr0_def
+  apply (wpsimp wp: handle_fault_pas_refined gts_wp vcpu_update_pas_refined)
+               apply (rule hoare_lift_Pf2[where f="cur_thread", rotated])
+                apply wpsimp
+               apply (wpsimp wp: vcpu_update_pas_refined vcpu_update_trivial_invs
+                                 hoare_vcg_all_lift hoare_vcg_imp_lift)
+              apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s)) \<and> invs s"
+                           in hoare_strengthen_post[rotated])
+               apply (clarsimp simp: valid_fault_def ct_in_state_def pred_tcb_at_def obj_at_def runnable_eq)
+              apply ((wpsimp wp: hoare_vcg_imp_lift)+)[4]
+          apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s)) \<and> invs s"
+                       in hoare_strengthen_post[rotated])
+           apply (auto simp: valid_fault_def ct_in_state_def pred_tcb_at_def obj_at_def runnable_eq)[1]
+          apply wpsimp+
+  done
+
+lemma handle_reserved_irq_pas_refined[Syscall_AC_assms]:
+  "\<lbrace>\<lambda>s. pas_refined aag s \<and> invs s \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s))\<rbrace>
+   handle_reserved_irq irq
+   \<lbrace>\<lambda>_ s. pas_refined aag s\<rbrace>"
+  unfolding handle_reserved_irq_def
+  by (wpsimp wp: vppi_event_pas_refined vgic_maintenance_pas_refined)
+
+lemma vgic_maintenance_idle:
+  "\<lbrace>integrity aag X st and invs and ct_idle\<rbrace>
+   vgic_maintenance
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vgic_maintenance_def
+  apply (rule bind_wp)
+   apply (rule_tac P'="\<lambda>s. integrity aag X st s \<and> (\<forall>v. rv \<noteq> Some (v,True))" in hoare_weaken_pre)
+    apply (case_tac rv; clarsimp)
+    apply (case_tac b; clarsimp)
+   apply assumption
+  apply (wpsimp)
+  apply (prop_tac "only_idle s")
+   apply (clarsimp simp: invs_def valid_state_def)
+  apply (prop_tac "arch_tcb_at (\<lambda>itcb. itcb_vcpu itcb = None) (idle_thread s) s")
+   apply (frule invs_valid_idle)
+   apply (clarsimp simp: valid_idle_def pred_tcb_at_def valid_arch_idle_def obj_at_def)
+  apply (frule invs_valid_cur_vcpu)
+  apply (clarsimp simp: valid_cur_vcpu_def only_idle_def pred_tcb_at_def
+                        ct_in_state_def obj_at_def active_cur_vcpu_of_def)
+  done
+
+lemma vppi_event_idle:
+  "\<lbrace>integrity aag X st and invs and ct_idle\<rbrace>
+   vppi_event irq
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding vppi_event_def
+  apply (rule bind_wp)
+   apply (rule_tac P'="\<lambda>s. integrity aag X st s \<and> (\<forall>v. rv \<noteq> Some (v,True))" in hoare_weaken_pre)
+    apply (case_tac rv; clarsimp)
+    apply (case_tac b; clarsimp)
+   apply assumption
+  apply (wpsimp)
+  apply (prop_tac "only_idle s")
+   apply (clarsimp simp: invs_def valid_state_def)
+  apply (prop_tac "arch_tcb_at (\<lambda>itcb. itcb_vcpu itcb = None) (idle_thread s) s")
+   apply (frule invs_valid_idle)
+   apply (clarsimp simp: valid_idle_def pred_tcb_at_def valid_arch_idle_def obj_at_def)
+  apply (frule invs_valid_cur_vcpu)
+  apply (clarsimp simp: valid_cur_vcpu_def only_idle_def pred_tcb_at_def
+                        ct_in_state_def obj_at_def active_cur_vcpu_of_def)
+  done
+
+lemma handle_reserved_irq_idle[Syscall_AC_assms]:
+  "\<lbrace>integrity aag X st and invs and ct_idle\<rbrace>
+   handle_reserved_irq irq
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  unfolding handle_reserved_irq_def
+  by (wpsimp wp: vppi_event_idle vgic_maintenance_idle)
+
+lemma handle_hypervisor_fault_pas_refined[Syscall_AC_assms, wp]:
+  "\<lbrace>\<lambda>s. pas_refined aag s \<and> is_subject aag (cur_thread s) \<and> is_subject aag thread \<and> invs s\<rbrace>
+   handle_hypervisor_fault thread fault
+   \<lbrace>\<lambda>_ s. pas_refined aag s\<rbrace>"
+  apply (case_tac fault)
+  apply clarify
+  apply (subst handle_hypervisor_fault.simps)
+  apply (wpsimp wp: handle_fault_pas_refined simp: getESR_def isFpuEnable_def valid_fault_def)
+  done
+
+lemma handle_hypervisor_fault_integrity_autarch[Syscall_AC_assms, wp]:
+  "\<lbrace>\<lambda>s. integrity aag X st s \<and> pas_refined aag s \<and> invs s \<and> is_subject aag thread
+                             \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s))\<rbrace>
+   handle_hypervisor_fault thread fault
+   \<lbrace>\<lambda>_ s. integrity aag X st s\<rbrace>"
+  apply (case_tac fault)
+  apply clarify
+  apply (subst handle_hypervisor_fault.simps)
+  apply (wpsimp wp: handle_fault_integrity_autarch simp: getESR_def isFpuEnable_def valid_fault_def)
+  done
+
+\<comment> \<open>These aren't proved in the previous crunch, and hence need to be declared\<close>
+declare handle_arch_fault_reply_it[Syscall_AC_assms]
+declare handle_arch_fault_reply_cur_thread[Syscall_AC_assms]
+declare arch_invoke_irq_control_cur_thread[Syscall_AC_assms]
+declare arch_invoke_irq_handler_cur_thread[Syscall_AC_assms]
+declare arch_mask_irq_signal_cur_thread[Syscall_AC_assms]
+declare handle_reserved_irq_cur_thread[Syscall_AC_assms]
+declare handle_hypervisor_fault_cur_thread[Syscall_AC_assms]
+declare handle_vm_fault_cur_thread[Syscall_AC_assms]
+declare ackInterrupt_underlying_memory_inv[Syscall_AC_assms]
+declare resetTimer_underlying_memory_inv[Syscall_AC_assms]
+declare arch_mask_irq_signal_arch_state[Syscall_AC_assms]
+declare init_arch_objects_arch_state[Syscall_AC_assms]
+
+end
+
+
+global_interpretation Syscall_AC_1?: Syscall_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Syscall_AC_assms)
+qed
+
+end
diff --git a/proof/access-control/AARCH64/ArchTcb_AC.thy b/proof/access-control/AARCH64/ArchTcb_AC.thy
new file mode 100644
index 0000000000..39c1a4a2e8
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchTcb_AC.thy
@@ -0,0 +1,110 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchTcb_AC
+imports Tcb_AC
+begin
+
+context Arch begin global_naming AARCH64
+
+named_theorems Tcb_AC_assms
+
+declare arch_get_sanitise_register_info_inv[Tcb_AC_assms]
+
+crunch arch_post_modify_registers
+  for pas_refined[Tcb_AC_assms, wp]: "pas_refined aag"
+
+lemma arch_post_modify_registers_respects[Tcb_AC_assms]:
+  "\<lbrace>integrity aag X st and K (is_subject aag t)\<rbrace>
+   arch_post_modify_registers cur t
+   \<lbrace>\<lambda>_ s. integrity aag X st s\<rbrace>"
+  by wpsimp
+
+lemma invoke_tcb_tc_respects_aag[Tcb_AC_assms]:
+  "\<lbrace>integrity aag X st and pas_refined aag and einvs and simple_sched_action
+                       and tcb_inv_wf (ThreadControl t sl ep mcp priority croot vroot buf)
+                       and K (authorised_tcb_inv aag (ThreadControl t sl ep mcp priority croot vroot buf))\<rbrace>
+   invoke_tcb (ThreadControl t sl ep mcp priority croot vroot buf)
+   \<lbrace>\<lambda>_. integrity aag X st and pas_refined aag\<rbrace>"
+  apply (rule hoare_gen_asm)+
+  apply (subst invoke_tcb.simps)
+  apply (subst option_update_thread_def)
+  apply (subst set_priority_extended.dxo_eq)
+  apply (rule hoare_weaken_pre)
+   apply (rule_tac P="case ep of Some v \<Rightarrow> length v = word_bits | _ \<Rightarrow> True"
+                 in hoare_gen_asm)
+   apply (simp only: split_def)
+  apply (((simp add: conj_comms,
+          strengthen imp_consequent[where Q="x = None" for x], simp cong: conj_cong)
+         | strengthen invs_psp_aligned invs_vspace_objs invs_arch_state
+         | rule wp_split_const_if wp_split_const_if_R hoare_vcg_all_liftE_R
+                hoare_vcg_conj_elimE hoare_vcg_const_imp_liftE_R hoare_vcg_conj_liftE_R
+         | wp restart_integrity_autarch set_mcpriority_integrity_autarch
+              as_user_integrity_autarch thread_set_integrity_autarch
+              option_update_thread_integrity_autarch
+              opt_update_thread_valid_sched hoare_weak_lift_imp
+              cap_insert_integrity_autarch checked_insert_pas_refined
+              cap_delete_respects' cap_delete_pas_refined'
+              check_cap_inv2[where Q="\<lambda>_. integrity aag X st"]
+              as_user_pas_refined restart_pas_refined
+              thread_set_pas_refined
+              out_invs_trivial case_option_wpE cap_delete_deletes
+              cap_delete_valid_cap cap_insert_valid_cap out_cte_at
+              cap_insert_cte_at cap_delete_cte_at out_valid_cap out_tcb_valid
+              hoare_vcg_const_imp_liftE_R hoare_vcg_all_liftE_R
+              thread_set_tcb_ipc_buffer_cap_cleared_invs
+              thread_set_invs_trivial[OF ball_tcb_cap_casesI]
+              hoare_vcg_all_lift thread_set_valid_cap out_emptyable
+              check_cap_inv[where P="valid_cap c" for c]
+              check_cap_inv[where P="tcb_cap_valid c p" for c p]
+              check_cap_inv[where P="cte_at p0" for p0]
+              check_cap_inv[where P="tcb_at p0" for p0]
+              check_cap_inv[where P="simple_sched_action"]
+              check_cap_inv[where P="valid_list"]
+              check_cap_inv[where P="valid_sched"]
+              check_cap_inv[where P="valid_arch_state"]
+              check_cap_inv[where P="valid_vspace_objs"]
+              check_cap_inv[where P="pspace_aligned"]
+              thread_set_not_state_valid_sched
+              thread_set_cte_at
+              thread_set_cte_wp_at_trivial[where Q="\<lambda>x. x", OF ball_tcb_cap_casesI]
+              thread_set_no_cap_to_trivial[OF ball_tcb_cap_casesI]
+              checked_insert_no_cap_to
+              out_no_cap_to_trivial[OF ball_tcb_cap_casesI]
+              thread_set_ipc_tcb_cap_valid
+              cap_delete_pas_refined'[THEN valid_validE_E] thread_set_cte_wp_at_trivial
+         | simp add: ran_tcb_cap_cases dom_tcb_cap_cases[simplified]
+                     emptyable_def a_type_def partial_inv_def
+         | wpc
+         | strengthen invs_mdb use_no_cap_to_obj_asid_strg
+                      tcb_cap_always_valid_strg[where p="tcb_cnode_index 0"]
+                      tcb_cap_always_valid_strg[where p="tcb_cnode_index (Suc 0)"]))+
+  apply (clarsimp simp: authorised_tcb_inv_def)
+  apply (clarsimp simp: tcb_at_cte_at_0 tcb_at_cte_at_1[simplified]
+                        is_cap_simps is_valid_vtable_root_def
+                        is_cnode_or_valid_arch_def tcb_cap_valid_def
+                        tcb_at_st_tcb_at[symmetric] invs_valid_objs
+                        cap_asid_def vs_cap_ref_def
+                        clas_no_asid cli_no_irqs
+                        emptyable_def
+         | rule conjI | erule pas_refined_refl)+
+   apply (thin_tac "case_option _ _ _")+
+   apply (fastforce split: cap.split_asm option.split_asm pt_type.split_asm)
+  apply (thin_tac "case_option _ _ _")+
+  apply (fastforce split: cap.split_asm option.split_asm pt_type.split_asm)
+  done
+
+end
+
+
+global_interpretation Tcb_AC_1?: Tcb_AC_1
+proof goal_cases
+  interpret Arch .
+  case 1 show ?case
+    by (unfold_locales; fact Tcb_AC_assms)
+qed
+
+end
diff --git a/proof/access-control/AARCH64/ArchTypes.thy b/proof/access-control/AARCH64/ArchTypes.thy
new file mode 100644
index 0000000000..3c988dc77a
--- /dev/null
+++ b/proof/access-control/AARCH64/ArchTypes.thy
@@ -0,0 +1,17 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ArchTypes
+imports Deterministic_AC
+begin
+
+section \<open>Policy and policy refinement\<close>
+
+subsection \<open>Arch-specific definitions\<close>
+
+datatype arch_auth = ASIDPoolMapsASID
+
+end
diff --git a/proof/access-control/AARCH64/ExampleSystem.thy b/proof/access-control/AARCH64/ExampleSystem.thy
new file mode 100644
index 0000000000..2f1980177f
--- /dev/null
+++ b/proof/access-control/AARCH64/ExampleSystem.thy
@@ -0,0 +1,1103 @@
+(*
+ * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
+ *
+ * SPDX-License-Identifier: GPL-2.0-only
+ *)
+
+theory ExampleSystem
+imports ArchAccess_AC
+begin
+
+context begin interpretation Arch . (*FIXME: arch-split*)
+
+definition
+  nat_to_bl :: "nat \<Rightarrow> nat \<Rightarrow> bool list option"
+where
+  "nat_to_bl bits n \<equiv>
+    if n \<ge> 2^bits then
+      None
+    else
+      Some $ bin_to_bl bits (of_nat n)"
+
+lemma nat_to_bl_id [simp]: "nat_to_bl (size (x :: (('a::len) word))) (unat x) = Some (to_bl x)"
+  apply (clarsimp simp: nat_to_bl_def to_bl_def)
+  apply (auto simp: le_def word_size)
+  done
+
+
+(*---------------------------------------------------------*)
+
+subsection \<open>Purpose\<close>
+
+text \<open>
+
+This file defines some example systems using the access control
+definitions. The aim is a sanity check of the AC definitions, to
+ensure they enable to reason about reasonable systems.
+
+In particular, we want to make sure that
+
+  . the function state_objs_to_policy does not connect everything to
+  everything (Example 1)
+  . we can talk about components sharing cnodes
+  . we can talk about components sharing frames
+  . we can have more than 1 untrusted component
+  . we can have an EP between two untrusted components
+
+\<close>
+
+(*---------------------------------------------------------*)
+
+subsection \<open>Generic functions / lemmas\<close>
+
+
+text \<open>Defining the authority between labels.
+
+In addition to the intuitive authority we want, we need to add all the
+authority required to have a wellformed graph. So we define
+complete_AgentAuthGraph to add these 'extra' authorities (at least all
+the ones not depending on the current label). These are:
+
+  . self-authority (each label needs all the authorities to itself).
+  . if Control edge is present between 2 labels then we add all
+    authorities between them.
+  . Control authority is transitive: we add an Control edge
+    between 2 labels if we can connect them via Control
+    edges. Actually we add all authorities because of the second
+    clause.
+
+\<close>
+
+
+definition
+  complete_AuthGraph :: "'a auth_graph \<Rightarrow> 'a set \<Rightarrow> 'a auth_graph"
+where
+  "complete_AuthGraph g ls \<equiv>
+     g \<union> {(l,a,l) | a l. l \<in> ls}"
+
+text \<open>converting a nat to a bool list of size 10 - for the cnodes\<close>
+
+definition
+  the_nat_to_bl :: "nat \<Rightarrow> nat \<Rightarrow> bool list"
+where
+  "the_nat_to_bl sz n \<equiv> the (nat_to_bl sz n)"
+
+definition
+  the_nat_to_bl_10  :: "nat \<Rightarrow> bool list"
+where
+  "the_nat_to_bl_10 n \<equiv> the_nat_to_bl 10 n"
+
+lemma tcb_cnode_index_nat_to_bl:
+  "n<10 \<Longrightarrow> the_nat_to_bl_10 n \<noteq> tcb_cnode_index n"
+  by (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def
+                     tcb_cnode_index_def
+                     nat_to_bl_def to_bl_def bin_to_bl_aux_def)
+
+
+(*---------------------------------------------------------*)
+subsection \<open>Example 1\<close>
+
+text \<open>
+
+This example aims at checking that we can extract a reasonable policy
+from the state, i.e. that the function state_objs_to_policy does not connect
+everything to everything.
+
+This example is a system Sys1 made of 2 main components UT1 and T1,
+connected through and endpoint EP1. EP1 is made of one single kernel
+object: obj1_0x9, the endpoint. Both UT1 and T1 contains:
+
+  . one TCB (obj1_0xC07 and obj1_0xC08 resp.)
+  . one vspace made up of one top-level page table (obj1_BF7 and obj1_0xBF9 resp.)
+  . each top-level pt contains a single page table (obj1_0xC00000 and obj1_0xC05000 resp.)
+  . one cspace made up of one cnode (obj1_0x6 and obj1_0x7 resp.)
+  . each cspace contains 4 caps:
+         one to the tcb
+         one to the cnode itself
+         one to the vspace
+         one to the ep
+
+UT1 can send to the ep while T1 can receive from it.
+
+Attempt to ASCII art:
+
+
+          --------    ----                      ----     --------
+          |       |   |  |                      |  |     |      |
+          V       |   |  V     S             R  |  V     |      V
+obj1_0xC07(tcb)-->obj1_0x6(cnode)--->obj1_0x9(ep)<---obj1_0x7(cnode)<--obj1_0xC08(tcb)
+  |               |                                   |            |
+  V               |                                   |            V
+obj1_0xBF7(pt)<-----                                    -------> obj1_0xBF9(pt)
+  |                                                                |
+  V                                                                V
+obj1_0xC00000(pt)                                                obj1_0xC05000(pt)
+
+
+(the references are derived from the dump of the SAC system)
+
+
+The aim is to be able to prove
+
+  pas_refined Sys1PAS s1
+
+where Sys1PAS is the label graph defining the AC policy for Sys1 and
+s1 is the state of Sys1 described above.
+
+This shows that the aag extracted from s1 (by state_objs_to_policy) is
+included in the policy graph Sys1PAS.
+
+\<close>
+
+
+subsubsection \<open>Defining the State\<close>
+
+text \<open>We need to define the asids of each pt to ensure that
+the object is included in the right ASID-label\<close>
+
+text \<open>UT1's ASID\<close>
+
+definition
+  asid1_0xBF7 :: asid
+where
+  "asid1_0xBF7 \<equiv> 1<<asid_low_bits"
+
+text \<open>T1's ASID\<close>
+
+definition
+  asid1_0xBF9 :: asid
+where
+  "asid1_0xBF9 \<equiv> 2<<asid_low_bits"
+
+lemma "asid_high_bits_of asid1_0xBF9 \<noteq> asid_high_bits_of asid1_0xBF7"
+by (simp add: asid1_0xBF7_def asid_high_bits_of_def asid1_0xBF9_def asid_low_bits_def)
+
+
+text \<open>UT1's CSpace\<close>
+definition
+  caps1_0x6 :: cnode_contents
+where
+  "caps1_0x6 \<equiv>
+   (empty_cnode 10)
+      ( (the_nat_to_bl_10 1)
+            \<mapsto> ThreadCap 0xC07,
+        (the_nat_to_bl_10 2)
+            \<mapsto> CNodeCap 6 undefined undefined,
+        (the_nat_to_bl_10 3)
+            \<mapsto> ArchObjectCap (PageTableCap 0xBF7 (Some (asid1_0xBF7,0))),
+        (the_nat_to_bl_10 318)
+            \<mapsto> EndpointCap 9 0 {AllowSend} )"
+
+
+definition
+  obj1_0x6 :: kernel_object
+where
+  "obj1_0x6 \<equiv> CNode 10 caps1_0x6"
+
+text \<open>T1's Cspace\<close>
+
+definition
+  caps1_0x7 :: cnode_contents
+where
+  "caps1_0x7 \<equiv>
+   (empty_cnode 10)
+      ( (the_nat_to_bl_10 1)
+            \<mapsto> ThreadCap 0xC08,
+        (the_nat_to_bl_10 2)
+            \<mapsto> CNodeCap 7 undefined undefined,
+        (the_nat_to_bl_10 3)
+           \<mapsto> ArchObjectCap (PageTableCap 0xBF9 (Some (asid1_0xBF9,0))),
+        (the_nat_to_bl_10 318)
+           \<mapsto> EndpointCap 9 0 {AllowRecv}) "
+
+definition
+  obj1_0x7 :: kernel_object
+where
+  "obj1_0x7 \<equiv> CNode 10 caps1_0x7"
+
+
+text \<open>endpoint between UT1 and T1\<close>
+
+definition
+  obj1_0x9 :: kernel_object
+where
+  "obj1_0x9 \<equiv> Endpoint IdleEP"
+
+
+text \<open>UT1's VSpace\<close>
+
+definition
+  pt1_0xC00000 :: pt
+where
+  "pt1_0xC00000 \<equiv> (\<lambda>_. InvalidPTE)"
+
+definition
+  obj1_0xC00000 :: kernel_object
+where
+  "obj1_0xC00000 \<equiv> ArchObj (PageTable pt1_0xC00000)"
+
+definition
+  pt1_0xBF7 :: pt
+where
+  "pt1_0xBF7 \<equiv>
+    (\<lambda>_. InvalidPTE)
+     (0 := PageTablePTE
+              (ucast (addrFromPPtr 0xC00000 >> pageBits))
+              undefined )"
+
+(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
+if it's right *)
+
+definition
+  obj1_0xBF7 :: kernel_object
+where
+  "obj1_0xBF7 \<equiv> ArchObj (PageTable pt1_0xBF7)"
+
+
+text \<open>T1's VSpace\<close>
+
+
+definition
+  pt1_0xC05000 :: pt
+where
+  "pt1_0xC05000 \<equiv>
+    (\<lambda>_. InvalidPTE)"
+
+
+definition
+  obj1_0xC05000 :: kernel_object
+where
+  "obj1_0xC05000 \<equiv> ArchObj (PageTable pt1_0xC05000)"
+
+
+definition
+  pt1_0xBF9 :: pt
+where
+  "pt1_0xBF9 \<equiv>
+    (\<lambda>_. InvalidPTE)
+     (0 := PageTablePTE
+             (ucast (addrFromPPtr 0xC05000 >> pageBits))
+             undefined )"
+
+(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
+if it's right *)
+
+definition
+  obj1_0xBF9 :: kernel_object
+where
+  "obj1_0xBF9 \<equiv> ArchObj (PageTable pt1_0xBF9)"
+
+
+text \<open>UT1's tcb\<close>
+
+definition
+  obj1_0xC07 :: kernel_object
+where
+  "obj1_0xC07 \<equiv>
+   TCB \<lparr>
+     tcb_ctable             = CNodeCap 6 undefined undefined,
+     tcb_vtable             = ArchObjectCap (PageTableCap 0xBF7 (Some (asid1_0xBF7, 0))),
+     tcb_reply              = ReplyCap 0xC07 True {AllowGrant,AllowWrite}, \<comment> \<open>master reply cap to itself\<close>
+     tcb_caller             = NullCap,
+     tcb_ipcframe           = NullCap,
+     tcb_state              = Running,
+     tcb_fault_handler      = undefined,
+     tcb_ipc_buffer         = undefined,
+     tcb_fault              = undefined,
+     tcb_bound_notification = None,
+     tcb_mcpriority         = undefined,
+     tcb_arch               = \<lparr>tcb_context = undefined\<rparr> \<rparr>"
+
+
+text \<open>T1's tcb\<close>
+
+definition
+  obj1_0xC08 :: kernel_object
+where
+  "obj1_0xC08 \<equiv>
+   TCB \<lparr>
+     tcb_ctable             = CNodeCap 7 undefined undefined,
+     tcb_vtable             = ArchObjectCap (PageTableCap 0xBF9 (Some (asid1_0xBF9, 0))),
+     tcb_reply              = ReplyCap 0xC08 True {AllowGrant,AllowWrite}, \<comment> \<open>master reply cap to itself\<close>
+     tcb_caller             = NullCap,
+     tcb_ipcframe           = NullCap,
+     tcb_state              = BlockedOnReceive 9 \<lparr> receiver_can_grant = False \<rparr>,
+     tcb_fault_handler      = undefined,
+     tcb_ipc_buffer         = undefined,
+     tcb_fault              = undefined,
+     tcb_bound_notification = None,
+     tcb_mcpriority         = undefined,
+     tcb_arch               = \<lparr>tcb_context = undefined\<rparr>\<rparr>"
+
+definition
+ "obj1_10 \<equiv> CNode 10 (Map.empty([] \<mapsto> cap.NullCap))"
+
+
+(* the boolean in BlockedOnReceive is True if the object can receive but not send.
+but Tom says it only matters if the sender can grant - which is not the case of the UT1 - I think *)
+
+definition
+  kh1 :: kheap
+where
+  "kh1 \<equiv> [0x6 \<mapsto> obj1_0x6,
+           0x7 \<mapsto> obj1_0x7,
+           0x9 \<mapsto> obj1_0x9,
+           0xA \<mapsto> obj1_10,
+           0xBF7 \<mapsto> obj1_0xBF7,
+           0xBF9 \<mapsto> obj1_0xBF9,
+           0xC07 \<mapsto> obj1_0xC07,
+           0xC08 \<mapsto> obj1_0xC08,
+           0xC00000 \<mapsto> obj1_0xC00000,
+           0xC05000 \<mapsto> obj1_0xC05000]"
+
+lemmas kh1_obj_def =
+  obj1_0x6_def obj1_0x7_def obj1_0x9_def obj1_10_def obj1_0xBF7_def obj1_0xBF9_def
+  obj1_0xC00000_def obj1_0xC05000_def obj1_0xC07_def obj1_0xC08_def
+
+definition exst1 :: "det_ext" where
+  "exst1 \<equiv> \<lparr>work_units_completed_internal = undefined,
+             scheduler_action_internal = undefined,
+             ekheap_internal = \<lambda>x. None,
+             domain_list_internal = undefined,
+             domain_index_internal = undefined,
+             cur_domain_internal = undefined,
+             domain_time_internal = undefined,
+             ready_queues_internal = undefined,
+             cdt_list_internal = undefined\<rparr>"
+
+definition
+  s1 :: "det_ext state"
+where
+  "s1 \<equiv>  \<lparr>
+    kheap = kh1,
+    cdt = Map.empty,
+    is_original_cap = undefined,
+    cur_thread = undefined,
+    idle_thread = undefined,
+    machine_state = undefined,
+    interrupt_irq_node = (\<lambda>_. 10),
+    interrupt_states = undefined,
+    arch_state = \<lparr>
+        riscv_asid_table = (\<lambda>_. None),
+        riscv_global_pts = undefined,
+        riscv_kernel_vspace = undefined
+        \<rparr>,
+     exst = exst1
+    \<rparr>"
+
+
+subsubsection \<open>Defining the policy graph\<close>
+
+
+datatype Sys1Labels =
+    UT1 | T1 | EP1 | IRQ1
+
+definition
+  Sys1AgentMap :: "Sys1Labels agent_map"
+where
+  "Sys1AgentMap \<equiv>
+   (\<lambda>_. undefined)
+     (0x6 := UT1,
+      0x7 := T1,
+      0x9 := EP1,
+      0xA := IRQ1,
+      0xBF7 := UT1,
+      0xBF9 := T1,
+      0xC00000 := UT1,
+      0xC05000 := T1,
+      0xC07 := UT1,
+      0xC08 := T1 )"
+
+lemma Sys1AgentMap_simps:
+  "Sys1AgentMap 0x6 = UT1"
+  "Sys1AgentMap 0x7 = T1"
+  "Sys1AgentMap 0x9 = EP1"
+  "Sys1AgentMap 0xA = IRQ1"
+  "Sys1AgentMap 0xBF7 = UT1"
+  "Sys1AgentMap 0xBF9 = T1"
+  "Sys1AgentMap 0xC00000 = UT1"
+  "Sys1AgentMap 0xC05000 = T1"
+  "Sys1AgentMap 0xC07 = UT1"
+  "Sys1AgentMap 0xC08 = T1"
+  unfolding Sys1AgentMap_def by simp_all
+
+definition
+  Sys1AuthGraph_aux :: "Sys1Labels auth_graph"
+where
+    "Sys1AuthGraph_aux \<equiv>
+  { (UT1, auth.SyncSend,    EP1),
+    (UT1, auth.Reset,   EP1),
+    (T1,  auth.Receive, EP1),
+    (T1,  auth.Reset,   EP1) }"
+
+definition
+  Sys1AuthGraph:: "Sys1Labels auth_graph"
+where
+    "Sys1AuthGraph \<equiv> complete_AuthGraph Sys1AuthGraph_aux {T1, UT1}"
+
+
+definition
+  Sys1ASIDMap :: "Sys1Labels agent_asid_map"
+where
+  "Sys1ASIDMap \<equiv>
+    (\<lambda>x. if (asid_high_bits_of x = asid_high_bits_of asid1_0xBF7)
+          then UT1
+         else if (asid_high_bits_of x = asid_high_bits_of asid1_0xBF9)
+          then T1 else undefined)"
+
+definition Sys1PAS :: "Sys1Labels PAS" where
+  "Sys1PAS \<equiv> \<lparr> pasObjectAbs = Sys1AgentMap, pasASIDAbs = Sys1ASIDMap, pasIRQAbs = (\<lambda>_. IRQ1),
+               pasPolicy = Sys1AuthGraph, pasSubject = UT1, pasMayActivate = True,
+               pasMayEditReadyQueues = True, pasMaySendIrqs = True, pasDomainAbs = undefined \<rparr>"
+
+subsubsection \<open>Proof of pas_refined for Sys1\<close>
+
+lemma caps1_0x7_well_formed: "well_formed_cnode_n 10 caps1_0x7"
+  apply (clarsimp simp: caps1_0x7_def well_formed_cnode_n_def)
+  apply (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def nat_to_bl_def)
+  apply (clarsimp simp: empty_cnode_def dom_def)
+  apply (rule set_eqI, clarsimp)
+  apply (rule iffI)
+   apply (elim disjE, insert len_bin_to_bl, simp_all)[1]
+  apply clarsimp
+  done
+
+lemma caps1_0x6_well_formed: "well_formed_cnode_n 10 caps1_0x6"
+  apply (clarsimp simp: caps1_0x6_def well_formed_cnode_n_def)
+  apply (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def nat_to_bl_def)
+  apply (clarsimp simp: empty_cnode_def dom_def)
+  apply (rule set_eqI, clarsimp)
+  apply (rule iffI)
+   apply (elim disjE, insert len_bin_to_bl, simp_all)[1]
+  apply clarsimp
+  done
+
+(* clagged from KernelInit_R *)
+lemma empty_cnode_apply[simp]:
+  "(empty_cnode n xs = Some cap) = (length xs = n \<and> cap = NullCap)"
+  by (auto simp add: empty_cnode_def)
+
+
+lemma s1_caps_of_state :
+  "caps_of_state s1 p = Some cap \<Longrightarrow>
+     cap = NullCap \<or>
+     (p,cap) \<in>
+       { ((6::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap 0xC07),
+         ((6::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap 6 undefined undefined),
+         ((6::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageTableCap 0xBF7 (Some (asid1_0xBF7, 0)))),
+         ((6::obj_ref,(the_nat_to_bl_10 318)),EndpointCap  9 0 {AllowSend}),
+         ((7::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap 0xC08),
+         ((7::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap 7 undefined undefined),
+         ((7::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageTableCap 0xBF9 (Some (asid1_0xBF9, 0)))),
+         ((7::obj_ref,(the_nat_to_bl_10 318)),EndpointCap  9 0 {AllowRecv}) ,
+         ((0xC07::obj_ref, (tcb_cnode_index 0)), CNodeCap 6 undefined undefined ),
+         ((0xC07::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageTableCap 0xBF7 (Some (asid1_0xBF7, 0)))),
+         ((0xC07::obj_ref, (tcb_cnode_index 2)), ReplyCap 0xC07 True {AllowGrant,AllowWrite}),
+         ((0xC07::obj_ref, (tcb_cnode_index 3)), NullCap),
+         ((0xC07::obj_ref, (tcb_cnode_index 4)), NullCap),
+         ((0xC08::obj_ref, (tcb_cnode_index 0)), CNodeCap 7 undefined undefined ),
+         ((0xC08::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageTableCap 0xBF9 (Some (asid1_0xBF9, 0)))),
+         ((0xC08::obj_ref, (tcb_cnode_index 2)), ReplyCap 0xC08 True {AllowGrant,AllowWrite}),
+         ((0xC08::obj_ref, (tcb_cnode_index 3)), NullCap),
+         ((0xC08::obj_ref, (tcb_cnode_index 4)), NullCap)} "
+  apply (insert caps1_0x7_well_formed)
+  apply (insert caps1_0x6_well_formed)
+  apply (simp add: caps_of_state_cte_wp_at cte_wp_at_cases s1_def kh1_def kh1_obj_def)
+  apply (case_tac p, clarsimp)
+  apply (clarsimp split: if_splits)
+     apply (clarsimp simp: cte_wp_at_cases tcb_cap_cases_def
+                     split: if_split_asm)+
+   apply (clarsimp simp: caps1_0x7_def split: if_splits)
+  apply (clarsimp simp: caps1_0x6_def cte_wp_at_cases  split: if_splits)
+  done
+
+
+lemma Sys1_wellformed: "pas_wellformed Sys1PAS"
+  apply (clarsimp simp: Sys1PAS_def
+                     policy_wellformed_def
+                     Sys1AuthGraph_def
+                     Sys1AuthGraph_aux_def
+                     complete_AuthGraph_def)
+  apply blast
+  done
+
+lemma tcb_states_of_state_1:
+  "tcb_states_of_state s1 = [0xC08 \<mapsto> thread_state.BlockedOnReceive 9 \<lparr> receiver_can_grant = False \<rparr>,  0xC07 \<mapsto> thread_state.Running ]"
+  unfolding s1_def tcb_states_of_state_def
+  apply (rule ext)
+  apply (simp add: get_tcb_def)
+  apply (simp add: kh1_def kh1_obj_def )
+  done
+
+lemma thread_bound_ntfns_1:
+  "thread_bound_ntfns s1 = Map.empty"
+  unfolding s1_def thread_bound_ntfns_def
+  apply (rule ext)
+  apply (simp add: get_tcb_def)
+  apply (simp add: kh1_def kh1_obj_def )
+  done
+
+declare AllowSend_def[simp] AllowRecv_def[simp]
+
+lemma domains_of_state_s1[simp]:
+  "domains_of_state s1 = {}"
+  apply (rule equalityI)
+   apply (rule subsetI)
+   apply clarsimp
+   apply (erule domains_of_state_aux.induct)
+   apply (simp add: s1_def exst1_def)
+  apply simp
+  done
+
+lemma vs_refs_aux_empty_pt[simp]:
+  "vs_refs_aux lvl (PageTable empty_pt) = {}"
+  by (clarsimp simp: vs_refs_aux_def graph_of_def pte_ref2_def)
+
+lemma is_aligned_0xC00000[simp]:
+  "ptrFromPAddr (addr_from_ppn (UCAST(64 \<rightarrow> 52) (addrFromPPtr 0xC00000 >> pageBits))) = 0xC00000"
+  by (subst ptrFromPAddr_addr_from_ppn; fastforce simp: bit_simps is_aligned_mask mask_def)
+
+lemma is_aligned_0xC05000[simp]:
+  "ptrFromPAddr (addr_from_ppn (UCAST(64 \<rightarrow> 52) (addrFromPPtr 0xC05000 >> pageBits))) = 0xC05000"
+  by (subst ptrFromPAddr_addr_from_ppn; fastforce simp: bit_simps is_aligned_mask mask_def)
+
+lemma "pas_refined Sys1PAS s1"
+  apply (clarsimp simp: pas_refined_def)
+  apply (intro conjI)
+       subgoal by (simp add: Sys1_wellformed)
+      subgoal by (simp add: irq_map_wellformed_aux_def s1_def Sys1AgentMap_simps Sys1PAS_def)
+     subgoal by (simp add: tcb_domain_map_wellformed_aux_def)
+    apply (clarsimp simp: auth_graph_map_def Sys1PAS_def state_objs_to_policy_def)+
+    apply (erule state_bits_to_policy.cases, simp_all, clarsimp)
+          apply (drule s1_caps_of_state, clarsimp)
+          apply (simp add: Sys1AuthGraph_def complete_AuthGraph_def Sys1AuthGraph_aux_def)
+          apply (elim disjE conjE; solves\<open>clarsimp simp: Sys1AgentMap_simps cap_auth_conferred_def cap_rights_to_auth_def\<close>)
+         apply (drule s1_caps_of_state, clarsimp)
+         apply (elim disjE; solves \<open>simp add: thread_bound_ntfns_def\<close>)
+        apply (clarsimp simp: state_refs_of_def thread_st_auth_def tcb_states_of_state_1
+               Sys1AuthGraph_def Sys1AgentMap_simps
+               complete_AuthGraph_def
+               Sys1AuthGraph_aux_def
+               split: if_splits)
+       apply (simp add:  thread_bound_ntfns_1)
+      apply (simp add: s1_def) (* this is OK because cdt is empty..*)
+     apply (simp add: s1_def) (* this is OK because cdt is empty..*)
+    apply (fastforce simp: state_vrefs_def vs_refs_aux_def s1_def kh1_def kh1_obj_def
+                           pt1_0xC00000_def pt1_0xC05000_def pt1_0xBF9_def pt1_0xBF7_def
+                           Sys1AuthGraph_def Sys1AuthGraph_aux_def Sys1AgentMap_simps
+                           complete_AuthGraph_def ptr_range_def pte_ref2_def opt_map_def
+                    dest!: graph_ofD split: if_splits)
+   apply (rule subsetI, clarsimp)
+   apply (erule state_asids_to_policy_aux.cases)
+     apply (drule s1_caps_of_state, clarsimp)
+     apply (fastforce simp: Sys1AgentMap_simps Sys1PAS_def Sys1ASIDMap_def Sys1AuthGraph_def
+                            Sys1AuthGraph_aux_def complete_AuthGraph_def cap_auth_conferred_def
+                            asid1_0xBF9_def asid1_0xBF7_def asid_low_bits_def asid_high_bits_of_def)
+    apply (fastforce simp: state_vrefs_def vs_refs_aux_def s1_def kh1_def kh1_obj_def
+                           pt1_0xC00000_def pt1_0xC05000_def pt1_0xBF9_def pt1_0xBF7_def
+                           Sys1AuthGraph_def Sys1AuthGraph_aux_def Sys1AgentMap_simps
+                           complete_AuthGraph_def ptr_range_def pte_ref2_def opt_map_def
+                    dest!: graph_ofD split: if_splits)
+   apply (clarsimp simp: s1_def)
+  apply (rule subsetI, clarsimp)
+  apply (erule state_irqs_to_policy_aux.cases)
+  apply (simp add: Sys1AuthGraph_def complete_AuthGraph_def Sys1AuthGraph_aux_def Sys1PAS_def Sys1ASIDMap_def)
+  apply (drule s1_caps_of_state)
+  apply (fastforce simp: Sys1AgentMap_simps Sys1PAS_def Sys1ASIDMap_def Sys1AuthGraph_def
+                         Sys1AuthGraph_aux_def complete_AuthGraph_def cap_auth_conferred_def
+                         asid1_0xBF9_def asid1_0xBF7_def asid_low_bits_def asid_high_bits_of_def)
+  done
+
+
+(*---------------------------------------------------------*)
+subsection \<open>Example 2\<close>
+
+text \<open>
+
+This example systems Sys2 aims at checking that we can have 2
+components, one untrusted UT2 and one truted T1, sharing a cnode obj2_5.
+
+Both UT2 and T2 contains:
+
+  . one TCB (obj2_0xC07 and obj2_0xC08 resp.)
+  . one vspace made up of one top-level page table (obj2_0xBF7 and obj2_0xBF9 resp.)
+  . each top-level pt contains a single page table (obj2_0xC00000 and obj2_0xC05000 resp.)
+  . one cspace made up of one cnode (obj2_0x6 and obj2_0x7 resp.)
+  . each cspace contains 4 caps:
+         one to the tcb
+         one to the cnode itself
+         one to the vspace
+         one to obj2_5
+
+
+Attempt to ASCII art:
+
+
+          --------    ----                          ----     --------
+          |       |   |  |                          |  |     |      |
+          V       |   |  V     S             R      |  V     |      V
+obj2_0xC07(tcb)-->obj2_0x6(cnode)--->obj2_5(cnode)<---obj2_0x7(cnode)<--obj2_0xC08(tcb)
+  |               |                                   |            |
+  V               |                                   |            V
+obj2_0xBF7(pt)<-----                                    -------> obj2_0xBF9(pt)
+  |                                                                |
+  V                                                                V
+obj2_0xC00000(pt)                                                obj2_0xC05000(pt)
+
+
+(the references are derived from the dump of the SAC system)
+
+
+The aim is to be able to prove
+
+  pas_refined Sys2PAS s2
+
+where Sys2PAS is the label graph defining the AC policy for Sys2 and
+s2 is the state of Sys2 described above.
+
+This shows that the aag extracted from s2 (by state_objs_to_policy) is
+included in the policy graph Sys2PAS.
+
+\<close>
+
+
+subsubsection \<open>Defining the State\<close>
+
+
+
+text \<open>We need to define the asids of each pt to ensure that
+the object is included in the right ASID-label\<close>
+
+text \<open>UT2's ASID\<close>
+
+definition
+  asid2_0xBF7 :: asid
+where
+  "asid2_0xBF7 \<equiv> 1<<asid_low_bits"
+
+text \<open>T2's ASID\<close>
+
+definition
+  asid2_0xBF9 :: asid
+where
+  "asid2_0xBF9 \<equiv> 2<<asid_low_bits"
+
+lemma "asid_high_bits_of asid2_0xBF9 \<noteq> asid_high_bits_of asid2_0xBF7"
+by (simp add: asid2_0xBF7_def asid_high_bits_of_def asid2_0xBF9_def asid_low_bits_def)
+
+
+
+text \<open>the intermediaite CSpace\<close>
+
+definition
+  caps2_5 :: cnode_contents
+where
+  "caps2_5 \<equiv>
+   (empty_cnode 10)"
+
+definition
+  obj2_5 :: kernel_object
+where
+  "obj2_5 \<equiv> CNode 10 caps2_5"
+
+
+
+text \<open>UT2's CSpace\<close>
+
+definition
+  caps2_0x6 :: cnode_contents
+where
+  "caps2_0x6 \<equiv>
+   (empty_cnode 10)
+      ( (the_nat_to_bl_10 1)
+            \<mapsto> ThreadCap 0xC07,
+        (the_nat_to_bl_10 2)
+            \<mapsto> CNodeCap 6 undefined undefined,
+        (the_nat_to_bl_10 3)
+            \<mapsto> ArchObjectCap (PageTableCap 0xBF7
+                                             (Some (asid2_0xBF7, 0))),
+        (the_nat_to_bl_10 4)
+            \<mapsto> CNodeCap 5 undefined undefined )"
+
+
+definition
+  obj2_0x6 :: kernel_object
+where
+  "obj2_0x6 \<equiv> CNode 10 caps2_0x6"
+
+text \<open>T2's Cspace\<close>
+
+definition
+  caps2_0x7 :: cnode_contents
+where
+  "caps2_0x7 \<equiv>
+   (empty_cnode 10)
+      ( (the_nat_to_bl_10 1)
+            \<mapsto> ThreadCap 0xC08,
+        (the_nat_to_bl_10 2)
+            \<mapsto> CNodeCap 7 undefined undefined,
+        (the_nat_to_bl_10 3)
+           \<mapsto> ArchObjectCap (PageTableCap 0xBF9
+                                            (Some (asid2_0xBF9, 0))),
+        (the_nat_to_bl_10 4)
+            \<mapsto> CNodeCap 5 undefined undefined) "
+
+definition
+  obj2_0x7 :: kernel_object
+where
+  "obj2_0x7 \<equiv> CNode 10 caps2_0x7"
+
+
+text \<open>endpoint between UT2 and T2\<close>
+
+definition
+  obj2_0x9 :: kernel_object
+where
+  "obj2_0x9 \<equiv> Endpoint IdleEP"
+
+
+text \<open>UT2's VSpace\<close>
+
+definition
+  pt2_0xC00000 :: pt
+where
+  "pt2_0xC00000 \<equiv> (\<lambda>_. InvalidPTE)"
+
+definition
+  obj2_0xC00000 :: kernel_object
+where
+  "obj2_0xC00000 \<equiv> ArchObj (PageTable pt2_0xC00000)"
+
+
+definition
+  pt2_0xBF7 :: pt
+where
+  "pt2_0xBF7 \<equiv>
+    (\<lambda>_. InvalidPTE)
+     (0 := PageTablePTE
+              (ucast (addrFromPPtr 0xC00000 >> pageBits))
+              undefined )"
+
+(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
+if it's right *)
+
+definition
+  obj2_0xBF7 :: kernel_object
+where
+  "obj2_0xBF7 \<equiv> ArchObj (PageTable pt2_0xBF7)"
+
+
+text \<open>T1's VSpace\<close>
+
+
+definition
+  pt2_0xC05000 :: pt
+where
+  "pt2_0xC05000 \<equiv>
+    (\<lambda>_. InvalidPTE)"
+
+definition
+  obj2_0xC05000 :: kernel_object
+where
+  "obj2_0xC05000 \<equiv> ArchObj (PageTable pt2_0xC05000)"
+
+
+definition
+  pt2_0xBF9 :: pt
+where
+  "pt2_0xBF9 \<equiv>
+    (\<lambda>_. InvalidPTE)
+     (0 := PageTablePTE
+             (ucast (addrFromPPtr 0xC05000 >> pageBits))
+             undefined )"
+
+(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
+if it's right *)
+
+definition
+  obj2_0xBF9 :: kernel_object
+where
+  "obj2_0xBF9 \<equiv> ArchObj (PageTable pt2_0xBF9)"
+
+
+text \<open>UT1's tcb\<close>
+
+definition
+  obj2_0xC07 :: kernel_object
+where
+  "obj2_0xC07 \<equiv>
+   TCB \<lparr>
+     tcb_ctable             = CNodeCap 6 undefined undefined ,
+     tcb_vtable             = ArchObjectCap (PageTableCap 0xBF7 (Some (asid2_0xBF7, 0))),
+     tcb_reply              = ReplyCap 0xC07 True {AllowGrant,AllowWrite}, \<comment> \<open>master reply cap to itself\<close>
+     tcb_caller             = NullCap,
+     tcb_ipcframe           = NullCap,
+     tcb_state              = Running,
+     tcb_fault_handler      = undefined,
+     tcb_ipc_buffer         = undefined,
+     tcb_fault              = undefined,
+     tcb_bound_notification = None,
+     tcb_mcpriority         = undefined,
+     tcb_arch               = \<lparr>tcb_context = undefined\<rparr>\<rparr>"
+
+
+text \<open>T1's tcb\<close>
+
+definition
+  obj2_0xC08 :: kernel_object
+where
+  "obj2_0xC08 \<equiv>
+   TCB \<lparr>
+     tcb_ctable             = CNodeCap 7 undefined undefined ,
+     tcb_vtable             = ArchObjectCap (PageTableCap 0xBF9 (Some (asid2_0xBF9,0))),
+     tcb_reply              = ReplyCap 0xC08 True {AllowGrant,AllowWrite}, \<comment> \<open>master reply cap to itself\<close>
+     tcb_caller             = NullCap,
+     tcb_ipcframe           = NullCap,
+     tcb_state              = BlockedOnReceive 9 \<lparr> receiver_can_grant = False \<rparr>,
+     tcb_fault_handler      = undefined,
+     tcb_ipc_buffer         = undefined,
+     tcb_fault              = undefined,
+     tcb_bound_notification = None,
+     tcb_mcpriority         = undefined,
+     tcb_arch               = \<lparr>tcb_context = undefined\<rparr>\<rparr>"
+
+(* the boolean in BlockedOnReceive is True if the object can receive but not send.
+but Tom says it only matters if the sender can grant - which is not the case of the UT1 - I think *)
+
+definition
+  kh2 :: kheap
+where
+  "kh2 \<equiv> [0x6 \<mapsto> obj2_0x6,
+           0x7 \<mapsto> obj2_0x7,
+           0x9 \<mapsto> obj2_0x9,
+           0xBF7 \<mapsto> obj2_0xBF7,
+           0xBF9 \<mapsto> obj2_0xBF9,
+           0xC00000 \<mapsto> obj2_0xC00000,
+           0xC05000 \<mapsto> obj2_0xC05000,
+           0xC07 \<mapsto> obj2_0xC07,
+           0xC08 \<mapsto> obj2_0xC08 ]"
+
+lemmas kh2_obj_def =
+  obj2_0x6_def obj2_0x7_def obj2_0x9_def obj2_0xBF7_def obj2_0xBF9_def
+  obj2_0xC00000_def obj2_0xC05000_def obj2_0xC07_def obj2_0xC08_def
+
+
+definition
+  s2 :: "det_ext state"
+where
+  "s2 \<equiv>  \<lparr>
+    kheap = kh2,
+    cdt = Map.empty,
+    is_original_cap = undefined,
+    cur_thread = undefined,
+    idle_thread = undefined,
+    machine_state = undefined,
+    interrupt_irq_node = (\<lambda>_. 9001),
+    interrupt_states = undefined,
+    arch_state = \<lparr>
+        riscv_asid_table = (\<lambda>_. None),
+        riscv_global_pts = undefined,
+        riscv_kernel_vspace = undefined
+        \<rparr>,
+    exst = exst1
+    \<rparr>"
+
+
+subsubsection \<open>Defining the policy graph\<close>
+
+
+datatype Sys2Labels =
+    UT2 | T2 | IRQ2
+
+definition
+  Sys2AgentMap :: "Sys2Labels agent_map"
+where
+  "Sys2AgentMap \<equiv>
+   (\<lambda>_. undefined)
+     (0x5 := UT2,
+      0x6 := UT2,
+      0x7 := T2,
+      0x9 := T2,
+      0xBF7 := UT2,
+      0xBF9 := T2,
+      0xC00000 := UT2,
+      0xC05000 := T2,
+      0xC07 := UT2,
+      0xC08 := T2,
+      9001 := IRQ2 )"
+
+
+definition
+  Sys2AuthGraph_aux :: "Sys2Labels auth_graph"
+where
+    "Sys2AuthGraph_aux \<equiv>
+       { (T2, Control, UT2) }"
+
+definition
+  Sys2AuthGraph:: "Sys2Labels auth_graph"
+where
+    "Sys2AuthGraph \<equiv> complete_AuthGraph Sys2AuthGraph_aux {T2, UT2}"
+
+
+definition
+  Sys2ASIDMap :: "Sys2Labels agent_asid_map"
+where
+  "Sys2ASIDMap \<equiv>
+    (\<lambda>_. undefined)
+     (asid2_0xBF7 := UT2,
+      asid2_0xBF9 := T2 )"
+
+definition Sys2PAS :: "Sys2Labels PAS" where
+  "Sys2PAS \<equiv> \<lparr> pasObjectAbs = Sys2AgentMap, pasASIDAbs = Sys2ASIDMap,
+              pasIRQAbs = (\<lambda>_. IRQ2),
+              pasPolicy = Sys2AuthGraph, pasSubject = UT2, pasMayActivate = True, pasMayEditReadyQueues = True, pasMaySendIrqs = True, pasDomainAbs = undefined \<rparr>"
+
+
+
+subsubsection \<open>Proof of pas_refined for Sys2\<close>
+
+lemma caps2_0x7_well_formed: "well_formed_cnode_n 10 caps2_0x7"
+  apply (clarsimp simp: caps2_0x7_def well_formed_cnode_n_def)
+  apply (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def nat_to_bl_def)
+  apply (clarsimp simp: empty_cnode_def dom_def)
+  apply (rule set_eqI, clarsimp)
+  apply (rule iffI)
+   apply (elim disjE, insert len_bin_to_bl, simp_all)[1]
+  apply clarsimp
+  done
+
+lemma caps2_0x6_well_formed: "well_formed_cnode_n 10 caps2_0x6"
+  apply (clarsimp simp: caps2_0x6_def well_formed_cnode_n_def)
+  apply (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def nat_to_bl_def)
+  apply (clarsimp simp: empty_cnode_def dom_def)
+  apply (rule set_eqI, clarsimp)
+  apply (rule iffI)
+   apply (elim disjE, insert len_bin_to_bl, simp_all)[1]
+  apply clarsimp
+  done
+
+lemma s2_caps_of_state :
+  "caps_of_state s2 p = Some cap \<Longrightarrow>
+     cap = NullCap \<or>
+     (p,cap) \<in>
+       { ((6::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap 0xC07),
+         ((6::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap 6 undefined undefined),
+         ((6::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageTableCap 0xBF7 (Some (asid2_0xBF7, 0)))),
+         ((6::obj_ref,(the_nat_to_bl_10 4)),  CNodeCap 5 undefined undefined),
+         ((7::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap 0xC08),
+         ((7::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap 7 undefined undefined),
+         ((7::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageTableCap 0xBF9 (Some (asid2_0xBF9, 0)))),
+         ((7::obj_ref,(the_nat_to_bl_10 4)),  CNodeCap 5 undefined undefined),
+         ((0xC07::obj_ref, (tcb_cnode_index 0)), CNodeCap 6 undefined undefined ),
+         ((0xC07::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageTableCap 0xBF7 (Some (asid2_0xBF7, 0)))),
+         ((0xC07::obj_ref, (tcb_cnode_index 2)), ReplyCap 0xC07 True {AllowGrant,AllowWrite}),
+         ((0xC07::obj_ref, (tcb_cnode_index 3)), NullCap),
+         ((0xC07::obj_ref, (tcb_cnode_index 4)), NullCap),
+         ((0xC08::obj_ref, (tcb_cnode_index 0)), CNodeCap 7 undefined undefined ),
+         ((0xC08::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageTableCap 0xBF9 (Some (asid2_0xBF9, 0)))),
+         ((0xC08::obj_ref, (tcb_cnode_index 2)), ReplyCap 0xC08 True {AllowGrant,AllowWrite}),
+         ((0xC08::obj_ref, (tcb_cnode_index 3)), NullCap),
+         ((0xC08::obj_ref, (tcb_cnode_index 4)), NullCap)} "
+  apply (insert caps2_0x7_well_formed)
+  apply (insert caps2_0x6_well_formed)
+  apply (simp add: caps_of_state_cte_wp_at cte_wp_at_cases s2_def kh2_def kh2_obj_def)
+  apply (case_tac p, clarsimp)
+  apply (clarsimp simp: cte_wp_at_cases split: if_splits)
+     apply (clarsimp simp: tcb_cap_cases_def split: if_splits)+
+   apply (clarsimp simp: caps2_0x7_def split: if_splits)
+  apply (clarsimp simp: caps2_0x6_def cte_wp_at_cases  split: if_splits)
+  done
+
+lemma Sys2_wellformed: "pas_wellformed Sys2PAS"
+  apply (clarsimp simp: Sys2PAS_def policy_wellformed_def)
+  apply (intro conjI)
+  apply (simp_all add: Sys2AuthGraph_def complete_AuthGraph_def
+                       Sys2AuthGraph_aux_def)
+  done
+
+lemma Sys2AgentMap_simps:
+  "Sys2AgentMap 5 = UT2"
+  "Sys2AgentMap 6 = UT2"
+  "Sys2AgentMap 7 = T2"
+  "Sys2AgentMap 9 = T2"
+  "Sys2AgentMap 0xBF7 = UT2"
+  "Sys2AgentMap 0xBF9 = T2"
+  "Sys2AgentMap 0xC00000 = UT2"
+  "Sys2AgentMap 0xC05000 = T2"
+  "Sys2AgentMap 0xC07 = UT2"
+  "Sys2AgentMap 0xC08 = T2"
+  "Sys2AgentMap 9001 = IRQ2"
+  by (simp_all add: Sys2AgentMap_def)
+
+lemma domains_of_state_s2[simp]:
+  "domains_of_state s2 = {}"
+  apply (rule equalityI)
+   apply (rule subsetI)
+   apply clarsimp
+   apply (erule domains_of_state_aux.induct)
+   apply (simp add: s2_def exst1_def)
+  apply simp
+  done
+
+lemma thread_bound_ntfns_2[simp]:
+  "thread_bound_ntfns s2 = Map.empty"
+  unfolding s2_def thread_bound_ntfns_def
+  apply (rule ext)
+  apply (simp add: get_tcb_def)
+  apply (simp add: kh2_def kh2_obj_def)
+  done
+
+lemma "pas_refined Sys2PAS s2"
+  apply (clarsimp simp: pas_refined_def)
+  apply (intro conjI)
+      apply (simp add: Sys2_wellformed)
+     apply (simp add: Sys2PAS_def s2_def Sys2AgentMap_def
+                      irq_map_wellformed_aux_def)
+    apply (clarsimp simp: auth_graph_map_def
+                          Sys2PAS_def
+                          state_objs_to_policy_def
+                          state_bits_to_policy_def tcb_domain_map_wellformed_aux_def)+
+    apply (erule state_bits_to_policyp.cases, simp_all)
+         apply (drule s2_caps_of_state, clarsimp)
+         apply (elim disjE, simp_all add: cap_auth_conferred_def
+                                          Sys2AgentMap_simps
+                                          Sys2AuthGraph_def Sys2AuthGraph_aux_def
+                                          complete_AuthGraph_def
+                              split: if_split_asm)[1]
+        apply (drule s2_caps_of_state, clarsimp)
+        apply (elim disjE, simp_all)[1]
+       apply (clarsimp simp: state_refs_of_def s2_def kh2_def kh2_obj_def
+                       split: if_splits)
+       apply (clarsimp split:if_splits option.splits
+                       simp: thread_st_auth_def tcb_states_of_state_def
+                             Sys2AgentMap_simps Sys2AuthGraph_def
+                             complete_AuthGraph_def Sys2AuthGraph_aux_def
+                      dest!: get_tcb_SomeD)
+      apply (simp add: s2_def) (* this is OK because cdt is empty..*)
+     apply (simp add: s2_def) (* this is OK because cdt is empty..*)
+    apply (fastforce simp: state_vrefs_def vs_refs_aux_def s2_def kh2_def kh2_obj_def pt2_0xBF9_def
+                           pt2_0xBF7_def pt2_0xC05000_def pt2_0xC00000_def Sys2AgentMap_simps
+                           Sys2AuthGraph_def Sys2AuthGraph_aux_def complete_AuthGraph_def
+                           pte_ref2_def graph_of_def opt_map_def ptr_range_def
+                    split: if_splits)
+   apply clarsimp
+   apply (erule state_asids_to_policy_aux.cases)
+    apply clarsimp
+    apply (fastforce simp: Sys2PAS_def Sys2AuthGraph_def Sys2AuthGraph_aux_def
+                           complete_AuthGraph_def Sys2AgentMap_simps asid_low_bits_def
+                           Sys2ASIDMap_def asid2_0xBF7_def asid2_0xBF9_def
+                    dest!: s2_caps_of_state)
+   apply (clarsimp simp: state_vrefs_def vs_refs_aux_def s2_def kh2_def kh2_obj_def
+                  split: if_splits)
+   apply (clarsimp simp: s2_def)
+  apply (clarsimp)
+  apply (erule state_irqs_to_policy_aux.cases)
+  apply (fastforce simp: Sys2PAS_def Sys2AuthGraph_def Sys2AuthGraph_aux_def
+                         complete_AuthGraph_def Sys2AgentMap_simps
+                         Sys2ASIDMap_def asid2_0xBF7_def asid2_0xBF9_def
+                  dest!: s2_caps_of_state)
+  done
+
+end
+
+end
diff --git a/proof/access-control/ARM/ArchDomainSepInv.thy b/proof/access-control/ARM/ArchDomainSepInv.thy
index a71f853432..74d5be62f2 100644
--- a/proof/access-control/ARM/ArchDomainSepInv.thy
+++ b/proof/access-control/ARM/ArchDomainSepInv.thy
@@ -25,6 +25,21 @@ lemma arch_finalise_cap_rv[DomainSepInv_assms]:
   "\<lbrace>\<lambda>_. P (NullCap,NullCap)\<rbrace> arch_finalise_cap c x \<lbrace>\<lambda>rv _. P rv\<rbrace>"
   unfolding arch_finalise_cap_def by wpsimp
 
+crunch
+  invalidate_tlb_by_asid, handle_reserved_irq, handle_vm_fault,
+  handle_hypervisor_fault, handle_arch_fault_reply, arch_mask_irq_signal,
+  arch_switch_to_thread, arch_switch_to_idle_thread, arch_activate_idle_thread
+  for domain_sep_inv[DomainSepInv_assms, wp]: "domain_sep_inv irqs st"
+
+lemma arch_derive_cap_domain_sep_inv[DomainSepInv_assms, wp]:
+  "\<lbrace>\<top>\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv _. domain_sep_inv_cap irqs rv\<rbrace>,-"
+  unfolding arch_derive_cap_def
+  by wpsimp
+
+lemma arch_post_modify_registers_domain_sep_inv[DomainSepInv_assms, wp]:
+  "arch_post_modify_registers cur x31 \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  unfolding arch_post_modify_registers_def by wpsimp
+
 end
 
 
@@ -38,12 +53,6 @@ qed
 
 context Arch begin global_naming ARM_A
 
-crunch
-  invalidate_tlb_by_asid, handle_reserved_irq, handle_vm_fault,
-  handle_hypervisor_fault, handle_arch_fault_reply, arch_mask_irq_signal,
-  arch_switch_to_thread, arch_switch_to_idle_thread, arch_activate_idle_thread
-  for domain_sep_inv[DomainSepInv_assms, wp]: "domain_sep_inv irqs st"
-
 lemma perform_page_invocation_domain_sep_inv:
   "\<lbrace>domain_sep_inv irqs st and valid_page_inv pgi\<rbrace>
    perform_page_invocation pgi
@@ -120,15 +129,6 @@ lemma arch_invoke_irq_control_domain_sep_inv[DomainSepInv_assms]:
    apply (wpsimp wp: do_machine_op_domain_sep_inv simp: arch_irq_control_inv_valid_def)+
   done
 
-lemma arch_derive_cap_domain_sep_inv[DomainSepInv_assms, wp]:
-  "\<lbrace>\<top>\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv _. domain_sep_inv_cap irqs rv\<rbrace>,-"
-  unfolding arch_derive_cap_def
-  by wpsimp
-
-lemma arch_post_modify_registers_domain_sep_inv[DomainSepInv_assms, wp]:
-  "arch_post_modify_registers cur x31 \<lbrace>domain_sep_inv irqs st\<rbrace>"
-  unfolding arch_post_modify_registers_def by wpsimp
-
 end
 
 
@@ -136,7 +136,7 @@ global_interpretation DomainSepInv_2?: DomainSepInv_2
 proof goal_cases
   interpret Arch .
   case 1 show ?case
-    by (unfold_locales; fact DomainSepInv_assms)
+    by (unfold_locales; wpsimp wp: DomainSepInv_assms)
 qed
 
 end
diff --git a/proof/access-control/ARM/ArchInterrupt_AC.thy b/proof/access-control/ARM/ArchInterrupt_AC.thy
index 78abd12d2b..9ac28a213a 100644
--- a/proof/access-control/ARM/ArchInterrupt_AC.thy
+++ b/proof/access-control/ARM/ArchInterrupt_AC.thy
@@ -21,8 +21,7 @@ definition arch_authorised_irq_ctl_inv ::
        (pasSubject aag, Control, pasIRQAbs aag irq) \<in> pasPolicy aag"
 
 lemma arch_invoke_irq_control_pas_refined[Interrupt_AC_assms]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_mdb and arch_irq_control_inv_valid irq_ctl_inv
+  "\<lbrace>pas_refined aag and valid_mdb and arch_irq_control_inv_valid irq_ctl_inv
                     and K (arch_authorised_irq_ctl_inv aag irq_ctl_inv)\<rbrace>
    arch_invoke_irq_control irq_ctl_inv
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
@@ -75,7 +74,7 @@ global_interpretation Interrupt_AC_1?: Interrupt_AC_1 "arch_authorised_irq_ctl_i
 proof goal_cases
   interpret Arch .
   case 1 show ?case
-    by (unfold_locales; (fact Interrupt_AC_assms)?)
+    by (unfold_locales; fact Interrupt_AC_assms)
 qed
 
 
diff --git a/proof/access-control/ARM/ArchSyscall_AC.thy b/proof/access-control/ARM/ArchSyscall_AC.thy
index 068449213b..c717a31f5e 100644
--- a/proof/access-control/ARM/ArchSyscall_AC.thy
+++ b/proof/access-control/ARM/ArchSyscall_AC.thy
@@ -179,7 +179,7 @@ global_interpretation Syscall_AC_1?: Syscall_AC_1
 proof goal_cases
   interpret Arch .
   case 1 show ?case
-    by (unfold_locales; (fact Syscall_AC_assms)?)
+    by (unfold_locales; wpsimp wp: Syscall_AC_assms)
 qed
 
 end
diff --git a/proof/access-control/Arch_AC.thy b/proof/access-control/Arch_AC.thy
index 512058f6b9..195dc942d5 100644
--- a/proof/access-control/Arch_AC.thy
+++ b/proof/access-control/Arch_AC.thy
@@ -68,9 +68,7 @@ lemma mapM_set'':
   done
 
 lemma as_user_state_vrefs:
-  "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and (\<lambda>s. P (state_vrefs s))\<rbrace>
-   as_user t f
-   \<lbrace>\<lambda>_ s :: det_ext state. P (state_vrefs s)\<rbrace>"
+  "as_user t f \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   apply (simp add: as_user_def)
   apply (wpsimp wp: set_object_wp)
   apply (clarsimp simp: state_vrefs_tcb_upd obj_at_def is_obj_defs
@@ -79,9 +77,7 @@ lemma as_user_state_vrefs:
   done
 
 lemma as_user_pas_refined[wp]:
-  "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and pas_refined aag\<rbrace>
-   as_user t f
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "as_user t f \<lbrace>pas_refined aag\<rbrace>"
   apply (simp add: pas_refined_def state_objs_to_policy_def)
   apply (rule hoare_pre)
    apply wps
@@ -151,9 +147,7 @@ lemma is_subject_asid_into_loas:
 
 locale Arch_AC_1 =
   assumes set_mrs_state_vrefs[wp]:
-    "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and (\<lambda>s. P (state_vrefs s))\<rbrace>
-     set_mrs thread buf msgs
-     \<lbrace>\<lambda>_ s :: det_ext state. P (state_vrefs s)\<rbrace>"
+    "set_mrs thread buf msgs \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   and mul_add_word_size_lt_msg_align_bits_ofnat:
   "\<lbrakk> p < 2 ^ (msg_align_bits - word_size_bits); k < word_size \<rbrakk>
      \<Longrightarrow> of_nat p * of_nat word_size + k < (2 :: obj_ref) ^ msg_align_bits"
@@ -196,9 +190,7 @@ lemma store_word_offs_integrity_autarch:
   done
 
 lemma set_mrs_pas_refined[wp]:
-  "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and pas_refined aag\<rbrace>
-   set_mrs thread buf msgs
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "set_mrs thread buf msgs \<lbrace>pas_refined aag\<rbrace>"
   apply (simp add: pas_refined_def state_objs_to_policy_def)
   apply (rule hoare_pre)
    apply (wp | wps)+
diff --git a/proof/access-control/CNode_AC.thy b/proof/access-control/CNode_AC.thy
index b79309883c..d45ce00054 100644
--- a/proof/access-control/CNode_AC.thy
+++ b/proof/access-control/CNode_AC.thy
@@ -67,18 +67,14 @@ locale CNode_AC_1 =
        state_asids_to_policy_arch aag caps (as :: arch_state) vrefs \<subseteq> pasPolicy aag \<rbrakk>
        \<Longrightarrow> state_asids_to_policy_arch aag (caps(ptr \<mapsto> cap, ptr' \<mapsto> cap')) as vrefs \<subseteq> pasPolicy aag"
   and state_vrefs_tcb_upd:
-    "\<lbrakk> pspace_aligned s; valid_vspace_objs s; valid_arch_state s; tcb_at tptr s \<rbrakk>
-       \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(tptr \<mapsto> TCB tcb)\<rparr>) = state_vrefs s"
+    "tcb_at tptr s \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(tptr \<mapsto> TCB tcb)\<rparr>) = state_vrefs s"
   and state_vrefs_simple_type_upd:
-    "\<lbrakk> pspace_aligned s; valid_vspace_objs s; valid_arch_state s;
-       ko_at ko p s; is_simple_type ko; a_type ko = a_type (f (val :: 'b)) \<rbrakk>
+    "\<lbrakk> ko_at ko p s; is_simple_type ko; a_type ko = a_type (f (val :: 'b)) \<rbrakk>
        \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(p \<mapsto> f val)\<rparr>) = state_vrefs s"
   and a_type_arch_object_not_tcb[simp]:
     "a_type (ArchObj arch_kernel_obj) \<noteq> ATCB"
   and set_cap_state_vrefs:
-    "\<And>P. \<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and (\<lambda>s. P (state_vrefs s))\<rbrace>
-          set_cap cap slot
-          \<lbrace>\<lambda>_ s :: det_ext state. P (state_vrefs s)\<rbrace>"
+    "\<And>P. set_cap cap slot \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   and set_cdt_state_vrefs[wp]:
     "\<And>P. set_cdt t \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   and set_cdt_state_asids_to_policy[wp]:
@@ -308,7 +304,7 @@ lemma sita_caps_update2:
 context CNode_AC_1 begin
 
 lemma set_cap_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and
+  "\<lbrace>pas_refined aag and
     (\<lambda>s. (is_transferable_in ptr s \<and> (\<not> Option.is_none (cdt s ptr)))
           \<longrightarrow> is_transferable_cap cap \<or>
               abs_has_auth_to aag Control (fst $ the $ cdt s ptr) (fst ptr)) and
@@ -330,8 +326,7 @@ lemma set_cap_pas_refined:
   done
 
 lemma set_cap_pas_refined_not_transferable:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and cte_wp_at (\<lambda>c. \<not>is_transferable (Some c)) ptr
+  "\<lbrace>pas_refined aag and cte_wp_at (\<lambda>c. \<not>is_transferable (Some c)) ptr
                     and K (aag_cap_auth aag (pasObjectAbs aag (fst ptr)) cap)\<rbrace>
    set_cap cap ptr
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
@@ -1025,7 +1020,7 @@ locale CNode_AC_3 = CNode_AC_2 +
 begin
 
 lemma cap_insert_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and
+  "\<lbrace>pas_refined aag and valid_mdb and
     (\<lambda>s. (is_transferable_in src_slot s \<and> (\<not> Option.is_none (cdt s src_slot)))
          \<longrightarrow> is_transferable_cap new_cap) and
     K (is_subject aag (fst dest_slot) \<and> is_subject aag (fst src_slot)
@@ -1049,7 +1044,7 @@ lemma cap_insert_pas_refined:
                  dest: aag_cdt_link_Control aag_cdt_link_DeleteDerived cap_auth_caps_of_state)
 
 lemma cap_insert_pas_refined':
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and
+  "\<lbrace>pas_refined aag and valid_mdb and
     (\<lambda>s. cte_wp_at is_transferable_cap src_slot s \<longrightarrow> is_transferable_cap new_cap) and
     K (is_subject aag (fst dest_slot) \<and> is_subject aag (fst src_slot)
                                       \<and> pas_cap_cur_auth aag new_cap) \<rbrace>
@@ -1060,7 +1055,7 @@ lemma cap_insert_pas_refined':
                 simp: cte_wp_at_caps_of_state Option.is_none_def)
 
 lemma cap_insert_pas_refined_not_transferable:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb
+  "\<lbrace>pas_refined aag and valid_mdb
                     and not cte_wp_at is_transferable_cap src_slot
                     and K (is_subject aag (fst dest_slot) \<and> is_subject aag (fst src_slot)
                                                           \<and> pas_cap_cur_auth aag new_cap) \<rbrace>
@@ -1069,7 +1064,7 @@ lemma cap_insert_pas_refined_not_transferable:
    by (wpsimp wp: cap_insert_pas_refined')
 
 lemma cap_insert_pas_refined_same_object_as:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb
+  "\<lbrace>pas_refined aag and valid_mdb
                     and cte_wp_at (same_object_as new_cap) src_slot
                     and K (is_subject aag (fst dest_slot) \<and> is_subject aag (fst src_slot) \<and>
                            (\<not> is_master_reply_cap new_cap) \<and> pas_cap_cur_auth aag new_cap)\<rbrace>
@@ -1081,8 +1076,7 @@ lemma cap_insert_pas_refined_same_object_as:
                 elim: is_transferable_capE split: cap.splits)
 
 lemma cap_move_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_mdb and cte_wp_at (weak_derived new_cap) src_slot
+  "\<lbrace>pas_refined aag and valid_mdb and cte_wp_at (weak_derived new_cap) src_slot
                     and cte_wp_at ((=) NullCap) dest_slot
                     and K (is_subject aag (fst dest_slot) \<and> is_subject aag (fst src_slot)
                                                           \<and> pas_cap_cur_auth aag new_cap)\<rbrace>
@@ -1099,14 +1093,8 @@ lemma cap_move_pas_refined[wp]:
                 dest: invs_mdb pas_refined_mem[OF sta_cdt]
                       pas_refined_mem[OF sta_cdt_transferable])
 
-crunch set_original, set_cdt
-  for pspace_aligned[wp]: pspace_aligned
-  and valid_vspace_objs[wp]: valid_vspace_objs
-  and valid_arch_state[wp]: valid_arch_state
-
 lemma empty_slot_pas_refined[wp, wp_not_transferable]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_mdb and K (is_subject aag (fst slot))\<rbrace>
+  "\<lbrace>pas_refined aag and valid_mdb and K (is_subject aag (fst slot))\<rbrace>
    empty_slot slot irqopt
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: empty_slot_def post_cap_deletion_def)
@@ -1119,8 +1107,7 @@ lemma empty_slot_pas_refined[wp, wp_not_transferable]:
 
 
 lemma empty_slot_pas_refined_transferable[wp_transferable]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_mdb and (\<lambda>s. is_transferable (caps_of_state s slot))\<rbrace>
+  "\<lbrace>pas_refined aag and valid_mdb and (\<lambda>s. is_transferable (caps_of_state s slot))\<rbrace>
    empty_slot slot irqopt
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: empty_slot_def post_cap_deletion_def)
@@ -1178,7 +1165,7 @@ lemma cap_swap_pas_refined[wp]:
      by (erule subsetD;
          force simp: is_transferable_weak_derived intro!: sbta_cdt_transferable auth_graph_map_memI)+
          apply (blast intro: state_bits_to_policy.intros auth_graph_map_memI)
-   by fastforce+
+   done
 
 lemma cap_swap_for_delete_pas_refined[wp]:
   "\<lbrace>pas_refined aag and invs and K (is_subject aag (fst slot) \<and> is_subject aag (fst slot'))\<rbrace>
@@ -1305,9 +1292,7 @@ lemma set_simple_ko_ekheap[wp]:
 context CNode_AC_3 begin
 
 lemma sts_st_vrefs[wp]:
-  "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and (\<lambda>s. P (state_vrefs s))\<rbrace>
-   set_thread_state t st
-   \<lbrace>\<lambda>_ s :: det_ext state. P (state_vrefs s)\<rbrace>"
+  "set_thread_state t st \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   apply (simp add: set_thread_state_def del: set_thread_state_ext_extended.dxo_eq)
   apply (wpsimp wp: set_object_wp dxo_wp_weak)
   apply (clarsimp simp: state_vrefs_tcb_upd obj_at_def is_obj_defs
@@ -1316,8 +1301,7 @@ lemma sts_st_vrefs[wp]:
   done
 
 lemma set_thread_state_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and
-    K (\<forall>r \<in> tcb_st_to_auth st. abs_has_auth_to aag (snd r) t (fst r))\<rbrace>
+  "\<lbrace>pas_refined aag and K (\<forall>r \<in> tcb_st_to_auth st. abs_has_auth_to aag (snd r) t (fst r))\<rbrace>
    set_thread_state t st
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: pas_refined_def state_objs_to_policy_def)
@@ -1330,17 +1314,14 @@ lemma set_thread_state_pas_refined:
   done
 
 lemma set_simple_ko_vrefs[wp]:
-  "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and (\<lambda>s. P (state_vrefs s))\<rbrace>
-   set_simple_ko f ptr (val :: 'b)
-   \<lbrace>\<lambda>_ s :: det_ext state. P (state_vrefs s)\<rbrace>"
+  "set_simple_ko f ptr (val :: 'b) \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   apply (simp add: set_simple_ko_def set_object_def)
   apply (wp get_object_wp)
   apply (fastforce simp: state_vrefs_simple_type_upd obj_at_def elim!: rsubst[where P=P, OF _ ext])
   done
 
 lemma set_simple_ko_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-    set_simple_ko f ptr (ep :: 'b) \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "set_simple_ko f ptr (ep :: 'b) \<lbrace>pas_refined aag\<rbrace>"
   apply (simp add: pas_refined_def state_objs_to_policy_def)
   apply (rule hoare_pre)
    apply (wp tcb_domain_map_wellformed_lift | wps)+
@@ -1348,9 +1329,7 @@ lemma set_simple_ko_pas_refined[wp]:
   done
 
 lemma thread_set_state_vrefs:
-  "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and (\<lambda>s. P (state_vrefs s))\<rbrace>
-   thread_set f t
-   \<lbrace>\<lambda>_ s :: det_ext state. P (state_vrefs s)\<rbrace>"
+  "thread_set f t \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   apply (simp add: thread_set_def)
   apply (wpsimp wp: set_object_wp)
   apply (clarsimp simp: state_vrefs_tcb_upd obj_at_def is_obj_defs
@@ -1387,8 +1366,7 @@ lemma thread_set_pas_refined_triv:
   assumes cps: "\<And>tcb. \<forall>(getF, v)\<in>ran tcb_cap_cases. getF (f tcb) = getF tcb"
        and st: "\<And>tcb. tcb_state (f tcb) = tcb_state tcb"
       and ntfn: "\<And>tcb. tcb_bound_notification (f tcb) = tcb_bound_notification tcb"
-     shows "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-            thread_set f t \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+     shows "thread_set f t \<lbrace>pas_refined aag\<rbrace>"
   by (wpsimp wp: tcb_domain_map_wellformed_lift thread_set_state_vrefs
            simp: pas_refined_def state_objs_to_policy_def
       | wps thread_set_caps_of_state_trivial[OF cps]
diff --git a/proof/access-control/DomainSepInv.thy b/proof/access-control/DomainSepInv.thy
index 7d2c2c6421..0650010cc8 100644
--- a/proof/access-control/DomainSepInv.thy
+++ b/proof/access-control/DomainSepInv.thy
@@ -320,6 +320,22 @@ locale DomainSepInv_1 =
     "prepare_thread_delete t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
   and arch_finalise_cap_rv:
     "\<lbrace>\<lambda>_. P (NullCap,NullCap)\<rbrace> arch_finalise_cap c x \<lbrace>\<lambda>rv s :: det_ext state. P rv\<rbrace>"
+  and arch_switch_to_thread_domain_sep_inv[wp]:
+    "arch_switch_to_thread t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs (st :: 'state_ext state) s\<rbrace>"
+  and arch_switch_to_idle_thread_domain_sep_inv[wp]:
+    "arch_switch_to_idle_thread \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and arch_activate_idle_thread_domain_sep_inv[wp]:
+    "arch_activate_idle_thread t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and arch_mask_irq_signal_domain_sep_inv[wp]:
+    "arch_mask_irq_signal irq \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and arch_derive_cap_domain_sep_inv[wp]:
+    "\<lbrace>\<top>\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv s :: det_ext state. domain_sep_inv_cap irqs rv\<rbrace>,-"
+  and arch_post_modify_registers_domain_sep_inv[wp]:
+    "arch_post_modify_registers cur t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and handle_arch_fault_reply_domain_sep_inv[wp]:
+    "handle_arch_fault_reply vmf thread d ds \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and handle_vm_fault_domain_sep_inv[wp]:
+    "handle_vm_fault t vmf_t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
 begin
 
 lemma deleted_irq_handler_domain_sep_inv:
@@ -739,83 +755,6 @@ lemma domain_sep_inv_cap_ArchObjectCap[simp]:
   "domain_sep_inv_cap irqs (ArchObjectCap arch_cap)"
   by (simp add: domain_sep_inv_cap_def)
 
-
-locale DomainSepInv_2 = DomainSepInv_1 state_ext_t
-  for state_ext_t :: "'state_ext :: state_ext itself" +
-  assumes arch_switch_to_thread_domain_sep_inv[wp]:
-    "arch_switch_to_thread t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs (st :: 'state_ext state) s\<rbrace>"
-  and arch_switch_to_idle_thread_domain_sep_inv[wp]:
-    "arch_switch_to_idle_thread \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and arch_activate_idle_thread_domain_sep_inv[wp]:
-    "arch_activate_idle_thread t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and arch_mask_irq_signal_domain_sep_inv[wp]:
-    "arch_mask_irq_signal irq \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and arch_derive_cap_domain_sep_inv[wp]:
-    "\<lbrace>\<top>\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv s :: det_ext state. domain_sep_inv_cap irqs rv\<rbrace>,-"
-  and arch_post_modify_registers_domain_sep_inv[wp]:
-    "arch_post_modify_registers cur x31 \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and arch_perform_invocation_domain_sep_inv[wp]:
-    "\<lbrace>domain_sep_inv irqs st and valid_arch_inv ai\<rbrace>
-     arch_perform_invocation ai
-     \<lbrace>\<lambda>_ s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and arch_invoke_irq_handler_domain_sep_inv[wp]:
-    "arch_invoke_irq_handler ihi \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and arch_invoke_irq_control_domain_sep_inv:
-    "\<lbrace>domain_sep_inv irqs st and arch_irq_control_inv_valid ivk\<rbrace>
-     arch_invoke_irq_control ivk
-     \<lbrace>\<lambda>_ s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and handle_arch_fault_reply_domain_sep_inv[wp]:
-    "handle_arch_fault_reply vmf thread x y \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and handle_hypervisor_fault_domain_sep_inv[wp]:
-    "handle_hypervisor_fault t hf_t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and handle_vm_fault_domain_sep_inv[wp]:
-    "handle_vm_fault t vmf_t \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-  and handle_reserved_irq_domain_sep_inv[wp]:
-    "handle_reserved_irq irq \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
-begin
-
-(* when i is AckIRQ the preconditions here contradict each other, which
-   is why this lemma is true *)
-lemma invoke_irq_handler_domain_sep_inv:
-  "\<lbrace>domain_sep_inv irqs st and irq_handler_inv_valid i\<rbrace>
-   invoke_irq_handler i
-   \<lbrace>\<lambda>_ s. domain_sep_inv irqs (st :: 'state_ext state) (s :: det_ext state)\<rbrace>"
-  apply (case_tac i)
-    apply (wp cap_insert_domain_sep_inv' | simp)+
-   apply (rename_tac irq cap cslot_ptr s)
-   apply (case_tac cap, simp_all add: domain_sep_inv_cap_def)[1]
-  apply (wp | clarsimp)+
-  done
-
-(* similarly, the preconditions here tend to contradict one another *)
-lemma invoke_control_domain_sep_inv:
-  "\<lbrace>domain_sep_inv irqs st and irq_control_inv_valid i\<rbrace>
-    invoke_irq_control i
-   \<lbrace>\<lambda>_ s. domain_sep_inv irqs (st :: 'state_ext state) (s :: det_ext state)\<rbrace>"
-  including classic_wp_pre
-  apply (case_tac i)
-   apply (case_tac irqs)
-    apply (wp cap_insert_domain_sep_inv' | simp )+
-    apply (simp add: set_irq_state_def, wp, simp)
-    apply (fastforce simp: domain_sep_inv_def domain_sep_inv_cap_def)
-   apply (fastforce simp: valid_def domain_sep_inv_def)
-  apply simp
-  apply (wp arch_invoke_irq_control_domain_sep_inv)
-  done
-
-lemma derive_cap_domain_sep_inv_cap:
-  "\<lbrace>\<lambda>s. domain_sep_inv_cap irqs cap\<rbrace>
-   derive_cap slot cap
-   \<lbrace>\<lambda>rv s :: det_ext state. domain_sep_inv_cap irqs rv\<rbrace>,-"
-  apply (simp add: derive_cap_def)
-  apply (rule hoare_pre)
-  apply (wp | wpc | simp add: )+
-  apply auto
-  done
-
-end
-
-
 crunch receive_signal, complete_signal
   for domain_sep_inv[wp]: "domain_sep_inv irqs st"
 
@@ -850,7 +789,7 @@ lemma transfer_caps_domain_sep_inv:
   done
 
 
-context DomainSepInv_2 begin
+context DomainSepInv_1 begin
 
 lemma do_normal_transfer_domain_sep_inv:
   "\<lbrace>domain_sep_inv irqs st and valid_objs and valid_mdb\<rbrace>
@@ -918,8 +857,9 @@ lemma receive_ipc_domain_sep_inv:
   done
 
 lemma send_fault_ipc_domain_sep_inv:
-  "\<lbrace>domain_sep_inv irqs st and valid_objs and sym_refs \<circ> state_refs_of
-                           and valid_mdb and K (valid_fault fault)\<rbrace>
+  "\<lbrace>domain_sep_inv irqs st and valid_objs and valid_mdb
+                           and sym_refs \<circ> state_refs_of
+                           and K (valid_fault fault)\<rbrace>
    send_fault_ipc thread fault
    \<lbrace>\<lambda>_ s. domain_sep_inv irqs (st :: 'state_ext state) (s :: det_ext state)\<rbrace>"
   unfolding send_fault_ipc_def
@@ -1035,7 +975,7 @@ lemma invoke_domain_domain_set_inv:
   done
 
 
-context DomainSepInv_2 begin
+context DomainSepInv_1 begin
 
 lemma invoke_tcb_domain_sep_inv:
   "\<lbrace>domain_sep_inv irqs st and tcb_inv_wf tinv\<rbrace>
@@ -1060,6 +1000,70 @@ lemma invoke_tcb_domain_sep_inv:
                   del: set_priority_extended.dxo_eq)+
   done
 
+end
+
+
+locale DomainSepInv_2 = DomainSepInv_1 state_ext_t
+  for state_ext_t :: "'state_ext :: state_ext itself" +
+  assumes arch_perform_invocation_domain_sep_inv[wp]:
+    "\<lbrace>domain_sep_inv irqs st and valid_arch_inv ai\<rbrace>
+     arch_perform_invocation ai
+     \<lbrace>\<lambda>_ s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and arch_invoke_irq_handler_domain_sep_inv[wp]:
+    "arch_invoke_irq_handler ihi \<lbrace>\<lambda>s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and arch_invoke_irq_control_domain_sep_inv:
+    "\<lbrace>domain_sep_inv irqs st and arch_irq_control_inv_valid ivk\<rbrace>
+     arch_invoke_irq_control ivk
+     \<lbrace>\<lambda>_ s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and handle_hypervisor_fault_domain_sep_inv[wp]:
+    "\<lbrace>domain_sep_inv irqs st and valid_objs and valid_mdb and sym_refs \<circ> state_refs_of\<rbrace>
+     handle_hypervisor_fault t hf_t
+     \<lbrace>\<lambda>_ s :: det_ext state. domain_sep_inv irqs st s\<rbrace>"
+  and handle_reserved_irq_domain_sep_inv[wp]:
+    "\<lbrace>domain_sep_inv irqs st and valid_objs and valid_mdb and sym_refs \<circ> state_refs_of\<rbrace>
+     handle_reserved_irq irq
+     \<lbrace>\<lambda>_ s :: det_ext state. domain_sep_inv irqs (st :: 'state_ext state) s\<rbrace>"
+begin
+
+(* when i is AckIRQ the preconditions here contradict each other, which
+   is why this lemma is true *)
+lemma invoke_irq_handler_domain_sep_inv:
+  "\<lbrace>domain_sep_inv irqs st and irq_handler_inv_valid i\<rbrace>
+   invoke_irq_handler i
+   \<lbrace>\<lambda>_ s. domain_sep_inv irqs (st :: 'state_ext state) (s :: det_ext state)\<rbrace>"
+  apply (case_tac i)
+    apply (wp cap_insert_domain_sep_inv' | simp)+
+   apply (rename_tac irq cap cslot_ptr s)
+   apply (case_tac cap, simp_all add: domain_sep_inv_cap_def)[1]
+  apply (wp | clarsimp)+
+  done
+
+(* similarly, the preconditions here tend to contradict one another *)
+lemma invoke_control_domain_sep_inv:
+  "\<lbrace>domain_sep_inv irqs st and irq_control_inv_valid i\<rbrace>
+    invoke_irq_control i
+   \<lbrace>\<lambda>_ s. domain_sep_inv irqs (st :: 'state_ext state) (s :: det_ext state)\<rbrace>"
+  including classic_wp_pre
+  apply (case_tac i)
+   apply (case_tac irqs)
+    apply (wp cap_insert_domain_sep_inv' | simp )+
+    apply (simp add: set_irq_state_def, wp, simp)
+    apply (fastforce simp: domain_sep_inv_def domain_sep_inv_cap_def)
+   apply (fastforce simp: valid_def domain_sep_inv_def)
+  apply simp
+  apply (wp arch_invoke_irq_control_domain_sep_inv)
+  done
+
+lemma derive_cap_domain_sep_inv_cap:
+  "\<lbrace>\<lambda>s. domain_sep_inv_cap irqs cap\<rbrace>
+   derive_cap slot cap
+   \<lbrace>\<lambda>rv s :: det_ext state. domain_sep_inv_cap irqs rv\<rbrace>,-"
+  apply (simp add: derive_cap_def)
+  apply (rule hoare_pre)
+  apply (wp | wpc | simp add: )+
+  apply auto
+  done
+
 lemma perform_invocation_domain_sep_inv':
   "\<lbrace>domain_sep_inv irqs st and valid_invocation iv and valid_objs
                            and valid_mdb and sym_refs \<circ> state_refs_of\<rbrace>
@@ -1150,7 +1154,8 @@ lemma domain_sep_inv_cur_thread_update[simp]:
 lemma (in is_extended') domain_sep_inv[wp]: "I (domain_sep_inv irqs st)" by (rule lift_inv, simp)
 
 
-context DomainSepInv_2 begin
+context DomainSepInv_2
+begin
 
 lemma handle_recv_domain_sep_inv:
   "\<lbrace>domain_sep_inv irqs st and invs\<rbrace>
@@ -1181,35 +1186,30 @@ lemma handle_event_domain_sep_inv:
   "\<lbrace>domain_sep_inv irqs st and invs and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_active s)\<rbrace>
    handle_event ev
    \<lbrace>\<lambda>_ s. domain_sep_inv irqs (st :: 'state_ext state) (s :: det_ext state)\<rbrace>"
-  apply (case_tac ev, simp_all)
-      apply (rule hoare_pre)
-       apply (wpsimp wp: handle_send_domain_sep_inv handle_call_domain_sep_inv
-                         handle_recv_domain_sep_inv handle_reply_domain_sep_inv hy_inv
-              | simp add: invs_valid_objs invs_mdb invs_sym_refs valid_fault_def)+
-     apply (rule_tac E'="\<lambda>rv s. domain_sep_inv irqs (st :: 'state_ext state) (s :: det_ext state) \<and>
-                                invs s \<and> valid_fault rv"
-                 and Q="Q" and Q'=Q for Q
-                  in hoare_strengthen_postE)
-     apply (wp | simp add: invs_valid_objs invs_mdb invs_sym_refs valid_fault_def | auto)+
-  done
+  apply (case_tac ev)
+  by (wpsimp wp: handle_send_domain_sep_inv handle_call_domain_sep_inv
+                 handle_recv_domain_sep_inv handle_reply_domain_sep_inv hy_inv
+      | strengthen invs_valid_objs invs_mdb invs_sym_refs
+      | simp add: valid_fault_def
+      | wp hoare_drop_imps)+
 
 lemma schedule_domain_sep_inv:
   "(schedule :: (unit,det_ext) s_monad) \<lbrace>domain_sep_inv irqs (st :: 'state_ext state)\<rbrace>"
-  apply (simp add: schedule_def allActiveTCBs_def)
-  apply (wp add: guarded_switch_to_lift hoare_drop_imps
-            del: ethread_get_wp
-         | wpc | clarsimp simp: get_thread_state_def thread_get_def trans_state_update'[symmetric]
-                                schedule_choose_new_thread_def)+
-  done
+  unfolding schedule_def allActiveTCBs_def
+  by (wp add: guarded_switch_to_lift hoare_drop_imps
+         del: ethread_get_wp
+      | wpc | clarsimp simp: get_thread_state_def thread_get_def trans_state_update'[symmetric]
+                             schedule_choose_new_thread_def)+
 
 lemma call_kernel_domain_sep_inv:
   "\<lbrace>domain_sep_inv irqs st and invs and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_active s)\<rbrace>
    call_kernel ev :: (unit,det_ext) s_monad
    \<lbrace>\<lambda>_ s. domain_sep_inv irqs (st :: 'state_ext state) s\<rbrace>"
-  apply (simp add: call_kernel_def)
-  apply (wp handle_interrupt_domain_sep_inv handle_event_domain_sep_inv schedule_domain_sep_inv
-         | simp)+
-  done
+  unfolding call_kernel_def
+  by (wpsimp wp: handle_event_domain_sep_inv schedule_domain_sep_inv
+              simp: if_fun_split
+      | strengthen invs_valid_objs invs_mdb invs_sym_refs
+      | wp hoare_drop_imps)+
 
 end
 
diff --git a/proof/access-control/Finalise_AC.thy b/proof/access-control/Finalise_AC.thy
index 36f064cfa3..488311bb13 100644
--- a/proof/access-control/Finalise_AC.thy
+++ b/proof/access-control/Finalise_AC.thy
@@ -23,9 +23,7 @@ NB: the @{term is_subject} assumption is not appropriate for some of
 locale Finalise_AC_1 =
   fixes aag :: "'a PAS"
   assumes sbn_st_vrefs:
-    "\<And>P. \<lbrace>(\<lambda>s.  P (state_vrefs s)) and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-          set_bound_notification ref ntfn
-          \<lbrace>\<lambda>_ s :: det_ext state. P (state_vrefs s)\<rbrace>"
+    "\<And>P. set_bound_notification ref ntfn \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   and arch_finalise_cap_auth':
     "\<lbrace>pas_refined aag\<rbrace> arch_finalise_cap acap final \<lbrace>\<lambda>rv _. pas_cap_cur_auth aag (fst rv)\<rbrace>"
   and arch_finalise_cap_obj_refs:
@@ -48,12 +46,12 @@ locale Finalise_AC_1 =
   and prepare_thread_delete_pas_refined[wp]:
     "prepare_thread_delete p \<lbrace>pas_refined aag\<rbrace>"
   and prepare_thread_delete_respects[wp]:
-    "prepare_thread_delete p \<lbrace>integrity aag X st\<rbrace>"
+    "\<lbrace>integrity aag X st and K (is_subject aag p)\<rbrace> prepare_thread_delete p \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
   and finalise_cap_replaceable:
     "\<lbrace>\<lambda>s :: det_ext state. s \<turnstile> cap \<and> x = is_final_cap' cap s \<and> valid_mdb s \<and>
                            cte_wp_at ((=) cap) sl s \<and> valid_objs s \<and> sym_refs (state_refs_of s) \<and>
                            (cap_irqs cap \<noteq> {} \<longrightarrow> if_unsafe_then_cap s \<and> valid_global_refs s) \<and>
-                           (is_arch_cap cap \<longrightarrow> pspace_aligned s \<and> valid_vspace_objs s \<and>
+                           (is_arch_cap cap \<longrightarrow> pspace_aligned s \<and> pspace_distinct s \<and> valid_vspace_objs s \<and>
                                                 valid_arch_state s \<and> valid_arch_caps s)\<rbrace>
      finalise_cap cap x
      \<lbrace>\<lambda>rv s. replaceable s sl (fst rv) cap\<rbrace>"
@@ -62,12 +60,6 @@ locale Finalise_AC_1 =
                                   and K (pas_cap_cur_auth aag (ArchObjectCap acap))\<rbrace>
      arch_finalise_cap acap final
      \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
-  and arch_post_cap_deletion[wp]:
-    "arch_post_cap_deletion acap \<lbrace>\<lambda>s :: det_ext state. pspace_aligned s\<rbrace>"
-  and arch_post_cap_deletion_valid_vspace_objs[wp]:
-    "arch_post_cap_deletion acap \<lbrace>\<lambda>s :: det_ext state. valid_vspace_objs s\<rbrace>"
-  and arch_post_cap_deletion_valid_arch_state[wp]:
-    "arch_post_cap_deletion acap \<lbrace>\<lambda>s :: det_ext state. valid_arch_state s\<rbrace>"
 begin
 
 lemma tcb_sched_action_dequeue_integrity':
@@ -250,7 +242,7 @@ crunch fast_finalise
 context Finalise_AC_1 begin
 
 lemma sbn_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and
+  "\<lbrace>pas_refined aag and
     K (case ntfn of None \<Rightarrow> True
                   | Some ntfn' \<Rightarrow> \<forall>auth \<in> {Receive, Reset}. abs_has_auth_to aag auth t ntfn')\<rbrace>
    set_bound_notification t ntfn
@@ -264,52 +256,29 @@ lemma sbn_pas_refined[wp]:
            split: if_split_asm)
 
 lemma unbind_notification_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-   unbind_notification tptr
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "unbind_notification tptr \<lbrace>pas_refined aag\<rbrace>"
   apply (clarsimp simp: unbind_notification_def)
   apply (wp set_simple_ko_pas_refined hoare_drop_imps | wpc | simp)+
   done
 
 lemma unbind_maybe_notification_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-   unbind_maybe_notification nptr \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "unbind_maybe_notification nptr \<lbrace>pas_refined aag\<rbrace>"
   apply (clarsimp simp: unbind_maybe_notification_def)
   apply (wp set_simple_ko_pas_refined hoare_drop_imps | wpc | simp)+
   done
 
 lemma cancel_all_ipc_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-   cancel_all_ipc epptr
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "cancel_all_ipc epptr \<lbrace>pas_refined aag\<rbrace>"
   apply (clarsimp simp: cancel_all_ipc_def get_ep_queue_def cong: endpoint.case_cong)
-  apply (rule_tac Q'="\<lambda>_. pas_refined aag and pspace_aligned
-                                         and valid_vspace_objs
-                                         and valid_arch_state"
-               in hoare_strengthen_post)
-   apply (wpsimp wp: mapM_x_wp_inv set_thread_state_pas_refined get_simple_ko_wp)+
+  apply (wpsimp wp: mapM_x_wp_inv set_thread_state_pas_refined get_simple_ko_wp)+
   done
 
 lemma cancel_all_signals_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and
-     valid_arch_state\<rbrace>
-   cancel_all_signals ntfnptr
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "cancel_all_signals ntfnptr \<lbrace>pas_refined aag\<rbrace>"
   apply (clarsimp simp: cancel_all_signals_def cong: ntfn.case_cong)
-  apply (rule_tac Q'="\<lambda>_. pas_refined aag and pspace_aligned
-                                         and valid_vspace_objs
-                                         and valid_arch_state"
-               in hoare_strengthen_post)
-   apply (wpsimp wp: mapM_x_wp_inv set_thread_state_pas_refined get_simple_ko_wp)+
+  apply (wpsimp wp: mapM_x_wp_inv set_thread_state_pas_refined get_simple_ko_wp)+
   done
 
-crunch unbind_maybe_notification, cancel_all_ipc, cancel_all_signals,
-         fast_finalise, blocked_cancel_ipc, cap_move
-  for pspace_aligned[wp]: pspace_aligned
-  and valid_vspace_objs[wp]: valid_vspace_objs
-  and valid_arch_state[wp]: valid_arch_state
-  (ignore: cap_move_ext tcb_sched_action reschedule_required wp: dxo_wp_weak mapM_x_inv_wp)
-
 crunch cap_delete_one
   for pas_refined_transferable[wp_transferable]: "pas_refined aag"
   and pas_refined[wp, wp_not_transferable]: "pas_refined aag"
@@ -368,12 +337,6 @@ lemma deleting_irq_handler_pas_refined[wp]:
   apply (fastforce simp: pas_refined_def irq_map_wellformed_aux_def)
   done
 
-crunch suspend
-  for pspace_aligned[wp]: "\<lambda>s :: det_ext state. pspace_aligned s"
-  and valid_vspace_objs[wp]: "\<lambda>s :: det_ext state. valid_vspace_objs s"
-  and valid_arch_state[wp]: "\<lambda>s :: det_ext state. valid_arch_state s"
-  (wp: dxo_wp_weak hoare_drop_imps simp: crunch_simps simp: tcb_cap_cases_def)
-
 crunch suspend
   for pas_refined[wp]: "pas_refined aag"
 
@@ -541,7 +504,6 @@ lemma reply_cancel_ipc_respects[wp]:
                       thread_set_not_state_valid_sched hoare_weak_lift_imp thread_set_cte_wp_at_trivial
                       thread_set_pas_refined
                 simp: ran_tcb_cap_cases)+
-  apply (strengthen invs_psp_aligned invs_vspace_objs invs_arch_state, clarsimp)
   apply (rule conjI)
    apply (fastforce simp: cte_wp_at_caps_of_state intro:is_transferable.intros
                    dest!: reply_cap_descends_from_master0)
@@ -594,7 +556,6 @@ lemma suspend_respects[wp]:
     apply (rule hoare_conjI)
      apply (wp hoare_drop_imps)+
     apply wpsimp+
-  apply fastforce
   done
 
 end
@@ -997,9 +958,7 @@ lemma set_eobject_integrity_autarch:
   done
 
 lemma cancel_badged_sends_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-   cancel_badged_sends epptr badge
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "cancel_badged_sends epptr badge \<lbrace>pas_refined aag\<rbrace>"
   unfolding cancel_badged_sends_def
   by (wpsimp simp: filterM_mapM wp: mapM_wp_inv set_thread_state_pas_refined get_simple_ko_wp)
 
@@ -1015,8 +974,7 @@ lemma thread_set_pas_refined_triv_idleT:
   and st: "\<And>tcb. P (tcb_state tcb) \<longrightarrow> tcb_state (f tcb) = tcb_state tcb"
   and ba: "\<And>tcb. Q (tcb_bound_notification tcb)
                   \<longrightarrow> tcb_bound_notification (f tcb) = tcb_bound_notification tcb"
-  shows "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                          and idle_tcb_at (\<lambda>(st, ntfn, arch). P st \<and> Q ntfn \<and> R arch) t\<rbrace>
+  shows "\<lbrace>pas_refined aag and idle_tcb_at (\<lambda>(st, ntfn, arch). P st \<and> Q ntfn \<and> R arch) t\<rbrace>
          thread_set f t
          \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: pas_refined_def state_objs_to_policy_def)
@@ -1026,10 +984,7 @@ lemma thread_set_pas_refined_triv_idleT:
    apply (wpsimp wp: set_object_wp)
   apply (clarsimp simp: pred_tcb_def2 fun_upd_def[symmetric]
                    del: subsetI)
-  apply (subst state_vrefs_tcb_upd, fastforce+)
-   apply (clarsimp simp: tcb_at_def)
-  apply (subst state_vrefs_tcb_upd, fastforce+)
-   apply (clarsimp simp: tcb_at_def)
+  apply (subst state_vrefs_tcb_upd, clarsimp simp: tcb_at_def)+
   apply (rule conjI)
    apply (erule_tac P="\<lambda> ts ba. auth_graph_map a (state_bits_to_policy cps ts ba cd vr) \<subseteq> ag"
                 for a cps cd vr ag in rsubst')
diff --git a/proof/access-control/Interrupt_AC.thy b/proof/access-control/Interrupt_AC.thy
index 42dee66806..19e434a611 100644
--- a/proof/access-control/Interrupt_AC.thy
+++ b/proof/access-control/Interrupt_AC.thy
@@ -30,8 +30,7 @@ lemma pas_refined_is_subject_irqD:
 locale Interrupt_AC_1 =
   fixes arch_authorised_irq_ctl_inv :: "'a PAS \<Rightarrow> arch_irq_control_invocation \<Rightarrow> bool"
   assumes arch_invoke_irq_control_pas_refined:
-    "\<lbrace>pas_refined (aag :: 'a PAS) and pspace_aligned and valid_vspace_objs and valid_arch_state
-                                  and valid_mdb and arch_irq_control_inv_valid irq_ctl_inv
+    "\<lbrace>pas_refined (aag :: 'a PAS) and valid_mdb and arch_irq_control_inv_valid irq_ctl_inv
                                   and K (arch_authorised_irq_ctl_inv aag irq_ctl_inv)\<rbrace>
      arch_invoke_irq_control irq_ctl_inv
      \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
@@ -59,8 +58,7 @@ definition authorised_irq_ctl_inv :: "'a PAS \<Rightarrow> Invocations_A.irq_con
      | ArchIRQControl acinv \<Rightarrow> arch_authorised_irq_ctl_inv aag acinv"
 
 lemma invoke_irq_control_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_mdb and irq_control_inv_valid irq_ctl_inv
+  "\<lbrace>pas_refined aag and valid_mdb and irq_control_inv_valid irq_ctl_inv
                     and K (authorised_irq_ctl_inv aag irq_ctl_inv)\<rbrace>
    invoke_irq_control irq_ctl_inv
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
diff --git a/proof/access-control/Ipc_AC.thy b/proof/access-control/Ipc_AC.thy
index eb7a8cc056..4289021a27 100644
--- a/proof/access-control/Ipc_AC.thy
+++ b/proof/access-control/Ipc_AC.thy
@@ -67,15 +67,13 @@ crunch possible_switch_to
   for tcb_domain_map_wellformed[wp]: "tcb_domain_map_wellformed aag"
 
 lemma update_waiting_ntfn_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and ko_at (Notification ntfn) ntfnptr and K (ntfn_obj ntfn = WaitingNtfn queue)\<rbrace>
+  "\<lbrace>pas_refined aag and ko_at (Notification ntfn) ntfnptr and K (ntfn_obj ntfn = WaitingNtfn queue)\<rbrace>
    update_waiting_ntfn ntfnptr queue badge val
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   by (wpsimp wp: set_thread_state_pas_refined set_simple_ko_pas_refined simp: update_waiting_ntfn_def)
 
 lemma cancel_ipc_receive_blocked_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs
-                    and valid_arch_state and st_tcb_at receive_blocked t\<rbrace>
+  "\<lbrace>pas_refined aag and st_tcb_at receive_blocked t\<rbrace>
    cancel_ipc t
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (clarsimp simp: cancel_ipc_def)
@@ -85,9 +83,7 @@ lemma cancel_ipc_receive_blocked_pas_refined:
   done
 
 lemma send_signal_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-   send_signal ntfnptr badge
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "send_signal ntfnptr badge \<lbrace>pas_refined aag\<rbrace>"
   apply (simp add: send_signal_def)
   apply (rule bind_wp[OF _ get_simple_ko_sp])
   apply (wpsimp wp: set_simple_ko_pas_refined update_waiting_ntfn_pas_refined gts_wp
@@ -96,8 +92,7 @@ lemma send_signal_pas_refined:
   done
 
 lemma receive_signal_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and K (\<forall>ntfnptr \<in> obj_refs_ac cap. abs_has_auth_to aag Receive thread ntfnptr)\<rbrace>
+  "\<lbrace>pas_refined aag and K (\<forall>ntfnptr \<in> obj_refs_ac cap. abs_has_auth_to aag Receive thread ntfnptr)\<rbrace>
    receive_signal thread cap is_blocking
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: receive_signal_def)
@@ -172,9 +167,6 @@ locale Ipc_AC_1 =
     "\<And>P. make_fault_msg ft t \<lbrace>\<lambda>s :: det_ext state. P s\<rbrace>"
   and tcb_context_no_change:
     "\<exists>ctxt. (tcb :: tcb) = tcb\<lparr>tcb_arch := arch_tcb_context_set ctxt (tcb_arch tcb)\<rparr>"
-  (* This assumption excludes x64 (its valid_arch_state includes caps) *)
-  and transfer_caps_loop_valid_arch[wp]:
-    "transfer_caps_loop ep buffer n caps slots mi \<lbrace>valid_arch_state :: det_ext state \<Rightarrow> _\<rbrace>"
 begin
 
 lemma send_upd_ctxintegrity:
@@ -736,8 +728,7 @@ lemma derive_cap_is_derived_foo':
 lemma transfer_caps_loop_presM_extended:
   fixes P vo em ex buffer slots caps n mi
   assumes x: "\<And>cap src dest.
-              \<lbrace>\<lambda>s. P s \<and> (vo \<longrightarrow> pspace_aligned s \<and> valid_vspace_objs s \<and> valid_arch_state s
-                               \<and> valid_objs s \<and> valid_mdb s \<and> real_cte_at dest s
+              \<lbrace>\<lambda>s. P s \<and> (vo \<longrightarrow> valid_objs s \<and> valid_mdb s \<and> real_cte_at dest s
                                \<and> s \<turnstile> cap \<and> Psrc src \<and> Pdest dest \<and> Pcap cap
                                \<and> tcb_cap_valid cap dest s \<and> real_cte_at src s
                                \<and> cte_wp_at (is_derived (cdt s) src cap) src s
@@ -748,8 +739,7 @@ lemma transfer_caps_loop_presM_extended:
               \<lbrace>\<lambda>_ s :: det_ext state. P s\<rbrace>"
   assumes eb: "\<And>b n. set_extra_badge buffer b n \<lbrace>P\<rbrace>"
   assumes pcap_auth_derived: "\<And>cap cap'. \<lbrakk> auth_derived cap cap'; Pcap cap' \<rbrakk> \<Longrightarrow> Pcap cap"
-  shows "\<lbrace>\<lambda>s. P s \<and> (vo \<longrightarrow> pspace_aligned s \<and> valid_vspace_objs s \<and> valid_arch_state s
-                          \<and> valid_objs s \<and> valid_mdb s \<and> distinct slots
+  shows "\<lbrace>\<lambda>s. P s \<and> (vo \<longrightarrow> valid_objs s \<and> valid_mdb s \<and> distinct slots
                           \<and> (\<forall>x \<in> set slots. cte_wp_at (\<lambda>cap. cap = NullCap) x s
                                            \<and> real_cte_at x s \<and> Pdest x)
                           \<and> (\<forall>x \<in> set caps. valid_cap (fst x) s \<and> Psrc (snd x) \<and> Pcap (fst x)
@@ -807,8 +797,7 @@ lemma transfer_caps_loop_presM_extended:
   by (clarsimp simp: masked_as_full_def is_cap_simps split: if_splits)+
 
 lemma transfer_caps_loop_pas_refined:
-  "\<lbrace>\<lambda>s. pas_refined aag s \<and> pspace_aligned s \<and> valid_vspace_objs s \<and>
-        valid_arch_state s \<and> valid_objs s \<and> valid_mdb s \<and>
+  "\<lbrace>\<lambda>s. pas_refined aag s \<and> valid_objs s \<and> valid_mdb s \<and>
         (\<forall>x \<in> set caps. valid_cap (fst x) s \<and> real_cte_at (snd x) s
                       \<and> cte_wp_at (\<lambda>cp. fst x \<noteq> NullCap \<longrightarrow> cp = fst x) (snd x) s) \<and>
         (\<forall>x\<in>set slots. real_cte_at x s \<and> cte_wp_at (\<lambda>cap. cap = NullCap) x s) \<and>
@@ -831,8 +820,7 @@ lemma transfer_caps_loop_pas_refined:
   done
 
 lemma transfer_caps_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs
-                    and valid_arch_state and valid_objs and valid_mdb
+  "\<lbrace>pas_refined aag and valid_objs and valid_mdb
                     and (\<lambda>s. (\<forall>x \<in> set caps. valid_cap (fst x) s
                                            \<and> cte_wp_at (\<lambda>cp. fst x \<noteq> NullCap \<longrightarrow> cp = fst x) (snd x) s
                                            \<and> real_cte_at (snd x) s))
@@ -849,16 +837,9 @@ lemma transfer_caps_pas_refined:
 end
 
 lemma copy_mrs_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-   copy_mrs sender sbuf receiver rbuf n
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "copy_mrs sender sbuf receiver rbuf n \<lbrace>pas_refined aag\<rbrace>"
   unfolding copy_mrs_def
-  apply (rule_tac Q'="\<lambda>_. pas_refined aag and pspace_aligned
-                                         and valid_vspace_objs
-                                         and valid_arch_state"
-               in hoare_strengthen_post[rotated], clarsimp)
-  apply (wpsimp wp: mapM_wp_inv)
-  done
+  by (wpsimp wp: mapM_wp_inv)
 
 lemma lookup_cap_and_slot_authorised:
   "\<lbrace>pas_refined aag and K (is_subject aag thread)\<rbrace>
@@ -916,13 +897,8 @@ context Ipc_AC_1 begin
 crunch do_fault_transfer
   for pas_refined[wp]: "\<lambda>s :: det_ext state. pas_refined aag s"
 
-crunch transfer_caps, copy_mrs
-  for valid_arch_state[wp]: "valid_arch_state :: det_ext state \<Rightarrow> _"
-  (wp: crunch_wps)
-
 lemma do_normal_transfer_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_objs and valid_mdb
+  "\<lbrace>pas_refined aag and valid_objs and valid_mdb
                     and K (grant \<longrightarrow> is_subject aag sender)
                     and K (grant \<longrightarrow> is_subject aag receiver)\<rbrace>
    do_normal_transfer sender sbuf endpoint badge grant receiver rbuf
@@ -945,8 +921,7 @@ next
 qed
 
 lemma do_ipc_transfer_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_objs and valid_mdb
+  "\<lbrace>pas_refined aag and valid_objs and valid_mdb
                     and K (grant \<longrightarrow> is_subject aag sender)
                     and K (grant \<longrightarrow> is_subject aag receiver)\<rbrace>
    do_ipc_transfer sender ep badge grant receiver
@@ -959,7 +934,7 @@ end
 
 (* FIXME MOVE*)
 lemma cap_insert_pas_refined_transferable:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and
+  "\<lbrace>pas_refined aag and valid_mdb and
     K (is_transferable_cap new_cap \<and> aag_cap_auth aag (pasObjectAbs aag (fst dest_slot)) new_cap \<and>
        abs_has_auth_to aag DeleteDerived (fst src_slot) (fst dest_slot))\<rbrace>
    cap_insert new_cap src_slot dest_slot
@@ -982,7 +957,7 @@ lemma cap_insert_pas_refined_transferable:
                 intro: aag_wellformed_delete_derived_trans[OF _ _ pas_refined_wellformed])
 
 lemma setup_caller_cap_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and
+  "\<lbrace>pas_refined aag and valid_mdb and
     K ((grant \<longrightarrow> is_subject aag sender \<and> is_subject aag receiver) \<and>
        abs_has_auth_to aag Reply receiver sender)\<rbrace>
    setup_caller_cap sender receiver grant
@@ -1061,12 +1036,11 @@ lemma send_ipc_pas_refined:
    apply (wpc | wp set_thread_state_pas_refined)+
          apply (simp add: hoare_if_r_and split del:if_split)
          apply (wp setup_caller_cap_pas_refined set_thread_state_pas_refined)+
-       apply (simp split del:if_split)
-       apply (rule_tac Q'="\<lambda>rv. pas_refined aag and pspace_aligned and valid_vspace_objs and
-                               valid_arch_state and valid_mdb and
-                               K (can_grant \<or> can_grant_reply
-                                  \<longrightarrow> (reply_can_grant \<longrightarrow> is_subject aag x21) \<and>
-                                      (pasObjectAbs aag x21, Reply, pasSubject aag) \<in> pasPolicy aag)"
+       apply (simp split del: if_split)
+       apply (rule_tac Q'="\<lambda>rv. pas_refined aag and valid_mdb and
+                                K (can_grant \<or> can_grant_reply
+                                   \<longrightarrow> (reply_can_grant \<longrightarrow> is_subject aag x21) \<and>
+                                       (pasObjectAbs aag x21, Reply, pasSubject aag) \<in> pasPolicy aag)"
                     in hoare_strengthen_post[rotated])
         apply simp
        apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined hoare_weak_lift_imp gts_wp
@@ -1180,8 +1154,7 @@ lemma receive_ipc_sender_can_grant_helper:
   done
 
 lemma complete_signal_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and bound_tcb_at ((=) (Some ntfnptr)) thread\<rbrace>
+  "\<lbrace>pas_refined aag and bound_tcb_at ((=) (Some ntfnptr)) thread\<rbrace>
    complete_signal ntfnptr thread
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: complete_signal_def)
@@ -1207,8 +1180,7 @@ lemma receive_ipc_base_pas_refined:
    apply (wp set_thread_state_pas_refined get_simple_ko_wp setup_caller_cap_pas_refined
           | wpc | simp add: thread_get_def do_nbrecv_failed_transfer_def split del: if_split)+
         apply (rename_tac list sss data)
-        apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s \<and> pspace_aligned s \<and> valid_vspace_objs s \<and>
-                                  valid_arch_state s \<and> valid_mdb s \<and>
+        apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s \<and> valid_mdb s \<and>
                                   (sender_can_grant data \<longrightarrow> is_subject aag (hd list)) \<and>
                                   (sender_can_grant_reply data \<longrightarrow>
                                   (AllowGrant \<in> rights \<longrightarrow> is_subject aag (hd list)) \<and>
@@ -1286,7 +1258,6 @@ lemma receive_ipc_pas_refined:
   apply (rule bind_wp[OF _ get_simple_ko_sp])
   apply (case_tac "isActive ntfn", simp_all)
    apply (wp complete_signal_pas_refined, clarsimp)
-   apply fastforce
   (* regular case again *)
   apply (rule hoare_pre, wp receive_ipc_base_pas_refined)
   apply (fastforce simp: aag_cap_auth_def cap_auth_conferred_def cap_rights_to_auth_def)
@@ -1365,8 +1336,7 @@ lemma transfer_caps_integrity_autarch:
 lemma do_normal_transfer_send_integrity_autarch:
   notes lec_valid_cap[wp del]
   shows
-  "\<lbrace>pas_refined aag and integrity aag X st and pspace_aligned and
-    valid_vspace_objs and valid_arch_state and valid_objs and valid_mdb and
+  "\<lbrace>pas_refined aag and integrity aag X st and valid_objs and valid_mdb and
     K (is_subject aag receiver \<and> ipc_buffer_has_auth aag receiver rbuf
                                \<and> (grant \<longrightarrow> is_subject aag sender))\<rbrace>
    do_normal_transfer sender sbuf endpoint badge grant receiver rbuf
@@ -1390,8 +1360,7 @@ lemma do_fault_transfer_integrity_autarch:
                  set_mrs_integrity_autarch thread_get_wp')
 
 lemma do_ipc_transfer_integrity_autarch:
-  "\<lbrace>pas_refined aag and integrity aag X st and
-    pspace_aligned and valid_vspace_objs and valid_arch_state and valid_objs and valid_mdb and
+  "\<lbrace>pas_refined aag and integrity aag X st and valid_objs and valid_mdb and
     K (is_subject aag receiver \<and> (grant \<longrightarrow> is_subject aag sender))\<rbrace>
    do_ipc_transfer sender ep badge grant receiver
    \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
@@ -1768,12 +1737,6 @@ locale Ipc_AC_2 = Ipc_AC_1 +
   and handle_arch_fault_reply_integrity_tcb_in_fault_reply_TRFContext[wp]:
     "handle_arch_fault_reply vmf thread x y
      \<lbrace>integrity_tcb_in_fault_reply aag X thread TRFContext st\<rbrace>"
-  and handle_arch_fault_reply_pspace_aligned[wp]:
-    "handle_arch_fault_reply vmf thread x y \<lbrace>\<lambda>s :: det_ext state. pspace_aligned s\<rbrace>"
-  and handle_arch_fault_reply_valid_vspace_objs[wp]:
-    "handle_arch_fault_reply vmf thread x y \<lbrace>\<lambda>s :: det_ext state. valid_vspace_objs s\<rbrace>"
-  and handle_arch_fault_reply_valid_arch_state[wp]:
-    "handle_arch_fault_reply vmf thread x y \<lbrace>\<lambda>s :: det_ext state. valid_arch_state s\<rbrace>"
   and cap_insert_ext_integrity_asids_in_ipc[wp]:
     "cap_insert_ext src_parent src_slot dest_slot src_p dest_p
      \<lbrace>\<lambda>s. integrity_asids aag subjects x asid st
@@ -2072,8 +2035,7 @@ lemma do_normal_transfer_respects_in_ipc:
   notes lec_valid_cap[wp del]
   shows
   "\<lbrace>integrity_tcb_in_ipc aag X receiver epptr TRContext st and pas_refined aag and
-    pspace_aligned and valid_vspace_objs and valid_arch_state and
-valid_objs and valid_mdb and st_tcb_at can_receive_ipc receiver and
+    valid_objs and valid_mdb and st_tcb_at can_receive_ipc receiver and
     (\<lambda>s. grant \<longrightarrow> is_subject aag sender \<and> is_subject aag receiver) and
     K ((\<not> is_subject aag receiver \<longrightarrow>
         (case recv_buf of None \<Rightarrow> True | Some buf' \<Rightarrow> auth_ipc_buffers st receiver =
@@ -2105,7 +2067,6 @@ lemma do_fault_transfer_respects_in_ipc:
 
 lemma do_ipc_transfer_respects_in_ipc:
   "\<lbrace>integrity_tcb_in_ipc aag X receiver epptr TRContext st and pas_refined aag and
-    pspace_aligned and valid_vspace_objs and valid_arch_state and
     valid_objs and valid_mdb and st_tcb_at can_receive_ipc receiver and
     (\<lambda>s. grant \<longrightarrow> is_subject aag sender \<and> is_subject aag receiver)\<rbrace>
    do_ipc_transfer sender epopt badge grant receiver
@@ -2330,7 +2291,7 @@ lemma setup_caller_cap_respects_in_ipc_reply:
   by (wpsimp wp: cap_insert_reply_cap_respects_in_ipc set_thread_state_respects_in_ipc_autarch)
 
 lemma send_ipc_integrity_autarch:
-  "\<lbrace>integrity aag X st and pas_refined aag and invs and is_subject aag \<circ> cur_thread and
+  "\<lbrace>integrity aag X st and pas_refined aag and invs and
     obj_at (\<lambda>ep. can_grant \<longrightarrow> (\<forall>r \<in> refs_of ep. snd r = EPRecv \<longrightarrow> is_subject aag (fst r))) epptr and
     K (is_subject aag sender \<and> aag_has_auth_to aag SyncSend epptr \<and>
        (can_grant_reply \<longrightarrow> aag_has_auth_to aag Call epptr))\<rbrace>
@@ -2409,15 +2370,13 @@ lemma valid_tcb_fault_update:
 context Ipc_AC_2 begin
 
 lemma thread_set_fault_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
+  "\<lbrace>pas_refined aag\<rbrace>
    thread_set (tcb_fault_update (\<lambda>_. Some fault)) thread
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
-  by (wpsimp wp: send_ipc_pas_refined thread_set_pas_refined
-                 thread_set_refs_trivial thread_set_obj_at_impossible)
+  by (wpsimp wp: thread_set_pas_refined)
 
 lemma send_fault_ipc_pas_refined:
-  "\<lbrace>pas_refined aag and invs and is_subject aag \<circ> cur_thread
-                    and K (valid_fault fault) and K (is_subject aag thread)\<rbrace>
+  "\<lbrace>pas_refined aag and invs and K (valid_fault fault) and K (is_subject aag thread)\<rbrace>
    send_fault_ipc thread fault
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (rule hoare_gen_asm)+
@@ -2426,8 +2385,7 @@ lemma send_fault_ipc_pas_refined:
                     thread_set_refs_trivial thread_set_obj_at_impossible get_cap_wp
                     thread_set_valid_objs'' hoare_vcg_conj_lift hoare_vcg_ex_lift hoare_vcg_all_lift
               simp: split_def)
-    apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s \<and> is_subject aag (cur_thread s) \<and>
-                               invs s \<and> valid_fault fault \<and> is_subject aag (fst (fst rv))"
+    apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s \<and> invs s \<and> valid_fault fault \<and> is_subject aag (fst (fst rv))"
                  in hoare_strengthen_postE_R[rotated])
      apply (fastforce dest!: cap_auth_caps_of_state
                        simp: invs_valid_objs invs_sym_refs cte_wp_at_caps_of_state aag_cap_auth_def
@@ -2437,8 +2395,7 @@ lemma send_fault_ipc_pas_refined:
   done
 
 lemma handle_fault_pas_refined:
-  "\<lbrace>pas_refined aag and invs and is_subject aag \<circ> cur_thread
-                    and K (valid_fault fault) and K (is_subject aag thread)\<rbrace>
+  "\<lbrace>pas_refined aag and invs and K (valid_fault fault) and K (is_subject aag thread)\<rbrace>
    handle_fault thread fault
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (wpsimp wp: set_thread_state_pas_refined simp: handle_fault_def handle_double_fault_def)
@@ -2449,7 +2406,6 @@ lemma handle_fault_pas_refined:
       apply (rule hoare_strengthen_postE[where E'=E and E=E for E])
         apply (rule valid_validE)
         apply (wpsimp wp: send_fault_ipc_pas_refined)+
-  apply fastforce
   done
 
 end
@@ -2471,7 +2427,7 @@ lemma obj_at_conj_distrib:
 context Ipc_AC_2 begin
 
 lemma send_fault_ipc_integrity_autarch:
-  "\<lbrace>pas_refined aag and invs and integrity aag X st and is_subject aag \<circ> cur_thread
+  "\<lbrace>pas_refined aag and invs and integrity aag X st
                     and K (valid_fault fault) and K (is_subject aag thread)\<rbrace>
    send_fault_ipc thread fault
    \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
@@ -2492,7 +2448,6 @@ lemma send_fault_ipc_integrity_autarch:
     apply (rule_tac Q'="\<lambda>rv s. integrity aag X st s \<and> pas_refined aag s
                           \<and> invs s
                           \<and> valid_fault fault
-                          \<and> is_subject aag (cur_thread s)
                           \<and> is_subject aag (fst (fst rv))"
                in hoare_strengthen_postE_R[rotated])
      apply (clarsimp simp: invs_valid_objs invs_sym_refs cte_wp_at_caps_of_state obj_at_def)
@@ -2512,7 +2467,7 @@ lemma send_fault_ipc_integrity_autarch:
   done
 
 lemma handle_fault_integrity_autarch:
-  "\<lbrace>pas_refined aag and integrity aag X st and is_subject aag \<circ> cur_thread and invs
+  "\<lbrace>integrity aag X st and pas_refined aag and invs
                     and K (valid_fault fault) and K (is_subject aag thread)\<rbrace>
    handle_fault thread fault
    \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
@@ -2533,12 +2488,6 @@ lemma tcb_st_to_auth_Restart_Inactive [simp]:
 
 context Ipc_AC_2 begin
 
-crunch handle_fault_reply
-  for pspace_aligned[wp]: "\<lambda>s :: det_ext state. pspace_aligned s"
-  and valid_vspace_objs[wp]: "\<lambda>s :: det_ext state. valid_vspace_objs s"
-  and valid_arch_state[wp]: "\<lambda>s :: det_ext state. valid_arch_state s"
-  (wp: arch_get_sanitise_register_info_inv)
-
 lemma do_reply_transfer_pas_refined:
   "\<lbrace>pas_refined aag and invs and K (is_subject aag sender)
                     and K ((grant \<longrightarrow> is_subject aag receiver) \<and> is_subject aag (fst slot))\<rbrace>
diff --git a/proof/access-control/RISCV64/ArchArch_AC.thy b/proof/access-control/RISCV64/ArchArch_AC.thy
index 4519236a7b..90075ebf16 100644
--- a/proof/access-control/RISCV64/ArchArch_AC.thy
+++ b/proof/access-control/RISCV64/ArchArch_AC.thy
@@ -19,20 +19,13 @@ context Arch begin global_naming RISCV64
 named_theorems Arch_AC_assms
 
 lemma set_mrs_state_vrefs[Arch_AC_assms, wp]:
-  "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and (\<lambda>s. P (state_vrefs s))\<rbrace>
-   set_mrs thread buf msgs
-   \<lbrace>\<lambda>_ s. P (state_vrefs s)\<rbrace>"
+  "set_mrs thread buf msgs \<lbrace>\<lambda>s. P (state_vrefs s)\<rbrace>"
   apply (simp add: set_mrs_def split_def set_object_def get_object_def split del: if_split)
   apply (wpsimp wp: gets_the_wp get_wp put_wp mapM_x_wp'
               simp: zipWithM_x_mapM_x split_def store_word_offs_def
          split_del: if_split)
-  apply (subst state_vrefs_eqI)
-        prefer 7
-        apply assumption
-       apply (clarsimp simp: opt_map_def)
-      apply (fastforce simp: opt_map_def aobj_of_def)
-     apply clarsimp
-    apply (auto simp: valid_arch_state_def)
+  apply (subst (asm) state_vrefs_tcb_upd[symmetric])
+   apply (auto simp: fun_upd_def get_tcb_def tcb_at_def)
   done
 
 lemma mul_add_word_size_lt_msg_align_bits_ofnat[Arch_AC_assms]:
@@ -503,11 +496,9 @@ lemma perform_pt_inv_unmap_pas_refined:
   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   unfolding perform_pt_inv_unmap_def
   apply (wpsimp wp: set_cap_pas_refined get_cap_wp)
-       apply (strengthen invs_psp_aligned invs_vspace_objs invs_arch_state)
        apply wps
        apply (rule hoare_vcg_all_lift[OF hoare_vcg_imp_lift'[OF mapM_x_wp_inv]], wpsimp wp: mapM_x_wp_inv)
        apply (rule hoare_vcg_conj_lift[OF hoare_strengthen_post[OF mapM_x_swp_store_InvalidPTE_pas_refined]], assumption)
-       apply (rule hoare_vcg_conj_lift[OF hoare_strengthen_post[OF mapM_x_swp_store_pte_invs_unmap]], assumption)
        apply (wpsimp wp: pt_lookup_from_level_wrp store_pte_invs_unmap store_pte_pas_refined
                          mapM_x_wp_inv unmap_page_table_pas_refined
                          hoare_vcg_imp_lift' hoare_vcg_ball_lift hoare_vcg_all_lift)+
diff --git a/proof/access-control/RISCV64/ArchCNode_AC.thy b/proof/access-control/RISCV64/ArchCNode_AC.thy
index 39053ab651..38662c773e 100644
--- a/proof/access-control/RISCV64/ArchCNode_AC.thy
+++ b/proof/access-control/RISCV64/ArchCNode_AC.thy
@@ -56,29 +56,28 @@ lemma sata_update2[CNode_AC_assms]:
                  simp: cap_links_asid_slot_def label_owns_asid_slot_def
                 split: if_split_asm)
 
+lemma vs_lookup_table_eqI':
+    "\<lbrakk> asid_table s' (asid_high_bits_of asid) = asid_table s (asid_high_bits_of asid);
+       \<forall>pool_ptr. asid_table s' (asid_high_bits_of asid) = Some pool_ptr
+                  \<longrightarrow> bot_level \<le> max_pt_level
+                  \<longrightarrow> vspace_for_pool pool_ptr asid (asid_pools_of s') =
+                      vspace_for_pool pool_ptr asid (asid_pools_of s);
+       bot_level < max_pt_level \<longrightarrow> pts_of s' = pts_of s \<rbrakk>
+   \<Longrightarrow> vs_lookup_table bot_level asid vref s' = vs_lookup_table bot_level asid vref s"
+  by (auto simp: obind_def vs_lookup_table_def asid_pool_level_eq[symmetric]
+                 pool_for_asid_def vspace_for_pool_def
+          split: option.splits)
+
 lemma state_vrefs_eqI:
-  "\<lbrakk> \<forall>bot_level asid vref level p.
-       bot_level < level \<and> vs_lookup_table level asid vref s = Some (level, p)
-       \<longrightarrow> (if level \<le> max_pt_level
-            then pts_of s' p = pts_of s p
-            else asid_pools_of s' p = asid_pools_of s p);
-     aobjs_of s' = aobjs_of s; asid_table s' = asid_table s;
-     pspace_aligned s; valid_vspace_objs s; valid_asid_table s \<rbrakk>
-     \<Longrightarrow> state_vrefs (s' :: 'a :: state_ext state) = state_vrefs (s :: 'a :: state_ext state)"
-  apply (rule ext)
-  apply safe
-   apply (subst (asm) state_vrefs_def, clarsimp)
-   apply (fastforce intro: state_vrefsD elim: subst[OF vs_lookup_table_eqI,rotated -1])
-  apply (subst (asm) state_vrefs_def, clarsimp)
-  apply (rule state_vrefsD)
-     apply (subst vs_lookup_table_eqI; fastforce)
-    apply fastforce+
-  done
+  assumes "asid_table s' = asid_table s"
+  and "aobjs_of s' = aobjs_of s"
+  shows "state_vrefs s' = state_vrefs s"
+  apply (prop_tac "\<forall>level asid vref. vs_lookup_table level asid vref s = vs_lookup_table level asid vref s'")
+   apply (intro allI vs_lookup_table_eqI')
+  using assms by (auto simp: vspace_for_pool_def state_vrefs_def)
 
 lemma set_cap_state_vrefs[CNode_AC_assms, wp]:
-  "\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and (\<lambda>s. P (state_vrefs s))\<rbrace>
-   set_cap cap slot
-   \<lbrace>\<lambda>_ s :: det_ext state. P (state_vrefs s)\<rbrace>"
+  "set_cap cap slot \<lbrace>\<lambda>s :: det_ext state. P (state_vrefs s)\<rbrace>"
   apply (simp add: set_cap_def set_object_def)
   apply (wpsimp wp: get_object_wp)
   apply safe
@@ -100,14 +99,12 @@ crunch prepare_thread_delete, arch_finalise_cap
   (wp: crunch_wps hoare_vcg_if_lift2 simp: unless_def)
 
 lemma state_vrefs_tcb_upd[CNode_AC_assms]:
-  "\<lbrakk> pspace_aligned s; valid_vspace_objs s; valid_arch_state s; tcb_at t s \<rbrakk>
-     \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(t \<mapsto> TCB tcb)\<rparr>) = state_vrefs s"
+  "tcb_at t s \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(t \<mapsto> TCB tcb)\<rparr>) = state_vrefs s"
   apply (rule state_vrefs_eqI)
   by (fastforce simp: opt_map_def obj_at_def is_obj_defs valid_arch_state_def)+
 
 lemma state_vrefs_simple_type_upd[CNode_AC_assms]:
-  "\<lbrakk> pspace_aligned s; valid_vspace_objs s; valid_arch_state s;
-     ko_at ko ptr s; is_simple_type ko; a_type ko = a_type (f val) \<rbrakk>
+  "\<lbrakk> ko_at ko ptr s; is_simple_type ko; a_type ko = a_type (f val) \<rbrakk>
      \<Longrightarrow> state_vrefs (s\<lparr>kheap := (kheap s)(ptr \<mapsto> f val)\<rparr>) = state_vrefs s"
   apply (case_tac ko; case_tac "f val"; clarsimp)
   by (fastforce intro!: state_vrefs_eqI simp: opt_map_def obj_at_def is_obj_defs valid_arch_state_def)+
diff --git a/proof/access-control/RISCV64/ArchDomainSepInv.thy b/proof/access-control/RISCV64/ArchDomainSepInv.thy
index 6d295b84e4..f749c22af8 100644
--- a/proof/access-control/RISCV64/ArchDomainSepInv.thy
+++ b/proof/access-control/RISCV64/ArchDomainSepInv.thy
@@ -25,6 +25,26 @@ lemma arch_finalise_cap_rv[DomainSepInv_assms]:
   "\<lbrace>\<lambda>_. P (NullCap,NullCap)\<rbrace> arch_finalise_cap c x \<lbrace>\<lambda>rv _. P rv\<rbrace>"
   unfolding arch_finalise_cap_def by wpsimp
 
+crunch
+  handle_reserved_irq, handle_vm_fault, perform_pg_inv_map, perform_pg_inv_unmap,
+  perform_pg_inv_get_addr, perform_pt_inv_map, perform_pt_inv_unmap,
+  handle_hypervisor_fault, handle_arch_fault_reply, arch_mask_irq_signal,
+  arch_switch_to_thread, arch_switch_to_idle_thread, arch_activate_idle_thread,
+  store_asid_pool_entry, copy_global_mappings
+  for domain_sep_inv[DomainSepInv_assms, wp]: "domain_sep_inv irqs st"
+  (wp: crunch_wps)
+
+lemma arch_derive_cap_domain_sep_inv[DomainSepInv_assms, wp]:
+  "\<lbrace>\<top>\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv _. domain_sep_inv_cap irqs rv\<rbrace>,-"
+  unfolding arch_derive_cap_def
+  by wpsimp
+
+lemma arch_post_modify_registers_domain_sep_inv[DomainSepInv_assms, wp]:
+  "arch_post_modify_registers cur t \<lbrace>domain_sep_inv irqs st\<rbrace>"
+  unfolding arch_post_modify_registers_def by wpsimp
+
+declare init_arch_objects_inv[DomainSepInv_assms]
+
 end
 
 
@@ -32,21 +52,12 @@ global_interpretation DomainSepInv_1?: DomainSepInv_1
 proof goal_cases
   interpret Arch .
   case 1 show ?case
-    by (unfold_locales; (fact DomainSepInv_assms | wp init_arch_objects_inv))
+    by (unfold_locales; fact DomainSepInv_assms)
 qed
 
 
 context Arch begin global_naming RISCV64
 
-crunch
-  handle_reserved_irq, handle_vm_fault, perform_pg_inv_map, perform_pg_inv_unmap,
-  perform_pg_inv_get_addr, perform_pt_inv_map, perform_pt_inv_unmap,
-  handle_hypervisor_fault, handle_arch_fault_reply, arch_mask_irq_signal,
-  arch_switch_to_thread, arch_switch_to_idle_thread, arch_activate_idle_thread,
-  store_asid_pool_entry, copy_global_mappings
-  for domain_sep_inv[DomainSepInv_assms, wp]: "domain_sep_inv irqs st"
-  (wp: crunch_wps)
-
 lemma perform_page_invocation_domain_sep_inv:
   "\<lbrace>domain_sep_inv irqs st and valid_page_inv pgi\<rbrace>
    perform_page_invocation pgi
@@ -112,15 +123,6 @@ lemma arch_invoke_irq_control_domain_sep_inv[DomainSepInv_assms]:
    apply (wpsimp wp: do_machine_op_domain_sep_inv simp: arch_irq_control_inv_valid_def)+
   done
 
-lemma arch_derive_cap_domain_sep_inv[DomainSepInv_assms, wp]:
-  "\<lbrace>\<top>\<rbrace> arch_derive_cap acap \<lbrace>\<lambda>rv _. domain_sep_inv_cap irqs rv\<rbrace>,-"
-  unfolding arch_derive_cap_def
-  by wpsimp
-
-lemma arch_post_modify_registers_domain_sep_inv[DomainSepInv_assms, wp]:
-  "arch_post_modify_registers cur t \<lbrace>domain_sep_inv irqs st\<rbrace>"
-  unfolding arch_post_modify_registers_def by wpsimp
-
 end
 
 
@@ -128,7 +130,7 @@ global_interpretation DomainSepInv_2?: DomainSepInv_2
 proof goal_cases
   interpret Arch .
   case 1 show ?case
-    by (unfold_locales; fact DomainSepInv_assms)
+    by (unfold_locales; wpsimp wp: DomainSepInv_assms)
 qed
 
 end
diff --git a/proof/access-control/RISCV64/ArchFinalise_AC.thy b/proof/access-control/RISCV64/ArchFinalise_AC.thy
index c523ccf513..7c769a04cd 100644
--- a/proof/access-control/RISCV64/ArchFinalise_AC.thy
+++ b/proof/access-control/RISCV64/ArchFinalise_AC.thy
@@ -111,9 +111,7 @@ crunch prepare_thread_delete
   for respects[Finalise_AC_assms, wp]: "integrity aag X st"
 
 lemma sbn_st_vrefs[Finalise_AC_assms]:
-  "\<lbrace>(\<lambda>s. P (state_vrefs s)) and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-   set_bound_notification t st
-   \<lbrace>\<lambda>_ s. P (state_vrefs s)\<rbrace>"
+  "set_bound_notification t st \<lbrace>\<lambda>s. P (state_vrefs s)\<rbrace>"
   apply (simp add: set_bound_notification_def)
   apply (wpsimp wp: set_object_wp dxo_wp_weak)
   apply (subst state_vrefs_tcb_upd)
@@ -216,7 +214,7 @@ lemma delete_asid_respects:
   apply (clarsimp simp: pas_refined_refl obj_at_def asid_pool_integrity_def)
   done
 
-lemma arch_finalise_cap_respects[wp]:
+lemma arch_finalise_cap_respects[Finalise_AC_assms, wp]:
   "\<lbrace>integrity aag X st and invs and pas_refined aag and valid_cap (ArchObjectCap cap)
                        and K (pas_cap_cur_auth aag (ArchObjectCap cap))\<rbrace>
    arch_finalise_cap cap final
@@ -229,10 +227,11 @@ lemma arch_finalise_cap_respects[wp]:
              intro: pas_refined_Control_into_is_subject_asid)
   done
 
-crunch arch_post_cap_deletion
-  for pspace_aligned[Finalise_AC_assms, wp]: "\<lambda>s :: det_ext state. pspace_aligned s"
-  and valid_vspace_objs[Finalise_AC_assms, wp]: "\<lambda>s :: det_ext state. valid_vspace_objs s"
-  and valid_arch_state[Finalise_AC_assms, wp]: "\<lambda>s :: det_ext state. valid_arch_state s"
+declare prepare_thread_delete_st_tcb_at_halted[Finalise_AC_assms]
+declare finalise_cap_valid_list[Finalise_AC_assms]
+declare arch_finalise_cap_pas_refined[Finalise_AC_assms]
+declare prepare_thread_delete_pas_refined[Finalise_AC_assms]
+declare finalise_cap_replaceable[Finalise_AC_assms]
 
 end
 
@@ -241,7 +240,7 @@ global_interpretation Finalise_AC_1?: Finalise_AC_1
 proof goal_cases
   interpret Arch .
   case 1 show ?case
-    by (unfold_locales; (fact Finalise_AC_assms | wp finalise_cap_replaceable))
+    by (unfold_locales; wpsimp wp: Finalise_AC_assms)
 qed
 
 
diff --git a/proof/access-control/RISCV64/ArchInterrupt_AC.thy b/proof/access-control/RISCV64/ArchInterrupt_AC.thy
index 09ff7a783c..938d3bc052 100644
--- a/proof/access-control/RISCV64/ArchInterrupt_AC.thy
+++ b/proof/access-control/RISCV64/ArchInterrupt_AC.thy
@@ -21,8 +21,7 @@ definition arch_authorised_irq_ctl_inv ::
        (pasSubject aag, Control, pasIRQAbs aag irq) \<in> pasPolicy aag"
 
 lemma arch_invoke_irq_control_pas_refined[Interrupt_AC_assms]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_mdb and arch_irq_control_inv_valid irq_ctl_inv
+  "\<lbrace>pas_refined aag and valid_mdb and arch_irq_control_inv_valid irq_ctl_inv
                     and K (arch_authorised_irq_ctl_inv aag irq_ctl_inv)\<rbrace>
    arch_invoke_irq_control irq_ctl_inv
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
diff --git a/proof/access-control/RISCV64/ArchIpc_AC.thy b/proof/access-control/RISCV64/ArchIpc_AC.thy
index 211262fde4..30a9994e71 100644
--- a/proof/access-control/RISCV64/ArchIpc_AC.thy
+++ b/proof/access-control/RISCV64/ArchIpc_AC.thy
@@ -188,11 +188,6 @@ lemma auth_ipc_buffers_machine_state_update[Ipc_AC_assms, simp]:
   "auth_ipc_buffers (machine_state_update f s) = auth_ipc_buffers s"
   by (clarsimp simp: auth_ipc_buffers_def get_tcb_def)
 
-crunch handle_arch_fault_reply
-  for pspace_aligned[Ipc_AC_assms, wp]: "\<lambda>s :: det_ext state. pspace_aligned s"
-  and valid_vspace_objs[Ipc_AC_assms, wp]: "\<lambda>s :: det_ext state. valid_vspace_objs s"
-  and valid_arch_state[Ipc_AC_assms, wp]: "\<lambda>s :: det_ext state. valid_arch_state s"
-
 lemma cap_insert_ext_integrity_asids_in_ipc[Ipc_AC_assms, wp]:
   "cap_insert_ext src_parent src_slot dest_slot src_p dest_p
    \<lbrace>\<lambda>s. integrity_asids aag subjects x asid st
diff --git a/proof/access-control/RISCV64/ArchSyscall_AC.thy b/proof/access-control/RISCV64/ArchSyscall_AC.thy
index e9c7f0ee17..e8db944cac 100644
--- a/proof/access-control/RISCV64/ArchSyscall_AC.thy
+++ b/proof/access-control/RISCV64/ArchSyscall_AC.thy
@@ -160,6 +160,7 @@ crunch
 \<comment> \<open>These aren't proved in the previous crunch, and hence need to be declared\<close>
 declare handle_arch_fault_reply_cur_thread[Syscall_AC_assms]
 declare handle_arch_fault_reply_it[Syscall_AC_assms]
+declare init_arch_objects_inv[Syscall_AC_assms]
 
 end
 
@@ -168,7 +169,7 @@ global_interpretation Syscall_AC_1?: Syscall_AC_1
 proof goal_cases
   interpret Arch .
   case 1 show ?case
-    by (unfold_locales; (fact Syscall_AC_assms | wp init_arch_objects_inv))
+    by (unfold_locales; wpsimp wp: Syscall_AC_assms)
 qed
 
 end
diff --git a/proof/access-control/Retype_AC.thy b/proof/access-control/Retype_AC.thy
index b81ad611ab..c432e6910b 100644
--- a/proof/access-control/Retype_AC.thy
+++ b/proof/access-control/Retype_AC.thy
@@ -373,7 +373,7 @@ lemma obj_refs_default':
   by (cases tp; auto simp: ptr_range_memI obj_bits_api_def dest: rev_subsetD[OF _ aobj_refs'_default'])
 
 lemma create_cap_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and
+  "\<lbrace>pas_refined aag and
     K (tp \<noteq> ArchObject ASIDPoolObj \<and> is_subject aag (fst p) \<and> is_subject aag (fst (fst ref)) \<and>
        (\<forall>x \<in> ptr_range (snd ref) (obj_bits_api tp sz). is_subject aag x) \<and>
        is_aligned (snd ref) (obj_bits_api tp sz))\<rbrace>
@@ -787,28 +787,6 @@ lemma set_free_index_invs':
    apply (fastforce simp: cte_wp_at_def)
   done
 
-lemma delete_objects_pspace_no_overlap:
-  "\<lbrace>pspace_aligned and valid_objs and cte_wp_at ((=) (UntypedCap dev ptr sz idx)) slot\<rbrace>
-   delete_objects ptr sz
-   \<lbrace>\<lambda>_. pspace_no_overlap_range_cover ptr sz\<rbrace>"
-  unfolding delete_objects_def do_machine_op_def
-  apply (wp | simp add: split_def detype_machine_state_update_comm)+
-  apply clarsimp
-  apply (rule pspace_no_overlap_detype)
-   apply (auto dest: cte_wp_at_valid_objs_valid_cap)
-  done
-
-lemma delete_objects_pspace_no_overlap':
-  "\<lbrace>pspace_aligned and valid_objs and cte_wp_at ((=) (UntypedCap dev ptr sz idx)) slot\<rbrace>
-   delete_objects ptr sz
-   \<lbrace>\<lambda>_. pspace_no_overlap_range_cover (ptr && ~~ mask sz) sz\<rbrace>"
-  apply (clarsimp simp: valid_def)
-  apply (frule untyped_cap_aligned, simp)
-  apply (clarsimp)
-  apply (frule(1) cte_wp_at_valid_objs_valid_cap)
-  apply (erule use_valid, wp delete_objects_pspace_no_overlap, auto)
-  done
-
 (* FIXME: move *)
 lemma valid_cap_range_untyped:
   "\<lbrakk> valid_objs s; cte_wp_at ((=) (UntypedCap dev (ptr && ~~ mask sz) sz idx)) slot s \<rbrakk>
@@ -924,22 +902,6 @@ lemma delete_objects_pas_refined:
   apply simp
   done
 
-lemma delete_objects_pspace_aligned[wp]:
-  "delete_objects ptr sz \<lbrace>pspace_aligned\<rbrace>"
-  unfolding delete_objects_def do_machine_op_def
-  apply (wp | simp add: split_def detype_machine_state_update_comm)+
-  apply clarsimp
-  apply (auto simp add: detype_def pspace_aligned_def)
-  done
-
-lemma reset_untyped_cap_pspace_aligned[wp]:
-  "reset_untyped_cap slot \<lbrace>pspace_aligned\<rbrace>"
-  apply (clarsimp simp: reset_untyped_cap_def)
-  apply (wpsimp wp: mapME_x_inv_wp )
-       apply (rule valid_validE)
-       apply (wpsimp wp: preemption_point_inv dxo_wp_weak hoare_drop_imps)+
-  done
-
 lemma valid_vspace_objs_detype:
   assumes "invs s"
   assumes "cte_wp_at (\<lambda>c. is_untyped_cap c \<and> descendants_range c ptr s
@@ -1028,8 +990,7 @@ lemma reset_untyped_cap_pas_refined[wp]:
    apply (wps | wp set_cap_pas_refined_not_transferable | simp add: unless_def)+
      apply (rule valid_validE)
      apply (rule_tac P="is_untyped_cap cap \<and> pas_cap_cur_auth aag cap" in hoare_gen_asm)
-     apply (rule_tac Q'="\<lambda>_. cte_wp_at (\<lambda> c. \<not> is_transferable (Some c)) slot and pas_refined aag and
-                            pspace_aligned and valid_vspace_objs and valid_arch_state"
+     apply (rule_tac Q'="\<lambda>_. cte_wp_at (\<lambda> c. \<not> is_transferable (Some c)) slot and pas_refined aag"
                   in hoare_strengthen_post)
       apply (rule validE_valid, rule mapME_x_inv_wp)
       apply (rule hoare_pre)
@@ -1046,7 +1007,6 @@ lemma reset_untyped_cap_pas_refined[wp]:
        apply (fastforce simp: cte_wp_at_caps_of_state)+
   apply (cases slot)
   apply (auto elim: caps_pas_cap_cur_auth_UntypedCap_idx_dev)
-       apply (fastforce simp: bits_of_def is_cap_simps)+
   done
 
 lemma invoke_untyped_pas_refined:
@@ -1056,9 +1016,8 @@ lemma invoke_untyped_pas_refined:
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (rule hoare_gen_asm)
   apply (rule hoare_pre)
-   apply (rule_tac Q'="\<lambda>_. pas_refined aag and pspace_aligned and valid_vspace_objs
-                                          and valid_arch_state and pas_cur_domain aag" in hoare_strengthen_post)
-   apply (rule invoke_untyped_Q)
+   apply (rule_tac Q'="\<lambda>_. pas_refined aag and pas_cur_domain aag" in hoare_strengthen_post)
+    apply (rule invoke_untyped_Q)
         apply (rule hoare_pre, wp create_cap_pas_refined)
         apply (clarsimp simp: authorised_untyped_inv_def
                               range_cover.aligned ptr_range_def[symmetric]
@@ -1074,31 +1033,20 @@ lemma invoke_untyped_pas_refined:
               | strengthen invs_psp_aligned invs_vspace_objs invs_arch_state)+
        apply (clarsimp simp: retype_addrs_aligned_range_cover
                              cte_wp_at_caps_of_state)
-       apply (rule context_conjI, clarsimp)
-        apply (drule valid_global_refsD[rotated 2])
-          apply (clarsimp simp: post_retype_invs_def split: if_split_asm)
-         apply (erule caps_of_state_cteD)
-        apply (erule notE, erule subsetD[rotated])
-        apply (rule order_trans, erule retype_addrs_subset_ptr_bits)
-        apply (simp add: field_simps word_and_le2)
-       apply blast
+       apply (drule valid_global_refsD[rotated 2])
+         apply (clarsimp simp: post_retype_invs_def split: if_split_asm)
+        apply (erule caps_of_state_cteD)
+       apply (erule notE, erule subsetD[rotated])
+       apply (rule order_trans, erule retype_addrs_subset_ptr_bits)
+       apply (simp add: field_simps word_and_le2)
       apply (rule hoare_name_pre_state, clarsimp)
       apply (rule hoare_pre, wp retype_region_pas_refined)
-       apply (rule_tac Q'="\<lambda>rv. post_retype_invs tp rv and pas_cur_domain aag" in hoare_strengthen_post)
-        apply (wp retype_region_post_retype_invs_spec)
-       apply (clarsimp simp: post_retype_invs_def invs_def valid_state_def valid_pspace_def split: if_splits)
       apply (clarsimp simp: authorised_untyped_inv_def)
       apply (strengthen range_cover_le[mk_strg I E], simp)
-      apply (intro conjI)
-        apply (intro conjI exI;
-               (erule cte_wp_at_weakenE)?,
-               clarsimp simp: field_simps word_and_le2)
-       apply (clarsimp simp: cte_wp_at_caps_of_state)
-       apply (erule caps_region_kernel_window_imp)
-        apply clarsimp
-       apply clarsimp
-       apply (fastforce simp: word_and_le2)
-      apply (fastforce simp: cte_wp_at_caps_of_state)
+      apply (intro conjI exI;
+             (erule cte_wp_at_weakenE)?,
+             clarsimp simp: field_simps word_and_le2)
+     apply (clarsimp simp: cte_wp_at_caps_of_state)
      apply (rule hoare_pre, wp set_cap_pas_refined)
      apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps)
      apply (cases ui,
diff --git a/proof/access-control/Syscall_AC.thy b/proof/access-control/Syscall_AC.thy
index ad13ff9fb8..82963b0fb8 100644
--- a/proof/access-control/Syscall_AC.thy
+++ b/proof/access-control/Syscall_AC.thy
@@ -371,7 +371,6 @@ lemma handle_recv_integrity:
       apply (fastforce simp: aag_cap_auth_def cap_auth_conferred_def
                              cap_rights_to_auth_def valid_fault_def)
      apply wpsimp+
-  apply fastforce
   done
 
 lemma handle_reply_pas_refined[wp]:
@@ -469,30 +468,42 @@ locale Syscall_AC_1 =
     "Syscall_AC_wps (arch_activate_idle_thread t) aag"
   and arch_mask_irq_signal_integrity[simp]:
     "Syscall_AC_wps (arch_mask_irq_signal irq) aag"
-  and handle_reserved_irq_integrity[simp]:
-    "Syscall_AC_wps (handle_reserved_irq irq) aag"
-  and handle_hypervisor_fault_integrity[simp]:
-    "Syscall_AC_wps (handle_hypervisor_fault t hf_t) aag"
   and arch_switch_to_idle_thread_pas_refined[wp]:
     "arch_switch_to_idle_thread \<lbrace>pas_refined aag\<rbrace>"
   and arch_activate_idle_thread_pas_refined[wp]:
     "arch_activate_idle_thread t \<lbrace>pas_refined aag\<rbrace>"
   and arch_mask_irq_signal_pas_refined[wp]:
     "arch_mask_irq_signal irq \<lbrace>pas_refined aag\<rbrace>"
-  and handle_reserved_irq_pas_refined[wp]:
-    "handle_reserved_irq irq \<lbrace>pas_refined aag\<rbrace>"
-  and handle_hypervisor_fault_pas_refined[wp]:
-    "handle_hypervisor_fault t hf_t \<lbrace>pas_refined aag\<rbrace>"
+  and arch_mask_irq_signal_pas_cur_domain:
+    "arch_mask_irq_signal irq \<lbrace>pas_cur_domain aag\<rbrace>"
+  and handle_reserved_irq_integrity_autarch:
+    "\<lbrace>integrity aag X st and pas_refined aag and invs and (\<lambda>s. is_subject aag (cur_thread s))\<rbrace>
+     handle_reserved_irq irq
+     \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  and handle_reserved_irq_integrity_idle:
+    "\<lbrace>integrity aag X st and invs and ct_idle\<rbrace>
+     handle_reserved_irq irq
+     \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  and handle_reserved_irq_pas_refined:
+    "\<lbrace>\<lambda>s. pas_refined aag s \<and> invs s \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s))\<rbrace>
+     handle_reserved_irq irq \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  and handle_reserved_irq_pas_cur_domain:
+    "handle_reserved_irq irq \<lbrace>pas_cur_domain aag\<rbrace>"
+  and handle_hypervisor_fault_integrity_autarch:
+    "\<lbrace>\<lambda>s. integrity aag X st s \<and> pas_refined aag s \<and> invs s \<and> is_subject aag thread
+                               \<and> (ct_active s \<longrightarrow> is_subject aag (cur_thread s))\<rbrace>
+     handle_hypervisor_fault thread fault
+     \<lbrace>\<lambda>_ s. integrity aag X st s\<rbrace>"
+  and handle_hypervisor_fault_pas_refined:
+    "\<lbrace>\<lambda>s. pas_refined aag s \<and> is_subject aag (cur_thread s) \<and> is_subject aag thread \<and> invs s\<rbrace>
+     handle_hypervisor_fault thread fault
+     \<lbrace>\<lambda>_ s. pas_refined aag s\<rbrace>"
   and handle_vm_fault_integrity:
     "\<lbrace>integrity aag X st and K (is_subject aag thread)\<rbrace>
      handle_vm_fault thread vmfault_type
      \<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
   and handle_vm_fault_pas_refined[wp]:
     "handle_vm_fault t vmf_t \<lbrace>pas_refined aag\<rbrace>"
-  and arch_mask_irq_signal_pas_cur_domain:
-    "arch_mask_irq_signal irq \<lbrace>pas_cur_domain aag\<rbrace>"
-  and handle_reserved_irq_pas_cur_domain:
-    "handle_reserved_irq irq \<lbrace>pas_cur_domain aag\<rbrace>"
   and ackInterrupt_underlying_memory_inv[wp]:
     "\<And>P. ackInterrupt irq \<lbrace>\<lambda>s. P (underlying_memory s)\<rbrace>"
   and resetTimer_underlying_memory_inv[wp]:
@@ -555,20 +566,17 @@ sublocale Syscall_AC_1 \<subseteq> arch_activate_idle_thread: Syscall_AC_wps "ar
   by simp
 sublocale Syscall_AC_1 \<subseteq> arch_mask_irq_signal: Syscall_AC_wps "arch_mask_irq_signal irq" aag
   by simp
-sublocale Syscall_AC_1 \<subseteq> handle_reserved_irq: Syscall_AC_wps "handle_reserved_irq irq" aag
-  by simp
-sublocale Syscall_AC_1 \<subseteq> handle_hypervisor_fault: Syscall_AC_wps "handle_hypervisor_fault t hf_t" aag
-  by simp
 
 
 context Syscall_AC_1 begin
 
 lemma handle_interrupt_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-    handle_interrupt irq \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "\<lbrace>pas_refined aag and invs and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))\<rbrace>
+    handle_interrupt irq
+   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: handle_interrupt_def)
   apply (rule conjI; rule impI;rule hoare_pre)
-  apply (wp send_signal_pas_refined get_cap_wp
+  apply (wp send_signal_pas_refined get_cap_wp handle_reserved_irq_pas_refined
          | wpc
          | simp add: get_irq_slot_def get_irq_state_def )+
   done
@@ -589,23 +597,6 @@ lemma timer_tick_integrity[wp]:
   apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def)
   done
 
-lemma handle_interrupt_integrity_autarch:
-  "\<lbrace>integrity aag X st and pas_refined aag and invs
-                       and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))
-                       and K (is_subject_irq aag irq)\<rbrace>
-   handle_interrupt irq
-   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
-  apply (simp add: handle_interrupt_def  cong: irq_state.case_cong)
-  apply (rule conjI; rule impI; rule hoare_pre)
-     apply (wp (once) send_signal_respects get_cap_auth_wp [where aag = aag] dmo_mol_respects
-                      ackInterrupt_device_state_inv resetTimer_device_state_inv
-            | simp add: get_irq_slot_def get_irq_state_def
-            | wp dmo_no_mem_respects
-            | wpc)+
-  apply (fastforce simp: is_cap_simps aag_cap_auth_def cap_auth_conferred_def
-                         cap_rights_to_auth_def)
-  done
-
 lemma hacky_ipc_Send:
   "\<lbrakk> abs_has_auth_to aag Notify (interrupt_irq_node s irq) p;
      pas_refined aag s; pasMaySendIrqs aag \<rbrakk>
@@ -617,27 +608,50 @@ lemma hacky_ipc_Send:
   apply simp
   done
 
+lemma handle_interrupt_integrity_autarch:
+  "\<lbrace>integrity aag X st and pas_refined aag and invs
+                       and (\<lambda>s. pasMaySendIrqs aag \<or> interrupt_states s irq \<noteq> IRQSignal)
+                       and (\<lambda>s. is_subject aag (cur_thread s))\<rbrace>
+   handle_interrupt irq
+   \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
+  apply (simp add: handle_interrupt_def cong: irq_state.case_cong bind_cong)
+  apply (rule conjI; rule impI; rule hoare_pre)
+     apply (wpsimp wp: send_signal_respects get_cap_wp dmo_mol_respects dmo_no_mem_respects
+                       ackInterrupt_device_state_inv resetTimer_device_state_inv
+                       handle_reserved_irq_integrity_autarch
+                 simp: get_irq_slot_def get_irq_state_def)+
+  apply (rule conjI, fastforce)+ \<comment> \<open>valid_objs etc.\<close>
+  apply (clarsimp simp: cte_wp_at_caps_of_state)
+  apply (rule_tac s = s in hacky_ipc_Send [where irq = irq])
+    apply (drule (1) cap_auth_caps_of_state)
+    apply (clarsimp simp: aag_cap_auth_def is_cap_simps cap_auth_conferred_def
+                          cap_rights_to_auth_def split: if_split_asm)
+   apply assumption+
+  done
+
 lemma handle_interrupt_integrity:
   "\<lbrace>integrity aag X st and pas_refined aag and invs
                        and (\<lambda>s. pasMaySendIrqs aag \<or> interrupt_states s irq \<noteq> IRQSignal)
-                       and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))\<rbrace>
+                       and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))
+                       and (ct_active or ct_idle)\<rbrace>
    handle_interrupt irq
    \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
-  apply (simp add: handle_interrupt_def
-             cong: irq_state.case_cong bind_cong)
+  apply (subst distrib(3))
+  apply (rule hoare_pre_disj)
+   apply (wpsimp wp: handle_interrupt_integrity_autarch)
+  apply (simp add: handle_interrupt_def cong: irq_state.case_cong bind_cong)
   apply (rule conjI; rule impI; rule hoare_pre)
-     apply (wp (once) send_signal_respects get_cap_wp dmo_mol_respects dmo_no_mem_respects
-                      ackInterrupt_device_state_inv resetTimer_device_state_inv
-            | wpc
-            | simp add: get_irq_slot_def get_irq_state_def)+
-  apply clarsimp
+     apply (wpsimp wp: send_signal_respects get_cap_wp dmo_mol_respects dmo_no_mem_respects
+                       ackInterrupt_device_state_inv resetTimer_device_state_inv
+                       handle_reserved_irq_integrity_idle
+                 simp: get_irq_slot_def get_irq_state_def)+
   apply (rule conjI, fastforce)+ \<comment> \<open>valid_objs etc.\<close>
   apply (clarsimp simp: cte_wp_at_caps_of_state)
   apply (rule_tac s = s in hacky_ipc_Send [where irq = irq])
-   apply (drule (1) cap_auth_caps_of_state)
-   apply (clarsimp simp: aag_cap_auth_def is_cap_simps cap_auth_conferred_def
-                         cap_rights_to_auth_def split: if_split_asm)
-  apply assumption+
+    apply (drule (1) cap_auth_caps_of_state)
+    apply (clarsimp simp: aag_cap_auth_def is_cap_simps cap_auth_conferred_def
+                          cap_rights_to_auth_def split: if_split_asm)
+   apply assumption+
   done
 
 lemma handle_yield_pas_refined[wp]:
@@ -647,25 +661,22 @@ lemma handle_yield_pas_refined[wp]:
 lemma handle_event_pas_refined:
   "\<lbrace>pas_refined aag and guarded_pas_domain aag and domain_sep_inv (pasMaySendIrqs aag) st'
                     and einvs and schact_is_rct
-                    and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> is_subject aag (cur_thread s))
+                    and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))
                     and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_active s) \<rbrace>
    handle_event ev
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (case_tac ev; simp)
-      apply (rename_tac syscall)
-      apply (case_tac syscall; simp add: handle_send_def handle_call_def)
-            apply ((wp handle_invocation_pas_refined handle_recv_pas_refined
-                       handle_fault_pas_refined
-                    | simp | clarsimp)+)
+       apply (rename_tac syscall)
+       apply (case_tac syscall; simp add: handle_send_def handle_call_def)
+              apply ((wp handle_invocation_pas_refined handle_recv_pas_refined
+                         handle_fault_pas_refined
+                      | simp | clarsimp)+)
+      apply (fastforce simp: valid_fault_def)
+     apply (wp handle_fault_pas_refined | simp)+
      apply (fastforce simp: valid_fault_def)
-    apply (wp handle_fault_pas_refined | simp)+
-    apply (fastforce simp: valid_fault_def)
-   apply (wp handle_interrupt_pas_refined handle_fault_pas_refined
-             hoare_vcg_conj_lift hoare_vcg_all_lift
-          | wpc
-          | rule hoare_drop_imps
-          | strengthen invs_vobjs_strgs invs_psp_aligned invs_vspace_objs invs_arch_state
-          | simp)+
+    apply (wpsimp wp: handle_fault_pas_refined handle_hypervisor_fault_pas_refined hoare_drop_imps
+                      handle_interrupt_pas_refined hoare_vcg_conj_lift hoare_vcg_all_lift
+                simp: ct_in_state_def)+
   done
 
 lemma valid_fault_Unknown[simp]:
@@ -692,7 +703,7 @@ lemma handle_event_integrity:
   "\<lbrace>integrity aag X st and pas_refined aag and guarded_pas_domain aag
                        and domain_sep_inv (pasMaySendIrqs aag) st'
                        and einvs and schact_is_rct
-                       and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))
+                       and (\<lambda>s. is_subject aag (cur_thread s))
                        and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_active s) and ((=) st)\<rbrace>
    handle_event ev
    \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
@@ -700,9 +711,9 @@ lemma handle_event_integrity:
        apply (unfold handle_send_def handle_call_def)
   by (wpsimp wp: handle_recv_integrity handle_invocation_respects
                   handle_reply_respects handle_fault_integrity_autarch
-                  handle_interrupt_integrity handle_vm_fault_integrity
+                  handle_interrupt_integrity_autarch handle_vm_fault_integrity
                   handle_reply_pas_refined handle_vm_fault_valid_fault
-                  handle_reply_valid_sched
+                  handle_reply_valid_sched handle_hypervisor_fault_integrity_autarch
                   hoare_vcg_conj_lift hoare_vcg_all_lift hoare_drop_imps
             simp: domain_sep_inv_def
       | rule dmo_wp hoare_vcg_conj_elimE
@@ -730,12 +741,9 @@ lemma activate_thread_integrity:
   done
 
 lemma activate_thread_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
-   activate_thread
-   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
+  "activate_thread \<lbrace>pas_refined aag\<rbrace>"
   unfolding activate_thread_def get_thread_state_def thread_get_def
-  apply (wpsimp wp: set_thread_state_pas_refined hoare_drop_imps)
-  done
+  by (wpsimp wp: set_thread_state_pas_refined hoare_drop_imps)
 
 lemma integrity_cur_thread[iff]:
   "integrity aag X st (s\<lparr>cur_thread := v\<rparr>) = integrity aag X st s"
@@ -1144,39 +1152,46 @@ lemma guarded_pas_domain_machine_state_update[simp]:
   by (simp add: guarded_pas_domain_def)
 
 lemma call_kernel_integrity':
-  "st \<turnstile> \<lbrace>einvs and pas_refined aag and is_subject aag \<circ> cur_thread and schact_is_rct and guarded_pas_domain aag
+  "st \<turnstile> \<lbrace>einvs and pas_refined aag and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))
+               and schact_is_rct and guarded_pas_domain aag
                and domain_sep_inv (pasMaySendIrqs aag) st'
                and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_active s) and (ct_active or ct_idle)
                and K (pasMayActivate aag \<and> pasMayEditReadyQueues aag)\<rbrace>
         call_kernel ev
         \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
-  apply (simp add: call_kernel_def)
-  apply (simp only: spec_valid_def)
-  apply (wpsimp wp: activate_thread_respects schedule_integrity_pasMayEditReadyQueues
-                    handle_interrupt_integrity dmo_wp handle_interrupt_pas_refined)
+  apply (case_tac "ev = Interrupt"; clarsimp simp: call_kernel_def spec_valid_def)
+   apply (wpsimp wp: activate_thread_respects schedule_integrity_pasMayEditReadyQueues
+                     handle_interrupt_integrity handle_interrupt_pas_refined)
+    apply (rule_tac Q="\<lambda>rv s. (rv = None \<longrightarrow> P s) \<and> (\<forall>x. rv = Some x \<longrightarrow> Q x s)"
+               and Q'="\<lambda>rv s. P s \<and> (\<forall>x. rv = Some x \<longrightarrow> Q x s)"
+        for P Q in hoare_strengthen_post[rotated]; clarsimp cong: conj_cong)
+    apply (wpsimp wp: hoare_vcg_all_lift hoare_drop_imps)
+   apply (fastforce intro!: valid_sched_ct_not_queued
+                      simp: schact_is_rct_def domain_sep_inv_def guarded_pas_domain_def)
+  apply (wpsimp wp: activate_thread_respects schedule_integrity_pasMayEditReadyQueues dmo_wp
+                    handle_interrupt_integrity_autarch handle_interrupt_pas_refined )
     apply (clarsimp simp: if_fun_split)
     apply (rule_tac Q'="\<lambda>rv ms. (rv \<noteq> None \<longrightarrow> the rv \<notin> non_kernel_IRQs) \<and>
                                 Q True (domain_sep_inv (pasMaySendIrqs aag) st' s) rv ms"
                 and Q="\<lambda>rv ms. Q (the rv \<in> non_kernel_IRQs \<longrightarrow> scheduler_act_sane s \<and> ct_not_queued s)
                                  (pasMaySendIrqs aag \<or> interrupt_states s (the rv) \<noteq> IRQSignal) rv ms"
                 for Q in hoare_strengthen_post[rotated], fastforce simp: domain_sep_inv_def)
-    apply (wpsimp wp: getActiveIRQ_rv_None hoare_drop_imps getActiveIRQ_inv)
+    apply (wpsimp wp: getActiveIRQ_rv_None getActiveIRQ_inv hoare_drop_imps)
    apply (rule hoare_strengthen_postE,
-      rule_tac Q="integrity aag X st and pas_refined aag and einvs and guarded_pas_domain aag
-                                     and domain_sep_inv (pasMaySendIrqs aag) st'
-                                     and is_subject aag \<circ> cur_thread
-                                     and K (pasMayActivate aag \<and> pasMayEditReadyQueues aag)"
-            in valid_validE)
-     apply (wpsimp wp: handle_event_integrity he_invs handle_event_pas_refined
-                       handle_event_cur_thread handle_event_cur_domain
+          rule_tac Q="integrity aag X st and pas_refined aag and einvs and guarded_pas_domain aag
+                                         and domain_sep_inv (pasMaySendIrqs aag) st'
+                                         and is_subject aag \<circ> cur_thread
+                                         and K (pasMayActivate aag \<and> pasMayEditReadyQueues aag)"
+                in valid_validE)
+     apply (wpsimp wp: handle_event_integrity  handle_event_pas_refined
                        handle_event_domain_sep_inv handle_event_valid_sched)+
-    apply (fastforce simp: domain_sep_inv_def guarded_pas_domain_def)+
+  apply (fastforce simp: domain_sep_inv_def guarded_pas_domain_def)
   done
 
 lemma call_kernel_integrity:
   "\<lbrace>pas_refined aag and einvs and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_active s) and (ct_active or ct_idle)
                     and domain_sep_inv (pasMaySendIrqs aag) st' and schact_is_rct
-                    and guarded_pas_domain aag and is_subject aag o cur_thread
+                    and guarded_pas_domain aag and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))
                     and K (pasMayActivate aag \<and> pasMayEditReadyQueues aag) and (\<lambda>s. s = st)\<rbrace>
    call_kernel ev
    \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
@@ -1188,18 +1203,22 @@ lemma call_kernel_integrity:
   done
 
 lemma call_kernel_pas_refined:
-  "\<lbrace>einvs and pas_refined aag and is_subject aag \<circ> cur_thread and guarded_pas_domain aag
+  "\<lbrace>einvs and pas_refined aag and (\<lambda>s. ct_active s \<longrightarrow> is_subject aag (cur_thread s))
+          and guarded_pas_domain aag
           and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_active s) and (ct_active or ct_idle)
           and schact_is_rct and pas_cur_domain aag and domain_sep_inv (pasMaySendIrqs aag) st'\<rbrace>
    call_kernel ev
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
-  apply (simp add: call_kernel_def )
-  apply (wp activate_thread_pas_refined schedule_pas_refined handle_interrupt_pas_refined
-            do_machine_op_pas_refined dmo_wp hoare_drop_imps getActiveIRQ_inv
-         | simp add: if_fun_split
-         | strengthen invs_psp_aligned invs_vspace_objs invs_arch_state)+
-   apply (wp he_invs handle_event_pas_refined)
-  apply auto
+  apply (case_tac "ev = Interrupt"; clarsimp simp: call_kernel_def)
+   apply (wpsimp wp: activate_thread_pas_refined schedule_pas_refined handle_interrupt_pas_refined
+                     do_machine_op_pas_refined dmo_wp hoare_drop_imps getActiveIRQ_inv
+          | simp add: if_fun_split
+          | strengthen invs_psp_aligned invs_vspace_objs invs_arch_state)+
+   apply (rule hoare_strengthen_postE,
+          rule_tac Q="pas_refined aag and invs and is_subject aag \<circ> cur_thread"
+                in valid_validE)
+     apply (wpsimp wp: he_invs handle_event_pas_refined)
+    apply auto
   done
 
 end
diff --git a/proof/access-control/Tcb_AC.thy b/proof/access-control/Tcb_AC.thy
index 9555729fdf..f1f7f54454 100644
--- a/proof/access-control/Tcb_AC.thy
+++ b/proof/access-control/Tcb_AC.thy
@@ -96,8 +96,7 @@ lemma cdt_NullCap:
   by (rule ccontr) (force dest: mdb_cte_atD simp: valid_mdb_def2)
 
 lemma setup_reply_master_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state
-                    and valid_mdb and K (is_subject aag t)\<rbrace>
+  "\<lbrace>pas_refined aag and valid_mdb and K (is_subject aag t)\<rbrace>
    setup_reply_master t
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: setup_reply_master_def)
@@ -108,7 +107,7 @@ crunch possible_switch_to
   for tcb_domain_map_wellformed[wp]: "tcb_domain_map_wellformed aag"
 
 crunch setup_reply_master
-  for pspace_aligned[wp]: pspace_aligned
+  for pas_refined[wp]: "pas_refined aag"
 
 lemma restart_pas_refined:
   "\<lbrace>pas_refined aag and invs and tcb_at t and K (is_subject aag t)\<rbrace>
@@ -116,8 +115,8 @@ lemma restart_pas_refined:
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (simp add: restart_def get_thread_state_def)
   apply (wp set_thread_state_pas_refined setup_reply_master_pas_refined thread_get_wp'
-         | strengthen invs_mdb
-         | fastforce)+
+         | strengthen invs_mdb)+
+  apply fastforce
   done
 
 lemma option_update_thread_set_safe_lift:
@@ -177,7 +176,7 @@ lemma (in is_extended') cte_wp_at[wp]: "I (cte_wp_at P a)"
   by (rule lift_inv, simp)
 
 lemma checked_insert_pas_refined:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and
+  "\<lbrace>pas_refined aag and valid_mdb and
     K (\<not> is_master_reply_cap new_cap \<and> is_subject aag target \<and>
          is_subject aag (fst src_slot) \<and> pas_cap_cur_auth aag new_cap)\<rbrace>
    check_cap_at new_cap src_slot
@@ -340,8 +339,7 @@ lemma hoare_st_refl:
   done
 
 lemma bind_notification_pas_refined[wp]:
-  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and
-    K (\<forall>auth \<in> {Receive, Reset}. abs_has_auth_to aag auth t ntfn)\<rbrace>
+  "\<lbrace>pas_refined aag and K (\<forall>auth \<in> {Receive, Reset}. abs_has_auth_to aag auth t ntfn)\<rbrace>
    bind_notification t ntfn
    \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
   apply (clarsimp simp: bind_notification_def)
@@ -358,13 +356,6 @@ lemma invoke_tcb_ntfn_control_pas_refined[wp]:
    apply (wp | fastforce simp: authorised_tcb_inv_def)+
   done
 
-crunch suspend, restart
-  for pspace_aligned[wp]: "\<lambda>s :: det_ext state. pspace_aligned s"
-  and valid_vspace_objs[wp]: "\<lambda>s :: det_ext state. valid_vspace_objs s"
-  and valid_arch_state[wp]: "\<lambda>s :: det_ext state. valid_arch_state s"
-  (wp: dxo_wp_weak)
-
-
 context Tcb_AC_1 begin
 
 lemma invoke_tcb_pas_refined:
@@ -382,11 +373,7 @@ lemma invoke_tcb_pas_refined:
    apply assumption
   apply (rule hoare_gen_asm)
   apply (cases ti, simp_all add: authorised_tcb_inv_def)
-        apply (wp ita_wps hoare_drop_imps
-                  hoare_strengthen_post[where Q'="\<lambda>_. pas_refined aag and pspace_aligned
-                                                                     and valid_vspace_objs
-                                                                     and valid_arch_state",
-                                        OF mapM_x_wp']
+        apply (wp ita_wps hoare_drop_imps mapM_x_wp'
               | simp add: emptyable_def if_apply_def2 authorised_tcb_inv_def
               | rule ball_tcb_cap_casesI
               | wpc
diff --git a/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy b/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy
index 01d12ad001..ef1627b0d8 100644
--- a/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy
@@ -31,7 +31,12 @@ lemma dmo_mapM_storeWord_0_invs[wp,Schedule_AI_assms]:
 lemma arch_stt_invs [wp,Schedule_AI_assms]:
   "arch_switch_to_thread t' \<lbrace>invs\<rbrace>"
   apply (wpsimp simp: arch_switch_to_thread_def)
-  by (rule sym_refs_VCPU_hyp_live; fastforce)
+  apply (clarsimp simp: obj_at_vcpu_hyp_live_of_s[symmetric] obj_at_conj_distrib)
+  apply (rule conjI)
+   apply (fastforce dest!: valid_tcb_objs[OF invs_valid_objs]
+                     simp: valid_tcb_def valid_arch_tcb_def obj_at_def is_vcpu_def)
+  apply (rule sym_refs_VCPU_hyp_live; fastforce)
+  done
 
 lemma arch_stt_tcb [wp,Schedule_AI_assms]:
   "arch_switch_to_thread t' \<lbrace>tcb_at t'\<rbrace>"
diff --git a/proof/invariant-abstract/AARCH64/ArchVCPU_AI.thy b/proof/invariant-abstract/AARCH64/ArchVCPU_AI.thy
index 35dc4a38bc..e8d2ec6c0c 100644
--- a/proof/invariant-abstract/AARCH64/ArchVCPU_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchVCPU_AI.thy
@@ -120,8 +120,10 @@ lemma switch_vcpu_valid_cur_vcpu_cur_thread_update[wp]:
    vcpu_switch v
    \<lbrace>\<lambda>_ s. valid_cur_vcpu (s\<lparr>cur_thread := t\<rparr>)\<rbrace>"
   unfolding vcpu_switch_def
-  apply (wpsimp simp: valid_cur_vcpu_def active_cur_vcpu_of_def)
-  by fastforce
+  apply (wpsimp simp: valid_cur_vcpu_def active_cur_vcpu_of_def
+         | rule hoare_lift_Pf[where f=arch_state])+
+  apply fastforce
+  done
 
 lemma switch_vcpu_valid_cur_vcpu[wp]:
   "\<lbrace>\<lambda>s. arch_tcb_at (\<lambda>itcb. itcb_vcpu itcb = v) (cur_thread s) s\<rbrace>
diff --git a/proof/invariant-abstract/AARCH64/ArchVSpace_AI.thy b/proof/invariant-abstract/AARCH64/ArchVSpace_AI.thy
index 48bb3f688a..77163ae0fa 100644
--- a/proof/invariant-abstract/AARCH64/ArchVSpace_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchVSpace_AI.thy
@@ -3063,13 +3063,14 @@ crunch vcpu_disable, vcpu_restore, vcpu_save
   (wp: crunch_wps)
 
 lemma vcpu_switch_invs[wp]:
-  "\<lbrace>invs and (\<lambda>s. v \<noteq> None \<longrightarrow> obj_at hyp_live (the v) s)\<rbrace> vcpu_switch v \<lbrace> \<lambda>_ . invs \<rbrace>"
+  "\<lbrace>invs and (\<lambda>s. v \<noteq> None \<longrightarrow> vcpu_hyp_live_of s (the v))\<rbrace> vcpu_switch v \<lbrace> \<lambda>_ . invs \<rbrace>"
   unfolding vcpu_switch_def
   apply (cases v; clarsimp)
    apply (wpsimp simp: cur_vcpu_at_def | strengthen invs_current_vcpu_update')+
    apply (clarsimp simp: invs_def valid_state_def valid_arch_state_def cur_vcpu_def
                          in_omonad obj_at_def hyp_live_def arch_live_def)
   apply (wpsimp simp: cur_vcpu_at_def | strengthen invs_current_vcpu_update')+
+  apply (clarsimp simp: in_omonad obj_at_def hyp_live_def arch_live_def)
   done
 
 crunch
diff --git a/run_tests b/run_tests
index a99ffbd0af..ce6460d6db 100755
--- a/run_tests
+++ b/run_tests
@@ -40,7 +40,10 @@ EXCLUDE["ARM_HYP"]=[
     "RefineOrphanage",
     "SimplExportAndRefine"]
 
-EXCLUDE["ARM"]=[]
+EXCLUDE["ARM"]=[
+    "DPolicy",
+    "InfoFlow"
+]
 
 EXCLUDE["X64"]=[
     "Access",
@@ -57,6 +60,7 @@ EXCLUDE["RISCV64"]=[
     "AutoCorresSEL4",
     "DSpec",
     "DBaseRefine",
+    "InfoFlow",
     "CamkesGlueProofs",
     "AsmRefine"
 ]
@@ -64,7 +68,9 @@ EXCLUDE["RISCV64"]=[
 EXCLUDE["AARCH64"]=[
     # To be eliminated/refined as development progresses
     "ASepSpec",
-    "Access",
+    "DPolicy",
+    "InfoFlow",
+    "Refine",
 
     # Tools and unrelated content, removed for development
     "AutoCorres",
diff --git a/spec/abstract/AARCH64/VCPUAcc_A.thy b/spec/abstract/AARCH64/VCPUAcc_A.thy
index 26b69800fa..7304ee1c94 100644
--- a/spec/abstract/AARCH64/VCPUAcc_A.thy
+++ b/spec/abstract/AARCH64/VCPUAcc_A.thy
@@ -244,21 +244,21 @@ definition vcpu_switch :: "obj_ref option \<Rightarrow> (unit,'z::state_ext) s_m
        cur_v \<leftarrow> gets (arm_current_vcpu \<circ> arch_state);
        (case cur_v of
           None \<Rightarrow> do \<comment> \<open>switch to the new vcpu with no current one\<close>
-            vcpu_restore new;
-            modify (\<lambda>s. s\<lparr> arch_state := (arch_state s)\<lparr> arm_current_vcpu := Some (new, True) \<rparr>\<rparr>)
+            modify (\<lambda>s. s\<lparr> arch_state := (arch_state s)\<lparr> arm_current_vcpu := Some (new, True) \<rparr>\<rparr>);
+            vcpu_restore new
           od
         | Some (vr, active) \<Rightarrow> \<comment> \<open>switch from an existing vcpu\<close>
             (if vr \<noteq> new
             then do \<comment> \<open>different vcpu\<close>
               vcpu_save cur_v;
-              vcpu_restore new;
-              modify (\<lambda>s. s\<lparr> arch_state := (arch_state s)\<lparr> arm_current_vcpu := Some (new, True) \<rparr>\<rparr>)
+              modify (\<lambda>s. s\<lparr> arch_state := (arch_state s)\<lparr> arm_current_vcpu := Some (new, True) \<rparr>\<rparr>);
+              vcpu_restore new
             od
             else \<comment> \<open>same vcpu\<close>
               when (\<not> active) $ do
                 do_machine_op isb;
-                vcpu_enable new;
-                modify (\<lambda>s. s\<lparr> arch_state := (arch_state s)\<lparr> arm_current_vcpu := Some (new, True) \<rparr>\<rparr>)
+                modify (\<lambda>s. s\<lparr> arch_state := (arch_state s)\<lparr> arm_current_vcpu := Some (new, True) \<rparr>\<rparr>);
+                vcpu_enable new
               od))
      od"