From bc5d044e93226e6a94a9febdda2bfbe36cfbf9fd Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Mon, 28 Oct 2024 17:45:35 +1100
Subject: [PATCH 1/7] aspec: refactor det_ext to remove scheduler state

The scheduler is now fully part of the extensible abstract
specification, because we are increasingly finding properties that are
not able to be reasonably specified without it. This means that there is
now no non-deterministic scheduler specification and that the only slots
for non-determinism are now CDT and preemption operations.

This came up due to some properties currently being proved not being
true for all execution paths of the previous non-deterministic
specification. Options that were considered were:
1 - move the minimal state (the current domain and tcb's domain)
required for the properties currently being considered to the extensible
abstract specification.
2 - move all of the scheduler state to the extensible abstract
specification, the same as what has been done on the rt branch.
3 - move all state and remove the non-deterministic specification
completely.
4 - add ghost state to sidestep the specific problem that we are
currently encountering (it is unclear whether this would actually work).

Option 2 was chosen because it is the least blocking (although may be
more annoying than some of the others), will result in the smallest diff
to the rt branch, and we don't think it will be significantly more work
than option 1. If we want to reason about threads in the
future (e.g. liveness), we will require that this information about the
scheduler state is accessible.

We are really not sure about whether moving specifically the scheduler
action is the right decision, but we are moving it across because the
correctness of the ready queues depends on it and any alternatives that
we have thought of would be a lot of work that we do not want to do at
this time.

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 spec/abstract/AARCH64/Init_A.thy  |   9 +
 spec/abstract/Deterministic_A.thy | 487 ++++++++----------------------
 spec/abstract/Interrupt_A.thy     |  12 +-
 spec/abstract/IpcCancel_A.thy     |  14 +-
 spec/abstract/Ipc_A.thy           |  12 +-
 spec/abstract/KHeap_A.thy         | 153 +++++++---
 spec/abstract/Retype_A.thy        |  14 +-
 spec/abstract/Schedule_A.thy      | 126 +++-----
 spec/abstract/Structures_A.thy    |  35 ++-
 spec/abstract/Syscall_A.thy       |   8 +-
 spec/abstract/Tcb_A.thy           |  22 +-
 11 files changed, 371 insertions(+), 521 deletions(-)

diff --git a/spec/abstract/AARCH64/Init_A.thy b/spec/abstract/AARCH64/Init_A.thy
index 9182f606e2..e8cd649fe8 100644
--- a/spec/abstract/AARCH64/Init_A.thy
+++ b/spec/abstract/AARCH64/Init_A.thy
@@ -79,6 +79,9 @@ definition init_kheap :: kheap where
          tcb_fault = None,
          tcb_bound_notification = None,
          tcb_mcpriority = minBound,
+         tcb_priority = 0,
+         tcb_time_slice = timeSlice,
+         tcb_domain = 0,
          tcb_arch = init_arch_tcb
          \<rparr>,
      arm_global_pt_ptr \<mapsto> ArchObj global_pt_obj
@@ -100,6 +103,12 @@ definition init_A_st :: "'z::state_ext state"
     is_original_cap = init_ioc,
     cur_thread = idle_thread_ptr,
     idle_thread = idle_thread_ptr,
+    scheduler_action = resume_cur_thread,
+    domain_list = [(0,15)],
+    domain_index = 0,
+    cur_domain = 0,
+    domain_time = 15,
+    ready_queues = const (const []),
     machine_state = init_machine_state,
     interrupt_irq_node = \<lambda>irq. init_irq_node_ptr + (ucast irq << cte_level_bits),
     interrupt_states = \<lambda>_. IRQInactive,
diff --git a/spec/abstract/Deterministic_A.thy b/spec/abstract/Deterministic_A.thy
index f84aa166b8..81241e8785 100644
--- a/spec/abstract/Deterministic_A.thy
+++ b/spec/abstract/Deterministic_A.thy
@@ -25,7 +25,7 @@ The basic technique, and its motivation, are described in~\cite{Matichuk_Murray_
 
 Here, we define two such instantiations. The first yields a
 largely-deterministic specification by instantiating @{typ "'a"} with
-a record that includes concrete scheduler state and
+a record that includes
 information about sibling ordering in the capability derivation tree (CDT).
 We call the resulting
 specification the \emph{deterministic abstract specification} and it is
@@ -33,8 +33,8 @@ defined below in \autoref{s:det-spec}.
 
 The second instantiation uses the type @{typ unit} for @{typ 'a}, yielding
 a specification that is far more nondeterministic. In particular, the
-scheduling behaviour and the order in which capabilities are deleted during
-a \emph{revoke} system call both become completely nondeterministic.
+order in which capabilities are deleted during
+a \emph{revoke} system call becomes completely nondeterministic.
 We call this second instantiation the
 \emph{nondeterministic abstract specification} and it is defined below in
 \autoref{s:nondet-spec}.
@@ -44,52 +44,54 @@ text \<open>Translate a state of type @{typ "'a state"} to one of type @{typ "'b
   via a function @{term t} from @{typ "'a"} to @{typ "'b"}.
 \<close>
 definition trans_state :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a state \<Rightarrow> 'b state" where
-"trans_state t s = \<lparr>kheap = kheap s, cdt = cdt s, is_original_cap = is_original_cap s,
-                     cur_thread = cur_thread s, idle_thread = idle_thread s,
-                     machine_state = machine_state s,
-                     interrupt_irq_node = interrupt_irq_node s,
-                     interrupt_states = interrupt_states s, arch_state = arch_state s,
-                     exst = t(exst s)\<rparr>"
+  "trans_state t s = abstract_state.extend (abstract_state.truncate s) (state.fields (t (exst s)))"
 
 (*<*)
-lemma trans_state[simp]: "kheap (trans_state t s) = kheap s"
-                            "cdt (trans_state t s) = cdt s"
-                            "is_original_cap (trans_state t s) = is_original_cap s"
-                            "cur_thread (trans_state t s) = cur_thread s"
-                            "idle_thread (trans_state t s) = idle_thread s"
-                            "machine_state (trans_state t s) = machine_state s"
-                            "interrupt_irq_node (trans_state t s) = interrupt_irq_node s"
-                           "interrupt_states (trans_state t s) = interrupt_states s"
-                            "arch_state (trans_state t s) = arch_state s"
-                            "exst (trans_state t s) = (t (exst s))"
-                            "exst (trans_state (\<lambda>_. e) s) = e"
-  apply (simp add: trans_state_def)+
-  done
+lemma trans_state[simp]:
+  "kheap (trans_state t s) = kheap s"
+  "cdt (trans_state t s) = cdt s"
+  "is_original_cap (trans_state t s) = is_original_cap s"
+  "cur_thread (trans_state t s) = cur_thread s"
+  "idle_thread (trans_state t s) = idle_thread s"
+  "machine_state (trans_state t s) = machine_state s"
+  "interrupt_irq_node (trans_state t s) = interrupt_irq_node s"
+  "interrupt_states (trans_state t s) = interrupt_states s"
+  "arch_state (trans_state t s) = arch_state s"
+  "scheduler_action (trans_state t s) = scheduler_action s"
+  "domain_list (trans_state t s) = domain_list s"
+  "domain_index (trans_state t s) = domain_index s"
+  "cur_domain (trans_state t s) = cur_domain s"
+  "domain_time (trans_state t s) = domain_time s"
+  "ready_queues (trans_state t s) = ready_queues s"
+  "exst (trans_state t s) = (t (exst s))"
+  "exst (trans_state (\<lambda>_. e) s) = e"
+  by (simp add: trans_state_def abstract_state.defs state.defs)+
 
 lemma trans_state_update[simp]:
- "trans_state t (kheap_update f s) = kheap_update f (trans_state t s)"
- "trans_state t (cdt_update g s) = cdt_update g (trans_state t s)"
- "trans_state t (is_original_cap_update h s) = is_original_cap_update h (trans_state t s)"
- "trans_state t (cur_thread_update i s) = cur_thread_update i (trans_state t s)"
- "trans_state t (idle_thread_update j s) = idle_thread_update j (trans_state t s)"
- "trans_state t (machine_state_update k s) = machine_state_update k (trans_state t s)"
- "trans_state t (interrupt_irq_node_update l s) = interrupt_irq_node_update l (trans_state t s)"
- "trans_state t (arch_state_update m s) = arch_state_update m (trans_state t s)"
- "trans_state t (interrupt_states_update p s) = interrupt_states_update p (trans_state t s)"
-  apply (simp add: trans_state_def)+
-  done
+  "trans_state t (kheap_update f s) = kheap_update f (trans_state t s)"
+  "trans_state t (cdt_update g s) = cdt_update g (trans_state t s)"
+  "trans_state t (is_original_cap_update h s) = is_original_cap_update h (trans_state t s)"
+  "trans_state t (cur_thread_update i s) = cur_thread_update i (trans_state t s)"
+  "trans_state t (idle_thread_update j s) = idle_thread_update j (trans_state t s)"
+  "trans_state t (machine_state_update k s) = machine_state_update k (trans_state t s)"
+  "trans_state t (interrupt_irq_node_update l s) = interrupt_irq_node_update l (trans_state t s)"
+  "trans_state t (arch_state_update m s) = arch_state_update m (trans_state t s)"
+  "trans_state t (scheduler_action_update b s) = scheduler_action_update b (trans_state t s)"
+  "trans_state t (domain_list_update c s) = domain_list_update c (trans_state t s)"
+  "trans_state t (domain_index_update d s) = domain_index_update d (trans_state t s)"
+  "trans_state t (cur_domain_update e s) = cur_domain_update e (trans_state t s)"
+  "trans_state t (domain_time_update f2 s) = domain_time_update f2 (trans_state t s)"
+  "trans_state t (ready_queues_update g2 s) = ready_queues_update g2 (trans_state t s)"
+  by (simp add: trans_state_def abstract_state.defs)+
 
 
 lemma trans_state_update':
   "trans_state f = exst_update f"
-  apply (rule ext)
-  apply simp
-  done
+  by (rule ext) simp
 
 lemma trans_state_update''[simp]:
   "trans_state t' (trans_state t s) = trans_state (\<lambda>e. t' (t e)) s"
-  apply simp
-  done
+  by simp
 (*>*)
 
 text \<open>Truncate an extended state of type @{typ "'a state"}
@@ -100,33 +102,8 @@ abbreviation "truncate_state \<equiv> trans_state (\<lambda>_. ())"
 section "Deterministic Abstract Specification"
 
 text \<open>\label{s:det-spec}
-  The deterministic abstract specification tracks the state of the scheduler
-and ordering information about sibling nodes in the CDT.\<close>
-
-text \<open>The current scheduler action,
-  which is part of the scheduling state.\<close>
-datatype scheduler_action =
-    resume_cur_thread
-  | switch_thread (sch_act_target : obj_ref)
-  | choose_new_thread
-
-type_synonym domain = word8
-
-record etcb =
- tcb_priority :: "priority"
- tcb_time_slice :: "nat"
- tcb_domain :: "domain"
-
-definition default_priority :: "priority" where
-  "default_priority \<equiv> minBound"
-
-definition default_domain :: "domain" where
-  "default_domain \<equiv> minBound"
-
-definition default_etcb :: "etcb" where
-  "default_etcb \<equiv> \<lparr>tcb_priority = default_priority, tcb_time_slice = timeSlice, tcb_domain = default_domain\<rparr>"
-
-type_synonym ready_queue = "obj_ref list"
+  The deterministic abstract specification tracks
+  ordering information about sibling nodes in the CDT.\<close>
 
 text \<open>
   For each entry in the CDT, we record an ordered list of its children.
@@ -141,13 +118,6 @@ text \<open>
 \<close>
 record det_ext =
    work_units_completed_internal :: "machine_word"
-   scheduler_action_internal :: scheduler_action
-   ekheap_internal :: "obj_ref \<Rightarrow> etcb option"
-   domain_list_internal :: "(domain \<times> machine_word) list"
-   domain_index_internal :: nat
-   cur_domain_internal :: domain
-   domain_time_internal :: "machine_word"
-   ready_queues_internal :: "domain \<Rightarrow> priority \<Rightarrow> ready_queue"
    cdt_list_internal :: cdt_list
 
 text \<open>
@@ -166,189 +136,92 @@ abbreviation
   "work_units_completed_update f (s::det_state) \<equiv>  trans_state (work_units_completed_internal_update f) s"
 
 abbreviation
-  "scheduler_action (s::det_state) \<equiv> scheduler_action_internal (exst s)"
-
-abbreviation
-  "scheduler_action_update f (s::det_state) \<equiv>  trans_state (scheduler_action_internal_update f) s"
-
-abbreviation
-  "ekheap (s::det_state) \<equiv> ekheap_internal (exst s)"
-
-abbreviation
-  "ekheap_update f (s::det_state) \<equiv> trans_state (ekheap_internal_update f) s"
-
-abbreviation
-  "domain_list (s::det_state) \<equiv> domain_list_internal (exst s)"
-
-abbreviation
-  "domain_list_update f (s::det_state) \<equiv> trans_state (domain_list_internal_update f) s"
-
-abbreviation
-  "domain_index (s::det_state) \<equiv> domain_index_internal (exst s)"
+  "cdt_list (s::det_state) \<equiv> cdt_list_internal (exst s)"
 
 abbreviation
-  "domain_index_update f (s::det_state) \<equiv> trans_state (domain_index_internal_update f) s"
+  "cdt_list_update f (s::det_state) \<equiv> trans_state (cdt_list_internal_update f) s"
 
-abbreviation
-  "cur_domain (s::det_state) \<equiv> cur_domain_internal (exst s)"
+type_synonym 'a det_ext_monad = "(det_state,'a) nondet_monad"
 
-abbreviation
-  "cur_domain_update f (s::det_state) \<equiv> trans_state (cur_domain_internal_update f) s"
 
-abbreviation
-  "domain_time (s::det_state) \<equiv> domain_time_internal (exst s)"
+section \<open>Type Class\<close>
 
-abbreviation
-  "domain_time_update f (s::det_state) \<equiv> trans_state (domain_time_internal_update f) s"
+text \<open>
+  A type class for all instantiations of the abstract specification. In
+  practice, this is restricted to basically allow only two sensible
+  implementations at present: the deterministic abstract specification and
+  the nondeterministic one.
+\<close>
+class state_ext =
+ fixes unwrap_ext :: "'a state \<Rightarrow> det_ext state"
+ fixes wrap_ext :: "(det_ext \<Rightarrow> det_ext) \<Rightarrow> ('a \<Rightarrow> 'a)"
+ fixes wrap_ext_op :: "unit det_ext_monad \<Rightarrow> ('a state,unit) nondet_monad"
+ fixes wrap_ext_bool :: "bool det_ext_monad \<Rightarrow> ('a state,bool) nondet_monad"
+ fixes select_switch :: "'a \<Rightarrow> bool"
+ fixes ext_init :: "'a"
 
-abbreviation
-  "ready_queues (s::det_state) \<equiv> ready_queues_internal (exst s)"
 
-abbreviation
-  "ready_queues_update f (s::det_state) \<equiv> trans_state (ready_queues_internal_update f) s"
+section \<open>Type Class Instances\<close>
 
-abbreviation
-  "cdt_list (s::det_state) \<equiv> cdt_list_internal (exst s)"
+subsection "Deterministic Abstract Specification"
 
-abbreviation
-  "cdt_list_update f (s::det_state) \<equiv> trans_state (cdt_list_internal_update f) s"
+instantiation  det_ext_ext :: (type) state_ext
+begin
 
-type_synonym 'a det_ext_monad = "(det_state,'a) nondet_monad"
+definition "unwrap_ext_det_ext_ext == (\<lambda>x. x) :: det_ext state \<Rightarrow> det_ext state"
 
-text \<open>
-  Basic monadic functions for operating on the extended state of the
-  deterministic abstract specification.
-\<close>
-definition
-  get_etcb :: "obj_ref \<Rightarrow> det_state \<Rightarrow> etcb option"
-where
-  "get_etcb tcb_ref es \<equiv> ekheap es tcb_ref"
+definition "wrap_ext_det_ext_ext == (\<lambda>x. x) ::
+  (det_ext \<Rightarrow> det_ext) \<Rightarrow> det_ext \<Rightarrow> det_ext"
 
-definition
-  ethread_get :: "(etcb \<Rightarrow> 'a) \<Rightarrow> obj_ref \<Rightarrow> 'a det_ext_monad"
-where
-  "ethread_get f tptr \<equiv> do
-     tcb \<leftarrow> gets_the $ get_etcb tptr;
-     return $ f tcb
-   od"
+definition "wrap_ext_op_det_ext_ext == (\<lambda>x. x) ::
+  (det_ext state \<Rightarrow> ((unit \<times> det_ext state) set) \<times> bool)
+  \<Rightarrow> det_ext state  \<Rightarrow> ((unit \<times> det_ext state) set) \<times> bool"
 
-(* For infoflow, we want to avoid certain read actions, such as reading the priority of the
-   current thread when it could be idle. Then we need to make sure we do not rely on the result.
-   undefined is the closest we have to a result that can't be relied on *)
-definition
-  ethread_get_when :: "bool \<Rightarrow> (etcb \<Rightarrow> 'a) \<Rightarrow> obj_ref \<Rightarrow> 'a det_ext_monad"
-where
-  "ethread_get_when b f tptr \<equiv> if b then (ethread_get f tptr) else return undefined"
-
-definition set_eobject :: "obj_ref \<Rightarrow> etcb \<Rightarrow> unit det_ext_monad"
-  where
- "set_eobject ptr obj \<equiv>
-  do es \<leftarrow> get;
-    ekh \<leftarrow> return $ (ekheap es)(ptr \<mapsto> obj);
-    put (es\<lparr>ekheap := ekh\<rparr>)
-  od"
+definition "wrap_ext_bool_det_ext_ext == (\<lambda>x. x) ::
+  (det_ext state \<Rightarrow> ((bool \<times> det_ext state) set) \<times> bool)
+  \<Rightarrow> det_ext state \<Rightarrow> ((bool \<times> det_ext state) set) \<times> bool"
 
-definition
-  ethread_set :: "(etcb \<Rightarrow> etcb) \<Rightarrow> obj_ref \<Rightarrow> unit det_ext_monad"
-where
-  "ethread_set f tptr \<equiv> do
-     tcb \<leftarrow> gets_the $ get_etcb tptr;
-     set_eobject tptr $ f tcb
-   od"
+definition "select_switch_det_ext_ext == (\<lambda>_. True)  :: det_ext\<Rightarrow> bool"
 
-definition
-  set_scheduler_action :: "scheduler_action \<Rightarrow> unit det_ext_monad" where
-  "set_scheduler_action action \<equiv>
-     modify (\<lambda>es. es\<lparr>scheduler_action := action\<rparr>)"
+definition "ext_init_det_ext_ext \<equiv>
+     \<lparr>work_units_completed_internal = 0,
+      cdt_list_internal = const [] \<rparr> :: det_ext"
 
-definition
-  thread_set_priority :: "obj_ref \<Rightarrow> priority \<Rightarrow> unit det_ext_monad" where
-  "thread_set_priority tptr prio \<equiv> ethread_set (\<lambda>tcb. tcb\<lparr>tcb_priority := prio\<rparr>) tptr"
+instance ..
 
-definition
-  thread_set_time_slice :: "obj_ref \<Rightarrow> nat \<Rightarrow> unit det_ext_monad" where
-  "thread_set_time_slice tptr time \<equiv> ethread_set (\<lambda>tcb. tcb\<lparr>tcb_time_slice := time\<rparr>) tptr"
+end
 
-definition
-  thread_set_domain :: "obj_ref \<Rightarrow> domain \<Rightarrow> unit det_ext_monad" where
-  "thread_set_domain tptr domain \<equiv> ethread_set (\<lambda>tcb. tcb\<lparr>tcb_domain := domain\<rparr>) tptr"
+subsection "Nondeterministic Abstract Specification"
 
+text \<open>\label{s:nondet-spec}
+The nondeterministic abstract specification instantiates the extended state
+with the unit type -- i.e. it doesn't have any meaningful extended state.
+\<close>
 
-definition
-  get_tcb_queue :: "domain \<Rightarrow> priority \<Rightarrow> ready_queue det_ext_monad" where
-  "get_tcb_queue d prio \<equiv> do
-     queues \<leftarrow> gets ready_queues;
-     return (queues d prio)
-   od"
+instantiation unit :: state_ext
+begin
 
-definition
-  set_tcb_queue :: "domain \<Rightarrow> priority \<Rightarrow> ready_queue \<Rightarrow> unit det_ext_monad" where
-  "set_tcb_queue d prio queue \<equiv>
-     modify (\<lambda>es. es\<lparr> ready_queues :=
-      (\<lambda>d' p. if d' = d \<and> p = prio then queue else ready_queues es d' p)\<rparr>)"
+definition "unwrap_ext_unit == (\<lambda>_. undefined) :: unit state \<Rightarrow> det_ext state"
 
+definition "wrap_ext_unit == (\<lambda>f s. ()) :: (det_ext \<Rightarrow> det_ext) \<Rightarrow> unit \<Rightarrow> unit"
 
-definition
-  tcb_sched_action :: "(obj_ref \<Rightarrow> obj_ref list \<Rightarrow> obj_ref list) \<Rightarrow> obj_ref  \<Rightarrow> unit det_ext_monad" where
-  "tcb_sched_action action thread \<equiv> do
-     d \<leftarrow> ethread_get tcb_domain thread;
-     prio \<leftarrow> ethread_get tcb_priority thread;
-     queue \<leftarrow> get_tcb_queue d prio;
-     set_tcb_queue d prio (action thread queue)
-   od"
 
-definition
-  tcb_sched_enqueue :: "obj_ref \<Rightarrow> obj_ref list \<Rightarrow> obj_ref list" where
-  "tcb_sched_enqueue thread queue \<equiv> if (thread \<notin> set queue) then thread # queue else queue"
+definition "wrap_ext_op_unit == (\<lambda>m. return ()) ::
+  (det_ext state \<Rightarrow> ((unit \<times> det_ext state) set) \<times> bool) \<Rightarrow> unit state \<Rightarrow> ((unit \<times> unit state) set) \<times> bool"
 
-definition
-  tcb_sched_append :: "obj_ref \<Rightarrow> obj_ref list \<Rightarrow> obj_ref list" where
-  "tcb_sched_append thread queue \<equiv> if (thread \<notin> set queue) then queue @ [thread] else queue"
+definition "wrap_ext_bool_unit == (\<lambda>m. select UNIV) ::
+  (det_ext state \<Rightarrow> ((bool \<times> det_ext state ) set) \<times> bool) \<Rightarrow> unit state \<Rightarrow> ((bool \<times> unit state) set) \<times> bool"
 
-definition
-  tcb_sched_dequeue :: "obj_ref \<Rightarrow> obj_ref list \<Rightarrow> obj_ref list" where
-  "tcb_sched_dequeue thread queue \<equiv> filter (\<lambda>x. x \<noteq> thread) queue"
+definition "select_switch_unit == (\<lambda>s. False) :: unit \<Rightarrow> bool"
 
+definition "ext_init_unit \<equiv> () :: unit"
 
-definition reschedule_required :: "unit det_ext_monad" where
-  "reschedule_required \<equiv> do
-     action \<leftarrow> gets scheduler_action;
-     case action of switch_thread t \<Rightarrow> tcb_sched_action (tcb_sched_enqueue) t | _ \<Rightarrow> return ();
-     set_scheduler_action choose_new_thread
-   od"
+instance ..
 
-definition
-  possible_switch_to :: "obj_ref \<Rightarrow> unit det_ext_monad" where
-  "possible_switch_to target \<equiv> do
-     cur_dom \<leftarrow> gets cur_domain;
-     target_dom \<leftarrow> ethread_get tcb_domain target;
-     action \<leftarrow> gets scheduler_action;
-
-     if (target_dom \<noteq> cur_dom) then
-       tcb_sched_action tcb_sched_enqueue target
-     else if (action \<noteq> resume_cur_thread) then
-       do
-         reschedule_required;
-         tcb_sched_action tcb_sched_enqueue target
-       od
-     else
-       set_scheduler_action $ switch_thread target
-   od"
+end
 
-definition
-  next_domain :: "unit det_ext_monad" where
-  "next_domain \<equiv>
-    modify (\<lambda>s.
-      let domain_index' = (domain_index s + 1) mod length (domain_list s) in
-      let next_dom = (domain_list s)!domain_index'
-      in s\<lparr> domain_index := domain_index',
-            cur_domain := fst next_dom,
-            domain_time := snd next_dom,
-            work_units_completed := 0\<rparr>)"
 
-definition
-  dec_domain_time :: "unit det_ext_monad" where
-  "dec_domain_time = modify (\<lambda>s. s\<lparr>domain_time := domain_time s - 1\<rparr>)"
+section \<open>Basic Deterministic Monadic Accessors\<close>
 
 definition set_cdt_list :: "cdt_list \<Rightarrow> (det_state, unit) nondet_monad" where
   "set_cdt_list t \<equiv> do
@@ -369,9 +242,9 @@ text \<open>The CDT in the implementation is stored in prefix traversal order.
   The following functions traverse its abstract representation here to
   yield corresponding information.
 \<close>
+(* FIXME: use Lib.hd_opt instead *)
 definition next_child :: "cslot_ptr \<Rightarrow> cdt_list \<Rightarrow> cslot_ptr option" where
-  "next_child slot t \<equiv> case (t slot) of [] \<Rightarrow> None |
-                                        x # xs \<Rightarrow> Some x"
+  "next_child slot t \<equiv> case t slot of [] \<Rightarrow> None | x # xs \<Rightarrow> Some x"
 
 definition next_sib :: "cslot_ptr \<Rightarrow> cdt_list \<Rightarrow> cdt \<Rightarrow> cslot_ptr option" where
   "next_sib slot t m \<equiv> case m slot of None \<Rightarrow> None |
@@ -380,10 +253,10 @@ definition next_sib :: "cslot_ptr \<Rightarrow> cdt_list \<Rightarrow> cdt \<Rig
 
 function (domintros) next_not_child :: "cslot_ptr \<Rightarrow> cdt_list \<Rightarrow> cdt \<Rightarrow> cslot_ptr option" where
   "next_not_child slot t m = (if next_sib slot t m = None
-                             then (case m slot of
-                               None \<Rightarrow> None |
-                               Some p \<Rightarrow> next_not_child p t m)
-                             else next_sib slot t m)"
+                              then case m slot of
+                                      None \<Rightarrow> None
+                                    | Some p \<Rightarrow> next_not_child p t m
+                              else next_sib slot t m)"
   by auto
 
 (* next_slot traverses the cdt, replicating mdb_next in the Haskell spec.
@@ -397,24 +270,8 @@ definition next_slot :: "cslot_ptr \<Rightarrow> cdt_list \<Rightarrow> cdt \<Ri
                         then next_child slot t
                         else next_not_child slot t m"
 
-text \<open>\emph{Extended operations} for the deterministic abstract specification.\<close>
-
-definition max_non_empty_queue :: "(priority \<Rightarrow> ready_queue) \<Rightarrow> ready_queue" where
-  "max_non_empty_queue queues \<equiv> queues (Max {prio. queues prio \<noteq> []})"
-
-
-definition default_ext :: "apiobject_type \<Rightarrow> domain \<Rightarrow> etcb option" where
-  "default_ext type cdom \<equiv>
-      case type of TCBObject \<Rightarrow> Some (default_etcb\<lparr>tcb_domain := cdom\<rparr>)
-                         | _ \<Rightarrow> None"
 
-definition retype_region_ext :: "obj_ref list \<Rightarrow> apiobject_type \<Rightarrow> unit det_ext_monad" where
-  "retype_region_ext ptrs type \<equiv>  do
-                                     ekh \<leftarrow> gets ekheap;
-                                     cdom \<leftarrow> gets cur_domain;
-                                     ekh' \<leftarrow> return $ foldr (\<lambda>p ekh. (ekh(p := default_ext type cdom))) ptrs ekh;
-                                     modify (\<lambda>s. s\<lparr>ekheap := ekh'\<rparr>)
-                                  od"
+text \<open>\emph{Extended operations} for the deterministic abstract specification.\<close>
 
 definition cap_swap_ext where
 "cap_swap_ext \<equiv> (\<lambda> slot1 slot2 slot1_op slot2_op.
@@ -442,44 +299,44 @@ definition cap_move_ext where
 "cap_move_ext \<equiv> (\<lambda> src_slot dest_slot src_p dest_p.
  do
 
-    update_cdt_list (\<lambda>list. case (dest_p) of
+    update_cdt_list (\<lambda>list. case dest_p of
       None \<Rightarrow> list |
       Some p \<Rightarrow> list (p := list_remove (list p) dest_slot));
 
-   if (src_slot = dest_slot) then return () else
+   if src_slot = dest_slot then return () else
 
     (do
-    update_cdt_list (\<lambda>list. case (src_p) of
+    update_cdt_list (\<lambda>list. case src_p of
       None \<Rightarrow> list |
       Some p \<Rightarrow> list (p := list_replace (list p) src_slot dest_slot));
 
-    update_cdt_list (\<lambda>list. list (src_slot := [], dest_slot := (list src_slot) @ (list dest_slot)))
+    update_cdt_list (\<lambda>list. list (src_slot := [], dest_slot := list src_slot @ list dest_slot))
     od)
 
   od)"
 
 
 definition cap_insert_ext where
-"cap_insert_ext \<equiv> (\<lambda> src_parent src_slot dest_slot src_p dest_p.
- do
-
- update_cdt_list (\<lambda>list. case (dest_p) of
-      None \<Rightarrow> list |
-      Some p \<Rightarrow> (list (p := list_remove (list p) dest_slot)));
-
-    update_cdt_list (\<lambda>list. case (src_p) of
-      None \<Rightarrow> list (
-        src_slot := if src_parent then [dest_slot] @ (list src_slot) else list src_slot) |
-      Some p \<Rightarrow> list (
-        src_slot := if src_parent then [dest_slot] @ (list src_slot) else list src_slot,
-        p := if (src_parent \<and> p \<noteq> src_slot) then (list p) else if (src_slot \<noteq> dest_slot) then (list_insert_after (list p) src_slot dest_slot) else (dest_slot # (list p))))
- od)"
+  "cap_insert_ext \<equiv> \<lambda>src_parent src_slot dest_slot src_p dest_p. do
+     update_cdt_list (\<lambda>list. case dest_p of
+       None \<Rightarrow> list
+     | Some p \<Rightarrow> list (p := list_remove (list p) dest_slot));
+     update_cdt_list (\<lambda>list. case src_p of
+       None \<Rightarrow> list (src_slot := if src_parent then [dest_slot] @ list src_slot else list src_slot)
+     | Some p \<Rightarrow> list (src_slot := if src_parent then [dest_slot] @ list src_slot else list src_slot,
+                       p := if src_parent \<and> p \<noteq> src_slot
+                            then list p
+                            else if src_slot \<noteq> dest_slot
+                                 then list_insert_after (list p) src_slot dest_slot
+                                 else dest_slot # list p))
+   od"
 
 definition empty_slot_ext where
-"empty_slot_ext \<equiv> (\<lambda> slot slot_p.
-
+"empty_slot_ext \<equiv> \<lambda> slot slot_p.
     update_cdt_list (\<lambda>list. case slot_p of None \<Rightarrow> list (slot := []) |
-      Some p \<Rightarrow> if (p = slot) then list(p := list_remove (list p) slot) else list (p := list_replace_list (list p) slot (list slot), slot := [])))"
+      Some p \<Rightarrow> if p = slot
+                then list(p := list_remove (list p) slot)
+                else list (p := list_replace_list (list p) slot (list slot), slot := []))"
 
 definition create_cap_ext where
 "create_cap_ext \<equiv> (\<lambda> untyped dest dest_p. do
@@ -519,86 +376,6 @@ definition work_units_limit_reached where
      return (work_units_limit \<le> work_units)
    od"
 
-text \<open>
-  A type class for all instantiations of the abstract specification. In
-  practice, this is restricted to basically allow only two sensible
-  implementations at present: the deterministic abstract specification and
-  the nondeterministic one.
-\<close>
-class state_ext =
- fixes unwrap_ext :: "'a state \<Rightarrow> det_ext state"
- fixes wrap_ext :: "(det_ext \<Rightarrow> det_ext) \<Rightarrow> ('a \<Rightarrow> 'a)"
- fixes wrap_ext_op :: "unit det_ext_monad \<Rightarrow> ('a state,unit) nondet_monad"
- fixes wrap_ext_bool :: "bool det_ext_monad \<Rightarrow> ('a state,bool) nondet_monad"
- fixes select_switch :: "'a \<Rightarrow> bool"
- fixes ext_init :: "'a"
-
-definition detype_ext :: "obj_ref set \<Rightarrow> 'z::state_ext \<Rightarrow> 'z" where
- "detype_ext S \<equiv> wrap_ext (\<lambda>s. s\<lparr>ekheap_internal := (\<lambda>x. if x \<in> S then None else ekheap_internal s x)\<rparr>)"
-
-instantiation  det_ext_ext :: (type) state_ext
-begin
-
-definition "unwrap_ext_det_ext_ext == (\<lambda>x. x) :: det_ext state \<Rightarrow> det_ext state"
-
-definition "wrap_ext_det_ext_ext == (\<lambda>x. x) ::
-  (det_ext \<Rightarrow> det_ext) \<Rightarrow> det_ext \<Rightarrow> det_ext"
-
-definition "wrap_ext_op_det_ext_ext == (\<lambda>x. x) ::
-  (det_ext state \<Rightarrow> ((unit \<times> det_ext state) set) \<times> bool)
-  \<Rightarrow> det_ext state  \<Rightarrow> ((unit \<times> det_ext state) set) \<times> bool"
-
-definition "wrap_ext_bool_det_ext_ext == (\<lambda>x. x) ::
-  (det_ext state \<Rightarrow> ((bool \<times> det_ext state) set) \<times> bool)
-  \<Rightarrow> det_ext state \<Rightarrow> ((bool \<times> det_ext state) set) \<times> bool"
-
-definition "select_switch_det_ext_ext == (\<lambda>_. True)  :: det_ext\<Rightarrow> bool"
-
-(* this probably doesn't satisfy the invariants *)
-definition "ext_init_det_ext_ext \<equiv>
-     \<lparr>work_units_completed_internal = 0,
-      scheduler_action_internal = resume_cur_thread,
-      ekheap_internal = Map.empty (idle_thread_ptr \<mapsto> default_etcb),
-      domain_list_internal = [(0,15)],
-      domain_index_internal = 0,
-      cur_domain_internal = 0,
-      domain_time_internal = 15,
-      ready_queues_internal = const (const []),
-      cdt_list_internal = const []\<rparr> :: det_ext"
-
-instance ..
-
-end
-
-section "Nondeterministic Abstract Specification"
-
-text \<open>\label{s:nondet-spec}
-The nondeterministic abstract specification instantiates the extended state
-with the unit type -- i.e. it doesn't have any meaningful extended state.
-\<close>
-
-instantiation unit :: state_ext
-begin
-
-
-definition "unwrap_ext_unit == (\<lambda>_. undefined) :: unit state \<Rightarrow> det_ext state"
-
-definition "wrap_ext_unit == (\<lambda>f s. ()) :: (det_ext \<Rightarrow> det_ext) \<Rightarrow> unit \<Rightarrow> unit"
-
-
-definition "wrap_ext_op_unit == (\<lambda>m. return ()) ::
-  (det_ext state \<Rightarrow> ((unit \<times> det_ext state) set) \<times> bool) \<Rightarrow> unit state \<Rightarrow> ((unit \<times> unit state) set) \<times> bool"
-
-definition "wrap_ext_bool_unit == (\<lambda>m. select UNIV) ::
-  (det_ext state \<Rightarrow> ((bool \<times> det_ext state ) set) \<times> bool) \<Rightarrow> unit state \<Rightarrow> ((bool \<times> unit state) set) \<times> bool"
-
-definition "select_switch_unit == (\<lambda>s. False) :: unit \<Rightarrow> bool"
-
-definition "ext_init_unit \<equiv> () :: unit"
-
-instance ..
-
-end
 
 text \<open>Run an extended operation over the extended state without
   modifying it and use the return value to choose between two computations
@@ -638,14 +415,16 @@ text \<open>
   Use the extended state to choose a value from a bounding set @{term S} when
   @{term select_switch} is true. Otherwise just select from @{term S}.
 \<close>
-definition select_ext :: "(det_ext state \<Rightarrow> 'd) \<Rightarrow> ('d set) \<Rightarrow> ('a::state_ext state,'d) nondet_monad" where
+definition select_ext ::
+  "(det_ext state \<Rightarrow> 'd) \<Rightarrow> 'd set \<Rightarrow> ('a::state_ext state,'d) nondet_monad" where
   "select_ext a S \<equiv> do
-                      s \<leftarrow> get;
-                      x \<leftarrow> if (select_switch (exst s)) then (return (a (unwrap_ext s)))
-                          else (select S);
-                      assert (x \<in> S);
-                      return x
-                    od"
+     s \<leftarrow> get;
+     x \<leftarrow> if select_switch (exst s)
+          then return (a (unwrap_ext s))
+          else select S;
+     assert (x \<in> S);
+     return x
+   od"
 
 (*Defined here because it's asserted before empty_slot*)
 definition valid_list_2 :: "cdt_list \<Rightarrow> cdt \<Rightarrow> bool" where
diff --git a/spec/abstract/Interrupt_A.thy b/spec/abstract/Interrupt_A.thy
index 082c55869e..23515d177d 100644
--- a/spec/abstract/Interrupt_A.thy
+++ b/spec/abstract/Interrupt_A.thy
@@ -56,12 +56,12 @@ included in this model, so no scheduling action needs to be taken on timer
 ticks. If the IRQ has a valid Notification cap loaded a message is
 delivered.\<close>
 
-definition timer_tick :: "unit det_ext_monad" where
+definition timer_tick :: "(unit, 'z::state_ext) s_monad" where
   "timer_tick \<equiv> do
      cur \<leftarrow> gets cur_thread;
      state \<leftarrow> get_thread_state cur;
      case state of Running \<Rightarrow> do
-       ts \<leftarrow> ethread_get tcb_time_slice cur;
+       ts \<leftarrow> thread_get tcb_time_slice cur;
        let ts' = ts - 1 in
        if (ts' > 0) then thread_set_time_slice cur ts' else do
          thread_set_time_slice cur timeSlice;
@@ -78,12 +78,12 @@ definition timer_tick :: "unit det_ext_monad" where
    od"
 
 definition
-  handle_interrupt :: "irq \<Rightarrow> (unit,'z::state_ext) s_monad" where
+  handle_interrupt :: "irq \<Rightarrow> (unit, 'z::state_ext) s_monad" where
  "handle_interrupt irq \<equiv>
    if irq > maxIRQ then do_machine_op $ do
     maskInterrupt True irq;
     ackInterrupt irq
-    od
+   od
   else do
    st \<leftarrow> get_irq_state irq;
    case st of
@@ -95,12 +95,12 @@ definition
        arch_mask_irq_signal irq
      od
    | IRQTimer \<Rightarrow> do
-       do_extended_op timer_tick;
+       timer_tick;
        do_machine_op resetTimer
      od
    | IRQInactive \<Rightarrow> fail \<comment> \<open>not meant to be able to get IRQs from inactive lines\<close>
    | IRQReserved \<Rightarrow> handle_reserved_irq irq;
    do_machine_op $ ackInterrupt irq
-   od"
+  od"
 
 end
diff --git a/spec/abstract/IpcCancel_A.thy b/spec/abstract/IpcCancel_A.thy
index f33ff6867c..4607ef52d9 100644
--- a/spec/abstract/IpcCancel_A.thy
+++ b/spec/abstract/IpcCancel_A.thy
@@ -55,8 +55,8 @@ where
                         queue \<leftarrow> get_ep_queue ep;
                         set_endpoint epptr IdleEP;
                         mapM_x (\<lambda>t. do set_thread_state t Restart;
-                                       do_extended_op (tcb_sched_action (tcb_sched_enqueue) t) od) $ queue;
-                        do_extended_op (reschedule_required)
+                                       tcb_sched_action (tcb_sched_enqueue) t od) $ queue;
+                        reschedule_required
                      od
    od"
 
@@ -82,7 +82,7 @@ where
                 st \<leftarrow> get_thread_state t;
                 if blocking_ipc_badge st = badge then do
                   set_thread_state t Restart;
-                  do_extended_op (tcb_sched_action (tcb_sched_enqueue) t);
+                  tcb_sched_action (tcb_sched_enqueue) t;
                   return False od
                 else return True
             od);
@@ -90,7 +90,7 @@ where
                            [] \<Rightarrow> IdleEP
                          | _ \<Rightarrow> SendEP queue');
             set_endpoint epptr ep';
-            do_extended_op (reschedule_required)
+            reschedule_required
         od
   od"
 
@@ -137,8 +137,8 @@ where
      case ntfn_obj ntfn of WaitingNtfn queue \<Rightarrow> do
                       _ \<leftarrow> set_notification ntfnptr $ ntfn_set_obj ntfn IdleNtfn;
                       mapM_x (\<lambda>t. do set_thread_state t Restart;
-                                     do_extended_op (tcb_sched_action tcb_sched_enqueue t) od) queue;
-                      do_extended_op (reschedule_required)
+                                     tcb_sched_action tcb_sched_enqueue t od) queue;
+                      reschedule_required
                      od
                | _ \<Rightarrow> return ()
    od"
@@ -372,7 +372,7 @@ where
      state \<leftarrow> get_thread_state thread;
      (if state = Running then update_restart_pc thread else return ());
      set_thread_state thread Inactive;
-     do_extended_op (tcb_sched_action (tcb_sched_dequeue) thread)
+     tcb_sched_action (tcb_sched_dequeue) thread
    od"
 
 end
diff --git a/spec/abstract/Ipc_A.thy b/spec/abstract/Ipc_A.thy
index 6ba07151dd..c90e98fc97 100644
--- a/spec/abstract/Ipc_A.thy
+++ b/spec/abstract/Ipc_A.thy
@@ -251,7 +251,7 @@ where
          do_ipc_transfer sender None 0 grant receiver;
          cap_delete_one slot;
          set_thread_state receiver Running;
-         do_extended_op (possible_switch_to receiver)
+         possible_switch_to receiver
       od
     | Some f \<Rightarrow> do
          cap_delete_one slot;
@@ -261,7 +261,7 @@ where
          restart \<leftarrow> handle_fault_reply f receiver (mi_label mi) mrs;
          thread_set (\<lambda>tcb. tcb \<lparr> tcb_fault := None \<rparr>) receiver;
          set_thread_state receiver (if restart then Restart else Inactive);
-         when restart $ do_extended_op (possible_switch_to receiver);
+         when restart $ possible_switch_to receiver;
          return ()
        od
   od"
@@ -330,7 +330,7 @@ where
                            od
                   | _ \<Rightarrow> fail;
                 set_thread_state dest Running;
-                do_extended_op (possible_switch_to dest);
+                possible_switch_to dest;
                 when call $
                   if (can_grant \<or> can_grant_reply)
                   then setup_caller_cap thread dest reply_can_grant
@@ -420,7 +420,7 @@ where
                 else set_thread_state sender Inactive
               else do
                 set_thread_state sender Running;
-                do_extended_op (possible_switch_to sender)
+                possible_switch_to sender
               od
             od
    od"
@@ -441,7 +441,7 @@ where
          ntfn_bound_tcb = bound_tcb \<rparr>;
      set_thread_state dest Running;
      as_user dest $ setRegister badge_register badge;
-     do_extended_op (possible_switch_to dest)
+     possible_switch_to dest
 
    od"
 
@@ -470,7 +470,7 @@ where
                       cancel_ipc tcb;
                       set_thread_state tcb Running;
                       as_user tcb $ setRegister badge_register badge;
-                      do_extended_op (possible_switch_to tcb)
+                      possible_switch_to tcb
                     od
                   else set_notification ntfnptr $ ntfn_set_obj ntfn (ActiveNtfn badge)
             od
diff --git a/spec/abstract/KHeap_A.thy b/spec/abstract/KHeap_A.thy
index 3d9a4542e1..f4647f53b8 100644
--- a/spec/abstract/KHeap_A.thy
+++ b/spec/abstract/KHeap_A.thy
@@ -101,39 +101,6 @@ where
      set_object ref (TCB (tcb \<lparr> tcb_bound_notification := ntfn \<rparr>))
    od"
 
-definition set_thread_state_ext :: "obj_ref \<Rightarrow> unit det_ext_monad" where
-  "set_thread_state_ext t \<equiv> do
-     ts \<leftarrow> get_thread_state t;
-     cur \<leftarrow> gets cur_thread;
-     action \<leftarrow> gets scheduler_action;
-     when (\<not> (runnable ts) \<and> cur = t \<and> action = resume_cur_thread) (set_scheduler_action choose_new_thread)
-   od"
-
-definition
-  set_thread_state :: "obj_ref \<Rightarrow> thread_state \<Rightarrow> (unit,'z::state_ext) s_monad"
-where
-  "set_thread_state ref ts \<equiv> do
-     tcb \<leftarrow> gets_the $ get_tcb ref;
-     set_object ref (TCB (tcb \<lparr> tcb_state := ts \<rparr>));
-     do_extended_op (set_thread_state_ext ref)
-   od"
-
-definition
-  set_priority :: "obj_ref \<Rightarrow> priority \<Rightarrow> unit det_ext_monad" where
-  "set_priority tptr prio \<equiv> do
-     tcb_sched_action tcb_sched_dequeue tptr;
-     thread_set_priority tptr prio;
-     ts \<leftarrow> get_thread_state tptr;
-     when (runnable ts) $ do
-       cur \<leftarrow> gets cur_thread;
-       if tptr = cur then reschedule_required else possible_switch_to tptr
-     od
-   od"
-
-definition
-  set_mcpriority :: "obj_ref \<Rightarrow> priority \<Rightarrow> (unit, 'z::state_ext) s_monad"  where
-  "set_mcpriority ref mcp \<equiv> thread_set (\<lambda>tcb. tcb\<lparr>tcb_mcpriority:=mcp\<rparr>) ref "
-
 
 section "simple kernel objects"
 (* to be used for abstraction unifying kernel objects other than TCB and CNode *)
@@ -158,10 +125,11 @@ lemma proj_ko_type_ntfn[simp]:
   "(\<exists>v. partial_inv Notification  ko = Some (v::notification)) = (a_type ko = ANTFN)"
   by (cases ko; auto simp: partial_inv_def a_type_def)
 
-
 abbreviation
   "is_simple_type \<equiv> (\<lambda>ob. a_type ob \<in> {AEndpoint, ANTFN})"
 
+section "getters/setters for simple kernel objects"
+(* to be used for abstraction unifying kernel objects other than TCB and CNode*)
 
 definition
   get_simple_ko :: "('a \<Rightarrow> kernel_object) \<Rightarrow> obj_ref \<Rightarrow> ('a,'z::state_ext) s_monad"
@@ -184,7 +152,6 @@ where
    od"
 
 
-
 section \<open>Synchronous and Asyncronous Endpoints\<close>
 
 
@@ -235,6 +202,122 @@ definition
   is_irq_active :: "irq \<Rightarrow> (bool,'z::state_ext) s_monad" where
  "is_irq_active irq \<equiv> liftM (\<lambda>st. st \<noteq> IRQInactive) $ get_irq_state irq"
 
+
+definition
+  get_tcb_queue :: "domain \<Rightarrow> priority \<Rightarrow> (ready_queue, 'z::state_ext) s_monad" where
+  "get_tcb_queue d prio \<equiv> do
+     queues \<leftarrow> gets ready_queues;
+     return (queues d prio)
+   od"
+
+definition
+  set_tcb_queue :: "domain \<Rightarrow> priority \<Rightarrow> ready_queue \<Rightarrow> (unit, 'z::state_ext) s_monad" where
+  "set_tcb_queue d prio queue \<equiv>
+     modify (\<lambda>es. es\<lparr> ready_queues :=
+      (\<lambda>d' p. if d' = d \<and> p = prio then queue else ready_queues es d' p)\<rparr>)"
+
+definition
+  tcb_sched_action :: "(obj_ref \<Rightarrow> obj_ref list \<Rightarrow> obj_ref list) \<Rightarrow> obj_ref
+                        \<Rightarrow> (unit, 'z::state_ext) s_monad"
+where
+  "tcb_sched_action action thread \<equiv> do
+     d \<leftarrow> thread_get tcb_domain thread;
+     prio \<leftarrow> thread_get tcb_priority thread;
+     queue \<leftarrow> get_tcb_queue d prio;
+     set_tcb_queue d prio (action thread queue)
+   od"
+
+definition
+  tcb_sched_enqueue :: "obj_ref \<Rightarrow> obj_ref list \<Rightarrow> obj_ref list" where
+  "tcb_sched_enqueue thread queue \<equiv> if thread \<notin> set queue then thread # queue else queue"
+
+definition
+  tcb_sched_append :: "obj_ref \<Rightarrow> obj_ref list \<Rightarrow> obj_ref list" where
+  "tcb_sched_append thread queue \<equiv> if thread \<notin> set queue then queue @ [thread] else queue"
+
+definition
+  tcb_sched_dequeue :: "obj_ref \<Rightarrow> obj_ref list \<Rightarrow> obj_ref list" where
+  "tcb_sched_dequeue thread queue \<equiv> filter ((\<noteq>) thread) queue"
+
+definition
+  set_scheduler_action :: "scheduler_action \<Rightarrow> (unit, 'z::state_ext) s_monad" where
+  "set_scheduler_action action \<equiv>
+     modify (\<lambda>es. es\<lparr>scheduler_action := action\<rparr>)"
+
+definition
+  thread_set_priority :: "obj_ref \<Rightarrow> priority \<Rightarrow> (unit, 'z::state_ext) s_monad" where
+  "thread_set_priority tptr prio \<equiv> thread_set (\<lambda>tcb. tcb\<lparr>tcb_priority := prio\<rparr>) tptr"
+
+definition
+  thread_set_time_slice :: "obj_ref \<Rightarrow> nat \<Rightarrow> (unit, 'z::state_ext) s_monad" where
+  "thread_set_time_slice tptr time \<equiv> thread_set (\<lambda>tcb. tcb\<lparr>tcb_time_slice := time\<rparr>) tptr"
+
+definition
+  thread_set_domain :: "obj_ref \<Rightarrow> domain \<Rightarrow> (unit, 'z::state_ext) s_monad" where
+  "thread_set_domain tptr domain \<equiv> thread_set (\<lambda>tcb. tcb\<lparr>tcb_domain := domain\<rparr>) tptr"
+
+definition reschedule_required :: "(unit, 'z::state_ext) s_monad" where
+  "reschedule_required \<equiv> do
+     action \<leftarrow> gets scheduler_action;
+     case action of
+       switch_thread t \<Rightarrow> tcb_sched_action (tcb_sched_enqueue) t | _ \<Rightarrow> return ();
+     set_scheduler_action choose_new_thread
+   od"
+
+definition
+  possible_switch_to :: "obj_ref \<Rightarrow> (unit, 'z::state_ext) s_monad" where
+  "possible_switch_to target \<equiv> do
+     cur_dom \<leftarrow> gets cur_domain;
+     target_dom \<leftarrow> thread_get tcb_domain target;
+     action \<leftarrow> gets scheduler_action;
+
+     if (target_dom \<noteq> cur_dom) then
+       tcb_sched_action tcb_sched_enqueue target
+     else if (action \<noteq> resume_cur_thread) then do
+         reschedule_required;
+         tcb_sched_action tcb_sched_enqueue target
+       od
+     else set_scheduler_action $ switch_thread target
+   od"
+
+definition
+  set_thread_state_act :: "obj_ref \<Rightarrow> (unit, 'z::state_ext) s_monad"
+where
+  "set_thread_state_act tcb_ptr \<equiv> do
+    ts \<leftarrow> get_thread_state tcb_ptr;
+    cur \<leftarrow> gets cur_thread;
+    sched_act \<leftarrow> gets scheduler_action;
+    when (tcb_ptr = cur \<and> sched_act = resume_cur_thread \<and> \<not> runnable ts) $ set_scheduler_action choose_new_thread
+  od"
+
+(***)
+
+definition
+  set_thread_state :: "obj_ref \<Rightarrow> thread_state \<Rightarrow> (unit,'z::state_ext) s_monad"
+where
+  "set_thread_state ref ts \<equiv> do
+     tcb \<leftarrow> gets_the $ get_tcb ref;
+     set_object ref (TCB (tcb \<lparr> tcb_state := ts \<rparr>));
+     set_thread_state_act ref
+   od"
+
+definition
+  set_priority :: "obj_ref \<Rightarrow> priority \<Rightarrow> (unit,'z::state_ext) s_monad" where
+  "set_priority tptr prio \<equiv> do
+     tcb_sched_action tcb_sched_dequeue tptr;
+     thread_set_priority tptr prio;
+     ts \<leftarrow> get_thread_state tptr;
+     when (runnable ts) $ do
+       cur \<leftarrow> gets cur_thread;
+       if tptr = cur then reschedule_required else possible_switch_to tptr
+     od
+   od"
+
+definition
+  set_mcpriority :: "obj_ref \<Rightarrow> priority \<Rightarrow> (unit, 'z::state_ext) s_monad"  where
+  "set_mcpriority ref mcp \<equiv> thread_set (\<lambda>tcb. tcb\<lparr>tcb_mcpriority:=mcp\<rparr>) ref "
+
+
 section "User Context"
 
 text \<open>
diff --git a/spec/abstract/Retype_A.thy b/spec/abstract/Retype_A.thy
index 9a6e6ede7f..d0eba76db9 100644
--- a/spec/abstract/Retype_A.thy
+++ b/spec/abstract/Retype_A.thy
@@ -62,11 +62,11 @@ definition
 
 text \<open>The initial state objects of various types are in when created.\<close>
 definition
-  default_object :: "apiobject_type \<Rightarrow> bool \<Rightarrow> nat \<Rightarrow> kernel_object" where
-  "default_object api dev n \<equiv> case api of
+  default_object :: "apiobject_type \<Rightarrow> bool \<Rightarrow> nat \<Rightarrow> domain \<Rightarrow> kernel_object" where
+  "default_object api dev n d \<equiv> case api of
            Untyped \<Rightarrow> undefined
          | CapTableObject \<Rightarrow> CNode n (empty_cnode n)
-         | TCBObject \<Rightarrow> TCB default_tcb
+         | TCBObject \<Rightarrow> TCB (default_tcb d)
          | EndpointObject \<Rightarrow> Endpoint default_ep
          | NotificationObject \<Rightarrow> Notification default_notification
          | ArchObject aobj \<Rightarrow> ArchObj (default_arch_object aobj dev n)"
@@ -78,7 +78,7 @@ definition
   "obj_bits_api type obj_size_bits \<equiv> case type of
            Untyped \<Rightarrow> obj_size_bits
          | CapTableObject \<Rightarrow> obj_size_bits + slot_bits
-         | TCBObject \<Rightarrow> obj_bits (TCB default_tcb)
+         | TCBObject \<Rightarrow> obj_bits (TCB (default_tcb default_domain))
          | EndpointObject \<Rightarrow> obj_bits (Endpoint undefined)
          | NotificationObject \<Rightarrow> obj_bits (Notification undefined)
          | ArchObject aobj \<Rightarrow> obj_bits $ ArchObj $ default_arch_object aobj False obj_size_bits"
@@ -99,8 +99,8 @@ where
     ptrs \<leftarrow> return $ map (\<lambda>p. ptr_add ptr (p * obj_size)) [0..< numObjects];
     when (type \<noteq> Untyped) (do
       kh \<leftarrow> gets kheap;
-      kh' \<leftarrow> return $ foldr (\<lambda>p kh. kh(p \<mapsto> default_object type dev o_bits)) ptrs kh;
-      do_extended_op (retype_region_ext ptrs type);
+      cd \<leftarrow> gets cur_domain;
+      kh' \<leftarrow> return $ foldr (\<lambda>p kh. kh(p \<mapsto> default_object type dev o_bits cd)) ptrs kh;
       modify $ kheap_update (K kh')
     od);
     return $ ptrs
@@ -113,7 +113,7 @@ abbreviation (input) "extended_state_update \<equiv> trans_state"
 text \<open>Remove objects from a region of the heap.\<close>
 definition
   detype :: "(obj_ref set) \<Rightarrow> 'z::state_ext state \<Rightarrow> 'z::state_ext state" where
- "detype S s \<equiv> s \<lparr> kheap := (\<lambda>x. if x \<in> S then None else kheap s x), extended_state := detype_ext S (exst s)\<rparr>"
+ "detype S s \<equiv> s \<lparr> kheap := (\<lambda>x. if x \<in> S then None else kheap s x)\<rparr>"
 
 text \<open>Delete objects within a specified region.\<close>
 definition
diff --git a/spec/abstract/Schedule_A.thy b/spec/abstract/Schedule_A.thy
index a541a1dc88..6eebab6ef6 100644
--- a/spec/abstract/Schedule_A.thy
+++ b/spec/abstract/Schedule_A.thy
@@ -4,10 +4,6 @@
  * SPDX-License-Identifier: GPL-2.0-only
  *)
 
-(*
-Non-deterministic scheduler functionality.
-*)
-
 chapter "Scheduler"
 
 theory Schedule_A
@@ -21,24 +17,6 @@ arch_requalify_consts (A)
 abbreviation
   "idle st \<equiv> st = Structures_A.IdleThreadState"
 
-text \<open>Gets the TCB at an address if the thread can be scheduled.\<close>
-definition
-  getActiveTCB :: "obj_ref \<Rightarrow> 'z::state_ext state \<Rightarrow> tcb option"
-where
-  "getActiveTCB tcb_ref state \<equiv>
-   case (get_tcb tcb_ref state)
-     of None           \<Rightarrow> None
-      | Some tcb       \<Rightarrow> if (runnable $ tcb_state tcb)
-                         then Some tcb else None"
-
-text \<open>Gets all schedulable threads in the system.\<close>
-definition
-  allActiveTCBs :: "(obj_ref set,'z::state_ext) s_monad" where
-  "allActiveTCBs \<equiv> do
-    state \<leftarrow> get;
-    return {x. getActiveTCB x state \<noteq> None}
-   od"
-
 text \<open>Switches the current thread to the specified one.\<close>
 definition
   switch_to_thread :: "obj_ref \<Rightarrow> (unit,'z::state_ext) s_monad" where
@@ -46,16 +24,17 @@ definition
      state \<leftarrow> get;
      assert (get_tcb t state \<noteq> None);
      arch_switch_to_thread t;
-     do_extended_op (tcb_sched_action (tcb_sched_dequeue) t);
+     tcb_sched_action (tcb_sched_dequeue) t;
      modify (\<lambda>s. s \<lparr> cur_thread := t \<rparr>)
    od"
 
 text \<open>Asserts that a thread is runnable before switching to it.\<close>
-definition guarded_switch_to :: "obj_ref \<Rightarrow> (unit,'z::state_ext) s_monad" where
-"guarded_switch_to thread \<equiv> do ts \<leftarrow> get_thread_state thread;
-                    assert (runnable ts);
-                    switch_to_thread thread
-                 od"
+definition guarded_switch_to :: "obj_ref \<Rightarrow> (unit, 'z::state_ext) s_monad" where
+  "guarded_switch_to thread \<equiv> do
+     ts \<leftarrow> get_thread_state thread;
+     assert (runnable ts);
+     switch_to_thread thread
+    od"
 
 text \<open>Switches to the idle thread.\<close>
 definition
@@ -66,36 +45,47 @@ definition
      modify (\<lambda>s. s \<lparr> cur_thread := thread \<rparr>)
    od"
 
-class state_ext_sched = state_ext +
-  fixes schedule :: "(unit,'a) s_monad"
+definition
+  next_domain :: "(unit, 'z::state_ext) s_monad" where
+  "next_domain \<equiv> do
+    modify (\<lambda>s.
+      let domain_index' = (domain_index s + 1) mod length (domain_list s) in
+      let next_dom = (domain_list s)!domain_index'
+      in s\<lparr> domain_index := domain_index',
+            cur_domain := fst next_dom,
+            domain_time := snd next_dom\<rparr>);
+    do_extended_op $ modify (\<lambda>s. s \<lparr>work_units_completed := 0\<rparr>)
+  od"
 
-definition choose_thread :: "det_ext state \<Rightarrow> (unit \<times> det_ext state) set \<times> bool" where
-"choose_thread \<equiv>
-      do
-        d \<leftarrow> gets cur_domain;
-        queues \<leftarrow> gets (\<lambda>s. ready_queues s d);
-        if (\<forall>prio. queues prio = []) then (switch_to_idle_thread)
-        else (guarded_switch_to (hd (max_non_empty_queue queues)))
-      od"
+definition
+  dec_domain_time :: "(unit, 'z::state_ext) s_monad" where
+  "dec_domain_time = modify (\<lambda>s. s\<lparr>domain_time := domain_time s - 1\<rparr>)"
+
+definition max_non_empty_queue :: "(priority \<Rightarrow> ready_queue) \<Rightarrow> ready_queue" where
+  "max_non_empty_queue queues \<equiv> queues (Max {prio. queues prio \<noteq> []})"
+
+definition choose_thread :: "(unit, 'z::state_ext) s_monad" where
+  "choose_thread \<equiv> do
+     d \<leftarrow> gets cur_domain;
+     queues \<leftarrow> gets (\<lambda>s. ready_queues s d);
+     if \<forall>prio. queues prio = []
+     then switch_to_idle_thread
+     else guarded_switch_to (hd (max_non_empty_queue queues))
+   od"
 
 text \<open>
   Determine whether given priority is highest among queued ready threads in given domain.
   Trivially true if no threads are ready.\<close>
 definition
-  is_highest_prio :: "domain \<Rightarrow> priority \<Rightarrow> det_ext state \<Rightarrow> bool"
+  is_highest_prio :: "domain \<Rightarrow> priority \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
 where
   "is_highest_prio d p s \<equiv>
     (\<forall>prio. ready_queues s d prio = [])
     \<or> p \<ge> Max {prio. ready_queues s d prio \<noteq> []}"
 
-instantiation  det_ext_ext :: (type) state_ext_sched
-begin
-
 definition
   "schedule_switch_thread_fastfail ct it ct_prio target_prio \<equiv>
-     if ct \<noteq> it
-     then return (target_prio < ct_prio)
-     else return True"
+     return $ ct \<noteq> it \<longrightarrow> target_prio < ct_prio"
 
 definition
   "schedule_choose_new_thread \<equiv> do
@@ -106,7 +96,7 @@ definition
    od"
 
 definition
-  "schedule_det_ext_ext \<equiv> do
+  "schedule \<equiv> do
      ct \<leftarrow> gets cur_thread;
      ct_st \<leftarrow> get_thread_state ct;
      ct_runnable \<leftarrow> return $ runnable ct_st;
@@ -125,10 +115,10 @@ definition
            when ct_runnable (tcb_sched_action tcb_sched_enqueue ct);
 
            it \<leftarrow> gets idle_thread;
-           target_prio \<leftarrow> ethread_get tcb_priority candidate;
+           target_prio \<leftarrow> thread_get tcb_priority candidate;
 
            \<comment> \<open>Infoflow does not like asking about the idle thread's priority or domain.\<close>
-           ct_prio \<leftarrow> ethread_get_when (ct \<noteq> it) tcb_priority ct;
+           ct_prio \<leftarrow> if ct \<noteq> it then thread_get tcb_priority ct else return 0;
            \<comment> \<open>When to look at the bitmaps. This optimisation is used in the C fast path,
               but there we know @{text cur_thread} is not idle.\<close>
            fastfail \<leftarrow> schedule_switch_thread_fastfail ct it ct_prio target_prio;
@@ -159,44 +149,4 @@ definition
         od)
     od"
 
-instance ..
-end
-
-
-instantiation unit :: state_ext_sched
-begin
-
-
-text \<open>
-  The scheduler is heavily underspecified.
-  It is allowed to pick any active thread or the idle thread.
-  If the thread the scheduler picked is the current thread, it
-  may omit the call to @{const switch_to_thread}. Likewise it
-  may omit the call to @{const switch_to_idle_thread} if the
-  idle thread is the current thread.
-\<close>
-definition schedule_unit :: "(unit,unit) s_monad" where
-"schedule_unit \<equiv> (do
-   cur \<leftarrow> gets cur_thread;
-   threads \<leftarrow> allActiveTCBs;
-   thread \<leftarrow> select threads;
-   (if thread = cur then
-     return () \<sqinter> switch_to_thread thread
-   else
-     switch_to_thread thread)
- od) \<sqinter>
- (do
-   cur \<leftarrow> gets cur_thread;
-   idl \<leftarrow> gets idle_thread;
-   if idl = cur then
-     return () \<sqinter> switch_to_idle_thread
-   else switch_to_idle_thread
-  od)"
-
-instance ..
-end
-
-
-lemmas schedule_def = schedule_det_ext_ext_def schedule_unit_def
-
 end
diff --git a/spec/abstract/Structures_A.thy b/spec/abstract/Structures_A.thy
index b8c7a568ca..1c9c17d636 100644
--- a/spec/abstract/Structures_A.thy
+++ b/spec/abstract/Structures_A.thy
@@ -367,6 +367,8 @@ datatype thread_state
 
 type_synonym priority = word8
 
+type_synonym domain = word8
+
 record tcb =
  tcb_ctable        :: cap
  tcb_vtable        :: cap
@@ -377,8 +379,11 @@ record tcb =
  tcb_fault_handler :: cap_ref
  tcb_ipc_buffer    :: vspace_ref
  tcb_fault         :: "fault option"
- tcb_bound_notification     :: "obj_ref option"
+ tcb_bound_notification :: "obj_ref option"
  tcb_mcpriority    :: priority
+ tcb_priority      :: priority
+ tcb_time_slice    :: nat
+ tcb_domain        :: domain
  tcb_arch          :: arch_tcb (* arch_tcb must have a field for user context *)
 
 
@@ -396,9 +401,15 @@ where
 | "runnable (BlockedOnReply)        = False"
 
 
+definition default_domain :: "domain" where
+  "default_domain \<equiv> minBound"
+
+definition default_priority :: "priority" where
+  "default_priority \<equiv> minBound"
+
 definition
-  default_tcb :: tcb where
-  "default_tcb \<equiv> \<lparr>
+  default_tcb :: "domain \<Rightarrow> tcb" where
+  "default_tcb d \<equiv> \<lparr>
       tcb_ctable   = NullCap,
       tcb_vtable   = NullCap,
       tcb_reply    = NullCap,
@@ -410,6 +421,9 @@ definition
       tcb_fault      = None,
       tcb_bound_notification  = None,
       tcb_mcpriority = minBound,
+      tcb_priority   = default_priority,
+      tcb_time_slice = timeSlice,
+      tcb_domain     = d,
       tcb_arch       = default_arch_tcb\<rparr>"
 
 text \<open>
@@ -506,6 +520,15 @@ datatype irq_state =
  | IRQTimer
  | IRQReserved
 
+text \<open>The current scheduler action,
+  which is part of the scheduling state.\<close>
+datatype scheduler_action =
+    resume_cur_thread
+  | switch_thread (sch_act_target : obj_ref)
+  | choose_new_thread
+
+type_synonym ready_queue = "obj_ref list"
+
 text \<open>The kernel state includes a heap, a capability derivation tree
 (CDT), a bitmap used to determine if a capability is the original
 capability to that object, a pointer to the current thread, a pointer
@@ -527,6 +550,12 @@ record abstract_state =
   is_original_cap    :: "cslot_ptr \<Rightarrow> bool"
   cur_thread         :: obj_ref
   idle_thread        :: obj_ref
+  scheduler_action   :: scheduler_action
+  domain_list        :: "(domain \<times> machine_word) list"
+  domain_index       :: nat
+  cur_domain         :: domain
+  domain_time        :: "machine_word"
+  ready_queues       :: "domain \<Rightarrow> priority \<Rightarrow> ready_queue"
   machine_state      :: machine_state
   interrupt_irq_node :: "irq \<Rightarrow> obj_ref"
   interrupt_states   :: "irq \<Rightarrow> irq_state"
diff --git a/spec/abstract/Syscall_A.thy b/spec/abstract/Syscall_A.thy
index e3f5bafb76..605cbcb5c0 100644
--- a/spec/abstract/Syscall_A.thy
+++ b/spec/abstract/Syscall_A.thy
@@ -249,9 +249,9 @@ definition
   handle_yield :: "(unit,'z::state_ext) s_monad" where
   "handle_yield \<equiv> do
      thread \<leftarrow> gets cur_thread;
-     do_extended_op (tcb_sched_action (tcb_sched_dequeue) thread);
-     do_extended_op (tcb_sched_action (tcb_sched_append) thread);
-     do_extended_op (reschedule_required)
+     tcb_sched_action (tcb_sched_dequeue) thread;
+     tcb_sched_action (tcb_sched_append) thread;
+     reschedule_required
    od"
 
 definition
@@ -374,7 +374,7 @@ text \<open>
 \<close>
 
 definition
-  call_kernel :: "event \<Rightarrow> (unit,'z::state_ext_sched) s_monad" where
+  call_kernel :: "event \<Rightarrow> (unit, 'z::state_ext) s_monad" where
   "call_kernel ev \<equiv> do
        handle_event ev <handle>
            (\<lambda>_. without_preemption $ do
diff --git a/spec/abstract/Tcb_A.thy b/spec/abstract/Tcb_A.thy
index 89fe35d96a..51aa1bddd6 100644
--- a/spec/abstract/Tcb_A.thy
+++ b/spec/abstract/Tcb_A.thy
@@ -44,8 +44,8 @@ definition
       cancel_ipc thread;
       setup_reply_master thread;
       set_thread_state thread Restart;
-      do_extended_op (tcb_sched_action (tcb_sched_enqueue) thread);
-      do_extended_op (possible_switch_to thread)
+      tcb_sched_action (tcb_sched_enqueue) thread;
+      possible_switch_to thread
     od
   od"
 
@@ -176,11 +176,11 @@ where
           $ check_cap_at (ThreadCap target) slot
           $ cap_insert new_cap src_slot (target, tcb_cnode_index 4);
       cur \<leftarrow> liftE $ gets cur_thread;
-      liftE $ when (target = cur) (do_extended_op reschedule_required)
+      liftE $ when (target = cur) reschedule_required
     odE);
     liftE $ case priority
               of None \<Rightarrow> return()
-               | Some (prio, _) \<Rightarrow> do_extended_op (set_priority target prio);
+               | Some (prio, _) \<Rightarrow> set_priority target prio;
     returnOk []
   odE"
 
@@ -203,7 +203,7 @@ where
         od) gpRegisters;
     cur \<leftarrow> gets cur_thread;
     arch_post_modify_registers cur dest;
-    when (dest = cur) (do_extended_op reschedule_required);
+    when (dest = cur) reschedule_required;
     return []
   od)"
 
@@ -227,7 +227,7 @@ where
     od;
     arch_post_modify_registers self dest;
     when resume_target $ restart dest;
-    when (dest = self) (do_extended_op reschedule_required);
+    when (dest = self) reschedule_required;
     return []
   od)"
 
@@ -247,25 +247,25 @@ where
   (liftE $ do
     as_user tcb $ setRegister tlsBaseRegister tls_base;
     cur \<leftarrow> gets cur_thread;
-    when (tcb = cur) (do_extended_op reschedule_required);
+    when (tcb = cur) reschedule_required;
     return []
   od)"
 
 definition
-  set_domain :: "obj_ref \<Rightarrow> domain \<Rightarrow> unit det_ext_monad" where
+  set_domain :: "obj_ref \<Rightarrow> domain \<Rightarrow> (unit, 'z::state_ext) s_monad" where
   "set_domain tptr new_dom \<equiv> do
      cur \<leftarrow> gets cur_thread;
      tcb_sched_action tcb_sched_dequeue tptr;
      thread_set_domain tptr new_dom;
      ts \<leftarrow> get_thread_state tptr;
-     when (runnable ts) (tcb_sched_action tcb_sched_enqueue tptr);
-     when (tptr = cur) reschedule_required
+     when (runnable ts) $ tcb_sched_action tcb_sched_enqueue tptr;
+     when (tptr = cur) $ reschedule_required
    od"
 
 definition invoke_domain:: "obj_ref \<Rightarrow> domain \<Rightarrow> (data list,'z::state_ext) p_monad"
 where
   "invoke_domain thread domain \<equiv>
-     liftE (do do_extended_op (set_domain thread domain); return [] od)"
+     liftE (do set_domain thread domain; return [] od)"
 
 text \<open>Get all of the message registers, both from the sending thread's current
 register file and its IPC buffer.\<close>

From 06d568d87da05ce9aa099ed7adeafb2fbf65b674 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Fri, 8 Nov 2024 15:54:45 +1100
Subject: [PATCH 2/7] squash aspec: review feedback and other arches

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 spec/abstract/ARM/Init_A.thy     | 9 +++++++++
 spec/abstract/ARM_HYP/Init_A.thy | 9 +++++++++
 spec/abstract/RISCV64/Init_A.thy | 9 +++++++++
 spec/abstract/Structures_A.thy   | 3 +--
 spec/abstract/Tcb_A.thy          | 2 +-
 spec/abstract/X64/Init_A.thy     | 9 +++++++++
 6 files changed, 38 insertions(+), 3 deletions(-)

diff --git a/spec/abstract/ARM/Init_A.thy b/spec/abstract/ARM/Init_A.thy
index 2872ed1276..aec20c6802 100644
--- a/spec/abstract/ARM/Init_A.thy
+++ b/spec/abstract/ARM/Init_A.thy
@@ -74,6 +74,9 @@ definition
     tcb_fault = None,
     tcb_bound_notification = None,
     tcb_mcpriority = minBound,
+    tcb_priority = 0,
+    tcb_time_slice = timeSlice,
+    tcb_domain = 0,
     tcb_arch = init_arch_tcb
   \<rparr>,
   init_globals_frame \<mapsto> ArchObj (DataPage False ARMSmallPage), \<comment> \<open>same reason as why we kept the definition of @{term init_globals_frame}\<close>
@@ -95,6 +98,12 @@ definition
     is_original_cap = init_ioc,
     cur_thread = idle_thread_ptr,
     idle_thread = idle_thread_ptr,
+    scheduler_action = resume_cur_thread,
+    domain_list = [(0,15)],
+    domain_index = 0,
+    cur_domain = 0,
+    domain_time = 15,
+    ready_queues = const (const []),
     machine_state = init_machine_state,
     interrupt_irq_node = \<lambda>irq. init_irq_node_ptr + (ucast irq << cte_level_bits),
     interrupt_states = \<lambda>_. Structures_A.IRQInactive,
diff --git a/spec/abstract/ARM_HYP/Init_A.thy b/spec/abstract/ARM_HYP/Init_A.thy
index e87c2dd6cd..6e43b278a0 100644
--- a/spec/abstract/ARM_HYP/Init_A.thy
+++ b/spec/abstract/ARM_HYP/Init_A.thy
@@ -76,6 +76,9 @@ definition
     tcb_fault = None,
     tcb_bound_notification = None,
     tcb_mcpriority = minBound,
+    tcb_priority = 0,
+    tcb_time_slice = timeSlice,
+    tcb_domain = 0,
     tcb_arch = init_arch_tcb
   \<rparr>,
   us_global_pd_ptr \<mapsto> us_global_pd)"
@@ -95,6 +98,12 @@ definition
     is_original_cap = init_ioc,
     cur_thread = idle_thread_ptr,
     idle_thread = idle_thread_ptr,
+    scheduler_action = resume_cur_thread,
+    domain_list = [(0,15)],
+    domain_index = 0,
+    cur_domain = 0,
+    domain_time = 15,
+    ready_queues = const (const []),
     machine_state = init_machine_state,
     interrupt_irq_node = \<lambda>irq. init_irq_node_ptr + (ucast irq << cte_level_bits),
     interrupt_states = \<lambda>_. Structures_A.IRQInactive,
diff --git a/spec/abstract/RISCV64/Init_A.thy b/spec/abstract/RISCV64/Init_A.thy
index 42bb63a180..f8f527d8cd 100644
--- a/spec/abstract/RISCV64/Init_A.thy
+++ b/spec/abstract/RISCV64/Init_A.thy
@@ -111,6 +111,9 @@ definition init_kheap :: kheap
          tcb_fault = None,
          tcb_bound_notification = None,
          tcb_mcpriority = minBound,
+         tcb_priority = 0,
+         tcb_time_slice = timeSlice,
+         tcb_domain = 0,
          tcb_arch = init_arch_tcb
          \<rparr>,
       riscv_global_pt_ptr \<mapsto> init_global_pt
@@ -134,6 +137,12 @@ definition init_A_st :: "'z::state_ext state"
     is_original_cap = init_ioc,
     cur_thread = idle_thread_ptr,
     idle_thread = idle_thread_ptr,
+    scheduler_action = resume_cur_thread,
+    domain_list = [(0,15)],
+    domain_index = 0,
+    cur_domain = 0,
+    domain_time = 15,
+    ready_queues = const (const []),
     machine_state = init_machine_state,
     interrupt_irq_node = \<lambda>irq. init_irq_node_ptr + (ucast irq << cte_level_bits),
     interrupt_states = \<lambda>_. IRQInactive,
diff --git a/spec/abstract/Structures_A.thy b/spec/abstract/Structures_A.thy
index 1c9c17d636..32088edd49 100644
--- a/spec/abstract/Structures_A.thy
+++ b/spec/abstract/Structures_A.thy
@@ -520,8 +520,7 @@ datatype irq_state =
  | IRQTimer
  | IRQReserved
 
-text \<open>The current scheduler action,
-  which is part of the scheduling state.\<close>
+text \<open>The current scheduler action, which is part of the scheduling state.\<close>
 datatype scheduler_action =
     resume_cur_thread
   | switch_thread (sch_act_target : obj_ref)
diff --git a/spec/abstract/Tcb_A.thy b/spec/abstract/Tcb_A.thy
index 51aa1bddd6..95b47cbb09 100644
--- a/spec/abstract/Tcb_A.thy
+++ b/spec/abstract/Tcb_A.thy
@@ -259,7 +259,7 @@ definition
      thread_set_domain tptr new_dom;
      ts \<leftarrow> get_thread_state tptr;
      when (runnable ts) $ tcb_sched_action tcb_sched_enqueue tptr;
-     when (tptr = cur) $ reschedule_required
+     when (tptr = cur) reschedule_required
    od"
 
 definition invoke_domain:: "obj_ref \<Rightarrow> domain \<Rightarrow> (data list,'z::state_ext) p_monad"
diff --git a/spec/abstract/X64/Init_A.thy b/spec/abstract/X64/Init_A.thy
index c0dd40f3a4..38fddc30aa 100644
--- a/spec/abstract/X64/Init_A.thy
+++ b/spec/abstract/X64/Init_A.thy
@@ -92,6 +92,9 @@ definition
          tcb_fault = None,
          tcb_bound_notification = None,
          tcb_mcpriority = minBound,
+         tcb_priority = 0,
+         tcb_time_slice = timeSlice,
+         tcb_domain = 0,
          tcb_arch = init_arch_tcb
          \<rparr>,
      init_global_pml4 \<mapsto> ArchObj (PageMapL4 global_pml4),
@@ -114,6 +117,12 @@ definition
     is_original_cap = init_ioc,
     cur_thread = idle_thread_ptr,
     idle_thread = idle_thread_ptr,
+    scheduler_action = resume_cur_thread,
+    domain_list = [(0,15)],
+    domain_index = 0,
+    cur_domain = 0,
+    domain_time = 15,
+    ready_queues = const (const []),
     machine_state = init_machine_state,
     interrupt_irq_node = \<lambda>irq. init_irq_node_ptr + (ucast irq << cte_level_bits),
     interrupt_states = \<lambda>_. Structures_A.IRQInactive,

From 9b20eb1b368f6a7a0283d75d53f9dd100ea782c1 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Wed, 13 Nov 2024 19:03:07 +1100
Subject: [PATCH 3/7] squash aspec: use default_domain in init_kheap

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 spec/abstract/AARCH64/Init_A.thy | 2 +-
 spec/abstract/ARM/Init_A.thy     | 2 +-
 spec/abstract/ARM_HYP/Init_A.thy | 2 +-
 spec/abstract/RISCV64/Init_A.thy | 2 +-
 spec/abstract/X64/Init_A.thy     | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/spec/abstract/AARCH64/Init_A.thy b/spec/abstract/AARCH64/Init_A.thy
index e8cd649fe8..a0ce6eee16 100644
--- a/spec/abstract/AARCH64/Init_A.thy
+++ b/spec/abstract/AARCH64/Init_A.thy
@@ -81,7 +81,7 @@ definition init_kheap :: kheap where
          tcb_mcpriority = minBound,
          tcb_priority = 0,
          tcb_time_slice = timeSlice,
-         tcb_domain = 0,
+         tcb_domain = default_domain,
          tcb_arch = init_arch_tcb
          \<rparr>,
      arm_global_pt_ptr \<mapsto> ArchObj global_pt_obj
diff --git a/spec/abstract/ARM/Init_A.thy b/spec/abstract/ARM/Init_A.thy
index aec20c6802..5c56b091c7 100644
--- a/spec/abstract/ARM/Init_A.thy
+++ b/spec/abstract/ARM/Init_A.thy
@@ -76,7 +76,7 @@ definition
     tcb_mcpriority = minBound,
     tcb_priority = 0,
     tcb_time_slice = timeSlice,
-    tcb_domain = 0,
+    tcb_domain = default_domain,
     tcb_arch = init_arch_tcb
   \<rparr>,
   init_globals_frame \<mapsto> ArchObj (DataPage False ARMSmallPage), \<comment> \<open>same reason as why we kept the definition of @{term init_globals_frame}\<close>
diff --git a/spec/abstract/ARM_HYP/Init_A.thy b/spec/abstract/ARM_HYP/Init_A.thy
index 6e43b278a0..558c3ea658 100644
--- a/spec/abstract/ARM_HYP/Init_A.thy
+++ b/spec/abstract/ARM_HYP/Init_A.thy
@@ -78,7 +78,7 @@ definition
     tcb_mcpriority = minBound,
     tcb_priority = 0,
     tcb_time_slice = timeSlice,
-    tcb_domain = 0,
+    tcb_domain = default_domain,
     tcb_arch = init_arch_tcb
   \<rparr>,
   us_global_pd_ptr \<mapsto> us_global_pd)"
diff --git a/spec/abstract/RISCV64/Init_A.thy b/spec/abstract/RISCV64/Init_A.thy
index f8f527d8cd..7564f1505c 100644
--- a/spec/abstract/RISCV64/Init_A.thy
+++ b/spec/abstract/RISCV64/Init_A.thy
@@ -113,7 +113,7 @@ definition init_kheap :: kheap
          tcb_mcpriority = minBound,
          tcb_priority = 0,
          tcb_time_slice = timeSlice,
-         tcb_domain = 0,
+         tcb_domain = default_domain,
          tcb_arch = init_arch_tcb
          \<rparr>,
       riscv_global_pt_ptr \<mapsto> init_global_pt
diff --git a/spec/abstract/X64/Init_A.thy b/spec/abstract/X64/Init_A.thy
index 38fddc30aa..b797746426 100644
--- a/spec/abstract/X64/Init_A.thy
+++ b/spec/abstract/X64/Init_A.thy
@@ -94,7 +94,7 @@ definition
          tcb_mcpriority = minBound,
          tcb_priority = 0,
          tcb_time_slice = timeSlice,
-         tcb_domain = 0,
+         tcb_domain = default_domain,
          tcb_arch = init_arch_tcb
          \<rparr>,
      init_global_pml4 \<mapsto> ArchObj (PageMapL4 global_pml4),

From 8f90150eb4fed570c34fc8249382a442377f6c1c Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Fri, 8 Nov 2024 15:34:09 +1100
Subject: [PATCH 4/7] aarch64 ainvs: proof update for det_ext refactor

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 .../AARCH64/ArchArch_AI.thy                   |    3 +
 .../AARCH64/ArchBCorres2_AI.thy               |   33 +-
 .../AARCH64/ArchDetSchedAux_AI.thy            |   63 +-
 .../AARCH64/ArchDetSchedDomainTime_AI.thy     |   28 +-
 .../AARCH64/ArchDetSchedSchedule_AI.thy       |  112 +-
 .../AARCH64/ArchDetype_AI.thy                 |    9 +-
 .../AARCH64/ArchEmptyFail_AI.thy              |   27 +-
 .../AARCH64/ArchInterrupt_AI.thy              |    4 +
 .../AARCH64/ArchInvariants_AI.thy             |    6 +
 .../AARCH64/ArchKHeap_AI.thy                  |   28 +-
 .../AARCH64/ArchRetype_AI.thy                 |   18 +-
 .../AARCH64/ArchSchedule_AI.thy               |   37 +-
 .../AARCH64/ArchUntyped_AI.thy                |    6 +-
 .../AARCH64/ArchVCPU_AI.thy                   |   60 +-
 .../AARCH64/ArchVSpaceEntries_AI.thy          |   18 +-
 .../AARCH64/ArchVSpace_AI.thy                 |    2 +-
 proof/invariant-abstract/ADT_AI.thy           |    6 +-
 proof/invariant-abstract/BCorres2_AI.thy      |  233 +--
 proof/invariant-abstract/BCorres_AI.thy       |   40 +-
 proof/invariant-abstract/CSpaceInv_AI.thy     |   19 -
 proof/invariant-abstract/CSpace_AI.thy        |   12 -
 proof/invariant-abstract/DetSchedAux_AI.thy   |  267 ++--
 .../DetSchedDomainTime_AI.thy                 |  214 ++-
 proof/invariant-abstract/DetSchedInvs_AI.thy  |  209 +--
 .../DetSchedSchedule_AI.thy                   | 1250 ++++++++---------
 proof/invariant-abstract/Deterministic_AI.thy |   75 +-
 proof/invariant-abstract/EmptyFail_AI.thy     |   66 +-
 proof/invariant-abstract/Finalise_AI.thy      |   16 +-
 proof/invariant-abstract/Include_AI.thy       |    4 +-
 proof/invariant-abstract/Invariants_AI.thy    |  144 +-
 proof/invariant-abstract/IpcCancel_AI.thy     |   83 +-
 proof/invariant-abstract/Ipc_AI.thy           |   20 +-
 proof/invariant-abstract/KHeap_AI.thy         |   56 +-
 proof/invariant-abstract/Retype_AI.thy        |  105 +-
 proof/invariant-abstract/Schedule_AI.thy      |   94 +-
 proof/invariant-abstract/Syscall_AI.thy       |  137 +-
 proof/invariant-abstract/TcbAcc_AI.thy        |  585 ++++++--
 proof/invariant-abstract/Tcb_AI.thy           |   18 +-
 proof/invariant-abstract/Untyped_AI.thy       |    8 +-
 proof/invariant-abstract/VSpacePre_AI.thy     |    4 -
 40 files changed, 2041 insertions(+), 2078 deletions(-)

diff --git a/proof/invariant-abstract/AARCH64/ArchArch_AI.thy b/proof/invariant-abstract/AARCH64/ArchArch_AI.thy
index 969da0e922..4c0e3f22ac 100644
--- a/proof/invariant-abstract/AARCH64/ArchArch_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchArch_AI.thy
@@ -1221,6 +1221,9 @@ lemma invoke_arch_invs[wp]:
   apply (wp perform_vcpu_invs|simp)+
   done
 
+crunch set_thread_state_act
+  for aobjs_of[wp]: "\<lambda>s. P (aobjs_of s)"
+
 lemma sts_aobjs_of[wp]:
   "set_thread_state t st \<lbrace>\<lambda>s. P (aobjs_of s)\<rbrace>"
   unfolding set_thread_state_def
diff --git a/proof/invariant-abstract/AARCH64/ArchBCorres2_AI.thy b/proof/invariant-abstract/AARCH64/ArchBCorres2_AI.thy
index 6259833c46..829365ddee 100644
--- a/proof/invariant-abstract/AARCH64/ArchBCorres2_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchBCorres2_AI.thy
@@ -16,11 +16,11 @@ named_theorems BCorres2_AI_assms
 
 crunch invoke_cnode
   for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state
-  (simp: swp_def ignore: clearMemory without_preemption filterM ethread_set)
+  (simp: swp_def ignore: clearMemory without_preemption filterM)
 
 crunch create_cap,init_arch_objects,retype_region,delete_objects
   for (bcorres) bcorres[wp]: truncate_state
-  (ignore: freeMemory clearMemory retype_region_ext)
+  (ignore: freeMemory clearMemory)
 
 crunch set_extra_badge,derive_cap
   for (bcorres) bcorres[wp]: truncate_state (ignore: storeWord)
@@ -29,7 +29,7 @@ crunch invoke_untyped
   for (bcorres) bcorres[wp]: truncate_state
   (ignore: sequence_x)
 
-crunch set_mcpriority
+crunch set_mcpriority, set_priority
   for (bcorres) bcorres[wp]: truncate_state
 
 crunch arch_get_sanitise_register_info, arch_post_modify_registers
@@ -75,10 +75,6 @@ lemma  handle_arch_fault_reply_bcorres[wp,BCorres2_AI_assms]:
   "bcorres ( handle_arch_fault_reply a b c d) (handle_arch_fault_reply a b c d)"
   by (cases a; simp add: handle_arch_fault_reply_def; wp)
 
-crunch
-    arch_switch_to_thread,arch_switch_to_idle_thread
-  for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state
-
 end
 
 interpretation BCorres2_AI?: BCorres2_AI
@@ -87,11 +83,9 @@ interpretation BCorres2_AI?: BCorres2_AI
   case 1 show ?case by (unfold_locales; (fact BCorres2_AI_assms)?)
   qed
 
-lemmas schedule_bcorres[wp] = schedule_bcorres1[OF BCorres2_AI_axioms]
-
 context Arch begin arch_global_naming
 
-crunch send_ipc,send_signal,do_reply_transfer,arch_perform_invocation
+crunch send_ipc,send_signal,do_reply_transfer,arch_perform_invocation,invoke_domain
   for (bcorres) bcorres[wp]: truncate_state
   (simp: gets_the_def swp_def
    ignore: freeMemory clearMemory loadWord cap_fault_on_failure
@@ -153,7 +147,7 @@ lemma vppi_event_bcorres[wp]:
 lemma handle_reserved_irq_bcorres[wp]: "bcorres (handle_reserved_irq a) (handle_reserved_irq a)"
   unfolding handle_reserved_irq_def by wpsimp
 
-crunch handle_hypervisor_fault
+crunch handle_hypervisor_fault, timer_tick
   for (bcorres) bcorres[wp]: truncate_state
 
 lemma handle_event_bcorres[wp]: "bcorres (handle_event e) (handle_event e)"
@@ -163,23 +157,6 @@ lemma handle_event_bcorres[wp]: "bcorres (handle_event e) (handle_event e)"
          | intro impI conjI allI | wp | wpc)+
   done
 
-crunch guarded_switch_to,switch_to_idle_thread
-  for (bcorres) bcorres[wp]: truncate_state (ignore: storeWord)
-
-lemma choose_switch_or_idle:
-  "((), s') \<in> fst (choose_thread s) \<Longrightarrow>
-       (\<exists>word. ((),s') \<in> fst (guarded_switch_to word s)) \<or>
-       ((),s') \<in> fst (switch_to_idle_thread s)"
-  apply (simp add: choose_thread_def)
-  apply (clarsimp simp add: switch_to_idle_thread_def bind_def gets_def
-                   arch_switch_to_idle_thread_def in_monad
-                   return_def get_def modify_def put_def
-                    get_thread_state_def
-                   thread_get_def
-                   split: if_split_asm)
-  apply force
-  done
-
 end
 
 end
diff --git a/proof/invariant-abstract/AARCH64/ArchDetSchedAux_AI.thy b/proof/invariant-abstract/AARCH64/ArchDetSchedAux_AI.thy
index 637024ae11..14959b6cf1 100644
--- a/proof/invariant-abstract/AARCH64/ArchDetSchedAux_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchDetSchedAux_AI.thy
@@ -15,67 +15,27 @@ named_theorems DetSchedAux_AI_assms
 
 crunch init_arch_objects
   for exst[wp]: "\<lambda>s. P (exst s)"
-  and valid_etcbs[wp, DetSchedAux_AI_assms]: valid_etcbs
   and valid_queues[wp]: valid_queues
   and valid_sched_action[wp]: valid_sched_action
   and valid_sched[wp]: valid_sched
-  (wp: mapM_x_wp')
-
-(* already proved earlier *)
-declare invoke_untyped_cur_thread[DetSchedAux_AI_assms]
-
-crunch invoke_untyped
-  for ready_queues[wp, DetSchedAux_AI_assms]: "\<lambda>s. P (ready_queues s)"
-  and scheduler_action[wp, DetSchedAux_AI_assms]: "\<lambda>s. P (scheduler_action s)"
+  and etcbs_of[wp, DetSchedAux_AI_assms]: "\<lambda>s. P (etcbs_of s)"
+  and ready_queues[wp, DetSchedAux_AI_assms]: "\<lambda>s. P (ready_queues s)"
+  and idle_thread[wp, DetSchedAux_AI_assms]: "\<lambda>s. P (idle_thread s)"
+  and schedact[wp, DetSchedAux_AI_assms]: "\<lambda>s. P (scheduler_action s)"
   and cur_domain[wp, DetSchedAux_AI_assms]: "\<lambda>s. P (cur_domain s)"
-  (wp: crunch_wps mapME_x_inv_wp preemption_point_inv'
-   simp: detype_def detype_ext_def crunch_simps wrap_ext_det_ext_ext_def mapM_x_defsym)
-
-crunch invoke_untyped
-  for idle_thread[wp, DetSchedAux_AI_assms]: "\<lambda>s. P (idle_thread s)"
-  (wp: crunch_wps mapME_x_inv_wp preemption_point_inv dxo_wp_weak
-   simp: detype_def detype_ext_def crunch_simps wrap_ext_det_ext_ext_def mapM_x_defsym
-   ignore: retype_region_ext)
+  (wp: mapM_x_wp')
 
 lemma tcb_sched_action_valid_idle_etcb:
   "tcb_sched_action foo thread \<lbrace>valid_idle_etcb\<rbrace>"
   by (rule valid_idle_etcb_lift)
      (wpsimp simp: tcb_sched_action_def set_tcb_queue_def)
 
-crunch do_machine_op
-  for ekheap[wp]: "\<lambda>s. P (ekheap s)"
-
-lemma delete_objects_etcb_at[wp, DetSchedAux_AI_assms]:
-  "delete_objects a b \<lbrace>etcb_at P t\<rbrace>"
-  unfolding delete_objects_def detype_def detype_ext_def
-  by (wpsimp simp: wrap_ext_det_ext_ext_def etcb_at_def)
-
-crunch reset_untyped_cap
-  for etcb_at[wp]: "etcb_at P t"
-  and valid_etcbs[wp]: "valid_etcbs"
-  (wp: preemption_point_inv' mapME_x_inv_wp crunch_wps
-    simp: unless_def)
-
-lemma invoke_untyped_etcb_at [DetSchedAux_AI_assms]:
-  "\<lbrace>etcb_at P t and valid_etcbs\<rbrace>
-   invoke_untyped ui
-   \<lbrace>\<lambda>r s. st_tcb_at (Not o inactive) t s \<longrightarrow> etcb_at P t s\<rbrace>"
-  apply (cases ui)
-  apply (simp add: mapM_x_def[symmetric] invoke_untyped_def)
-  apply (wpsimp wp: retype_region_etcb_at mapM_x_wp'
-                    create_cap_no_pred_tcb_at typ_at_pred_tcb_at_lift
-                    hoare_convert_imp[OF create_cap_no_pred_tcb_at]
-                    hoare_convert_imp[OF _ init_arch_objects_exst]
-                    hoare_drop_impE_E)
-  done
-
-
 crunch init_arch_objects
   for valid_blocked[wp, DetSchedAux_AI_assms]: valid_blocked
-  (wp: valid_blocked_lift set_cap_typ_at)
+  (wp: valid_blocked_lift crunch_wps)
 
 lemma perform_asid_control_etcb_at:
-  "\<lbrace>etcb_at P t and valid_etcbs\<rbrace>
+  "\<lbrace>etcb_at P t\<rbrace>
    perform_asid_control_invocation aci
    \<lbrace>\<lambda>r s. st_tcb_at (Not \<circ> inactive) t s \<longrightarrow> etcb_at P t s\<rbrace>"
   apply (simp add: perform_asid_control_invocation_def)
@@ -88,12 +48,11 @@ lemma perform_asid_control_etcb_at:
 
 crunch perform_asid_control_invocation
   for idle_thread[wp]: "\<lambda>s. P (idle_thread s)"
-  and valid_etcbs[wp]: valid_etcbs
   and valid_blocked[wp]: valid_blocked
   and schedact[wp]: "\<lambda>s. P (scheduler_action s)"
   and ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
   and cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
-  (wp: hoare_weak_lift_imp)
+  (wp: hoare_weak_lift_imp simp: detype_def)
 
 lemma perform_asid_control_invocation_valid_sched:
   "\<lbrace>ct_active and invs and valid_aci aci and valid_sched and valid_idle\<rbrace>
@@ -118,12 +77,6 @@ end
 lemmas tcb_sched_action_valid_idle_etcb
     = AARCH64.tcb_sched_action_valid_idle_etcb
 
-global_interpretation DetSchedAux_AI_det_ext?: DetSchedAux_AI_det_ext
-proof goal_cases
-  interpret Arch .
-  case 1 show ?case by (unfold_locales; (fact DetSchedAux_AI_assms)?)
-qed
-
 global_interpretation DetSchedAux_AI?: DetSchedAux_AI
 proof goal_cases
   interpret Arch .
diff --git a/proof/invariant-abstract/AARCH64/ArchDetSchedDomainTime_AI.thy b/proof/invariant-abstract/AARCH64/ArchDetSchedDomainTime_AI.thy
index 44790fee8d..0b55ef4faa 100644
--- a/proof/invariant-abstract/AARCH64/ArchDetSchedDomainTime_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchDetSchedDomainTime_AI.thy
@@ -29,11 +29,11 @@ crunch
   arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread,
   handle_arch_fault_reply,
   arch_invoke_irq_control, arch_get_sanitise_register_info,
-  prepare_thread_delete, handle_hypervisor_fault, make_arch_fault_msg,
+  prepare_thread_delete, handle_hypervisor_fault, make_arch_fault_msg, init_arch_objects,
   arch_post_modify_registers, arch_post_cap_deletion, handle_vm_fault,
   arch_invoke_irq_handler
-  for domain_list_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s. P (domain_list s)"
-  (simp: crunch_simps isFpuEnable_def wp: mapM_wp' transfer_caps_loop_pres)
+  for domain_list_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s::det_state. P (domain_list s)"
+  (simp: crunch_simps isFpuEnable_def wp: mapM_wp' transfer_caps_loop_pres crunch_wps)
 
 crunch arch_finalise_cap
   for domain_time_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s. P (domain_time s)"
@@ -46,14 +46,9 @@ crunch
   prepare_thread_delete, handle_hypervisor_fault, handle_vm_fault,
   arch_post_modify_registers, arch_post_cap_deletion, make_arch_fault_msg,
   arch_invoke_irq_handler, handle_reserved_irq, arch_mask_irq_signal
-  for domain_time_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s::det_state. P (domain_time s)"
   (simp: crunch_simps wp: transfer_caps_loop_pres crunch_wps)
 
-crunch do_machine_op
-  for exst[wp]: "\<lambda>s. P (exst s)"
-
-declare init_arch_objects_exst[DetSchedDomainTime_AI_assms]
-
 end
 
 global_interpretation DetSchedDomainTime_AI?: DetSchedDomainTime_AI
@@ -65,15 +60,15 @@ qed
 context Arch begin arch_global_naming
 
 crunch arch_perform_invocation
-  for domain_time_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: crunch_wps check_cap_inv simp: if_apply_def2)
 
 crunch arch_perform_invocation
-  for domain_list_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp, DetSchedDomainTime_AI_assms]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps check_cap_inv simp: if_apply_def2)
 
 lemma vgic_maintenance_valid_domain_time:
-  "\<lbrace>\<lambda>s. 0 < domain_time s\<rbrace>
+  "\<lbrace>\<lambda>s::det_state. 0 < domain_time s\<rbrace>
     vgic_maintenance \<lbrace>\<lambda>y s. domain_time s = 0 \<longrightarrow> scheduler_action s = choose_new_thread\<rbrace>"
   unfolding vgic_maintenance_def
   apply (rule hoare_strengthen_post[where Q'="\<lambda>_ s. 0 < domain_time s"])
@@ -106,7 +101,7 @@ lemma timer_tick_valid_domain_time:
    \<lbrace>\<lambda>x s. domain_time s = 0 \<longrightarrow> scheduler_action s = choose_new_thread\<rbrace>" (is "\<lbrace> ?dtnot0 \<rbrace> _ \<lbrace> _ \<rbrace>")
   unfolding timer_tick_def
   supply if_split[split del]
-  supply ethread_get_wp[wp del]
+  supply thread_get_wp[wp del]
   supply if_apply_def2[simp]
   apply (wpsimp
            wp: reschedule_required_valid_domain_time hoare_vcg_const_imp_lift gts_wp
@@ -114,10 +109,13 @@ lemma timer_tick_valid_domain_time:
                   postcondition once we hit thread_set_time_slice *)
                hoare_post_imp[where Q'="\<lambda>_. ?dtnot0" and Q="\<lambda>_ s. domain_time s = 0 \<longrightarrow> X s"
                                 and f="thread_set_time_slice t ts" for X t ts]
-               hoare_drop_imp[where f="ethread_get t f" for t f])
+               hoare_drop_imp[where f="thread_get t f" for t f])
   apply fastforce
   done
 
+crunch do_machine_op
+  for domain_time_sched[wp]: "\<lambda>s. P (domain_time s) (scheduler_action s)"
+
 lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]:
   "\<lbrace>\<lambda>s :: det_ext state. 0 < domain_time s \<rbrace>
    handle_interrupt i
@@ -141,7 +139,7 @@ lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]:
   done
 
 crunch handle_reserved_irq, arch_mask_irq_signal
-  for domain_list_inv [wp, DetSchedDomainTime_AI_assms]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv [wp, DetSchedDomainTime_AI_assms]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps mapM_wp subset_refl simp: crunch_simps)
 
 end
diff --git a/proof/invariant-abstract/AARCH64/ArchDetSchedSchedule_AI.thy b/proof/invariant-abstract/AARCH64/ArchDetSchedSchedule_AI.thy
index b168ce488f..fe4328d175 100644
--- a/proof/invariant-abstract/AARCH64/ArchDetSchedSchedule_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchDetSchedSchedule_AI.thy
@@ -25,14 +25,6 @@ crunch vcpu_disable, vcpu_restore, vcpu_save, vcpu_switch
   for exst[wp]: "\<lambda>s. P (exst s)"
   (wp: crunch_wps)
 
-lemma set_vcpu_etcbs [wp]:
-  "\<lbrace>valid_etcbs\<rbrace> set_vcpu a b \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
-  by (rule valid_etcbs_lift; wp)
-
-lemma vcpu_switch_valid_etcbs[wp]:
-  "vcpu_switch v \<lbrace>valid_etcbs\<rbrace>"
-  by (rule valid_etcbs_lift; wp)
-
 lemma pred_tcb_atP[wp]:
   "\<lbrace>\<lambda>s. P (pred_tcb_at proj Q t s)\<rbrace> set_vcpu prt vcpu \<lbrace>\<lambda>_ s. P (pred_tcb_at proj Q t s)\<rbrace>"
   unfolding set_vcpu_def set_object_def
@@ -48,10 +40,27 @@ lemma vcpu_switch_pred_tcb_at[wp]:
   "\<lbrace>\<lambda>s. P (pred_tcb_at proj Q t s)\<rbrace> vcpu_switch vcpu \<lbrace>\<lambda>_ s. P (pred_tcb_at proj Q t s)\<rbrace>"
   unfolding vcpu_switch_def by (rule hoare_pre) wpsimp+
 
+lemma set_vcpu_etcbs_of[wp]:
+  "set_vcpu ptr vcpu \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
+  unfolding set_vcpu_def
+  apply (wpsimp wp: set_object_wp_strong)
+  by (auto elim!: rsubst[where P=P] simp: etcbs_of'_def obj_at_def a_type_def
+           split: kernel_object.splits)
+
+crunch set_vcpu
+  for ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
+  and cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
+
 lemma set_vcpu_valid_queues [wp]:
   "\<lbrace>valid_queues\<rbrace> set_vcpu ptr vcpu \<lbrace>\<lambda>_. valid_queues\<rbrace>"
   by (rule valid_queues_lift; wp)
 
+crunch vcpu_switch
+  for etcbs_of[wp]: "\<lambda>s. P (etcbs_of s)"
+  and ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
+  and cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
+  (wp: crunch_wps)
+
 lemma vcpu_switch_valid_queues[wp]:
   "\<lbrace>valid_queues\<rbrace> vcpu_switch v \<lbrace>\<lambda>_. valid_queues\<rbrace>"
   by (rule valid_queues_lift; wp)
@@ -68,19 +77,23 @@ crunch set_vm_root
   for pred_tcb_atP[wp]: "\<lambda>s. P (pred_tcb_at proj Q t s)"
   (wp: crunch_wps simp: crunch_simps)
 
-lemma set_asid_pool_valid_etcbs[wp]:
-  "set_asid_pool ptr pool \<lbrace>valid_etcbs\<rbrace>"
+lemma set_asid_pool_etcbs_of[wp]:
+  "set_asid_pool ptr pool \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
   unfolding set_asid_pool_def
-  by (wpsimp wp: hoare_drop_imps valid_etcbs_lift)
+  apply (wpsimp wp: set_object_wp_strong)
+  by (auto elim!: rsubst[where P=P] simp: etcbs_of'_def obj_at_def a_type_def
+           split: kernel_object.splits)
+
+crunch set_asid_pool
+  for ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
+  (wp: crunch_wps set_object_wp_strong)
 
 lemma set_asid_pool_valid_queues[wp]:
   "set_asid_pool ptr pool \<lbrace>valid_queues\<rbrace>"
-  unfolding set_asid_pool_def
   by (wpsimp wp: valid_queues_lift)
 
 crunch set_asid_pool, set_vm_root, arch_thread_set
   for scheduler_action[wp]: "\<lambda>s. P (scheduler_action s)"
-  and ekheap[wp]: "\<lambda>s. P (ekheap s)"
   and cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
   and ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
 
@@ -90,24 +103,18 @@ lemma set_asid_pool_weak_valid_sched_action[wp]:
 
 lemma set_asid_pool_valid_sched_action'[wp]:
   "set_asid_pool ptr pool
-   \<lbrace>\<lambda>s. valid_sched_action_2 (scheduler_action s) (ekheap s) (kheap s) thread (cur_domain s)\<rbrace>"
+   \<lbrace>\<lambda>s. valid_sched_action_2 (scheduler_action s) (etcbs_of s) (kheap s) thread (cur_domain s)\<rbrace>"
   unfolding valid_sched_action_def
   by (wpsimp simp: is_activatable_def switch_in_cur_domain_def in_cur_domain_def
              wp: hoare_vcg_imp_lift' hoare_vcg_all_lift | wps)+
 
 lemma set_vcpu_valid_sched_action'[wp]:
   "set_vcpu ptr vcpu
-   \<lbrace>\<lambda>s. valid_sched_action_2 (scheduler_action s) (ekheap s) (kheap s) thread (cur_domain s)\<rbrace>"
+   \<lbrace>\<lambda>s. valid_sched_action_2 (scheduler_action s) (etcbs_of s) (kheap s) thread (cur_domain s)\<rbrace>"
   unfolding valid_sched_action_def
   by (wpsimp simp: is_activatable_def switch_in_cur_domain_def in_cur_domain_def
              wp: hoare_vcg_imp_lift' hoare_vcg_all_lift | wps)+
 
-crunch
-  arch_switch_to_idle_thread, arch_switch_to_thread, arch_get_sanitise_register_info,
-  arch_post_modify_registers
-  for valid_etcbs [wp, DetSchedSchedule_AI_assms]: valid_etcbs
-  (simp: crunch_simps)
-
 crunch
   switch_to_idle_thread, switch_to_thread, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers
   for valid_queues [wp, DetSchedSchedule_AI_assms]: valid_queues
@@ -126,18 +133,18 @@ crunch set_vm_root
 lemma vcpu_switch_valid_sched_action[wp]:
   "\<lbrace>valid_sched_action\<rbrace> vcpu_switch v \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
   unfolding valid_sched_action_def is_activatable_def st_tcb_at_kh_simp
-  by (rule hoare_lift_Pf[where f=cur_thread]; wpsimp wp: hoare_vcg_imp_lift)
+  by (rule hoare_lift_Pf[where f=cur_thread]; wpsimp wp: hoare_vcg_imp_lift switch_in_cur_domain_lift)
 
 lemma switch_to_idle_thread_ct_not_in_q [wp, DetSchedSchedule_AI_assms]:
   "\<lbrace>valid_queues and valid_idle\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
   unfolding switch_to_idle_thread_def arch_switch_to_idle_thread_def
-  apply wpsimp
+  apply (wpsimp | wps)+
   apply (fastforce simp: valid_queues_def ct_not_in_q_def not_queued_def
                          valid_idle_def pred_tcb_at_def obj_at_def)
   done
 
 crunch set_vm_root, vcpu_switch
-  for valid_sched_action'[wp]: "\<lambda>s. valid_sched_action_2 (scheduler_action s) (ekheap s) (kheap s)
+  for valid_sched_action'[wp]: "\<lambda>s. valid_sched_action_2 (scheduler_action s) (etcbs_of s) (kheap s)
                                                          thread (cur_domain s)"
   (wp: crunch_wps simp: crunch_simps)
 
@@ -153,13 +160,13 @@ lemma switch_to_idle_thread_valid_sched_action [wp, DetSchedSchedule_AI_assms]:
 
 crunch set_vm_root
   for ct_in_cur_domain'[wp]: "\<lambda>s. ct_in_cur_domain_2 t (idle_thread s)
-                                                   (scheduler_action s) (cur_domain s) (ekheap s)"
-  (wp: crunch_wps simp: crunch_simps)
+                                                   (scheduler_action s) (cur_domain s) (etcbs_of s)"
+  (wp: crunch_wps simp: crunch_simps ignore: set_asid_pool)
 
 lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]:
   "\<lbrace>\<top>\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
   unfolding switch_to_idle_thread_def arch_switch_to_idle_thread_def
-  by (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_disj_lift | simp add: ct_in_cur_domain_def)+
+  by (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_disj_lift | simp add: ct_in_cur_domain_def | wps)+
 
 crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers
   for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q
@@ -184,7 +191,8 @@ lemma set_asid_pool_is_activatable[wp]:
   done
 
 crunch vcpu_disable, vcpu_restore, vcpu_save, vcpu_switch, set_vm_root
-  for is_activatable[wp]: "is_activatable t"
+  for etcbs_of[wp]: "\<lambda>s. P (etcbs_of s)"
+  and is_activatable[wp]: "is_activatable t"
   and valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched
   (wp: crunch_wps valid_sched_lift simp: crunch_simps ignore: set_asid_pool)
 
@@ -206,8 +214,8 @@ crunch set_vm_root
   (wp: crunch_wps whenE_wp simp: crunch_simps)
 
 crunch arch_switch_to_thread
-  for ct_in_cur_domain_2[wp, DetSchedSchedule_AI_assms]: "\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)"
-  (simp: crunch_simps wp: assert_inv crunch_wps)
+  for ct_in_cur_domain_2[wp, DetSchedSchedule_AI_assms]: "\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)"
+  (simp: crunch_simps wp: assert_inv crunch_wps ignore: set_vcpu)
 
 crunch set_asid_pool
   for valid_blocked[wp]: valid_blocked
@@ -237,11 +245,6 @@ crunch
 crunch arch_switch_to_idle_thread
   for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t"
 
-crunch
-  arch_switch_to_idle_thread, next_domain
-  for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\<lambda>s. P (scheduler_action s)"
-  (simp: Let_def)
-
 lemma vcpu_switch_ct_in_q[wp]:
   "\<lbrace>ct_in_q\<rbrace> vcpu_switch vcpu \<lbrace>\<lambda>_. ct_in_q\<rbrace>"
   unfolding ct_in_q_def
@@ -269,7 +272,7 @@ lemma arch_switch_to_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]:
   by (wpsimp simp: arch_switch_to_thread_def)
 
 lemma switch_to_idle_thread_ct_not_queued [wp, DetSchedSchedule_AI_assms]:
-  "\<lbrace>valid_queues and valid_etcbs and valid_idle\<rbrace>
+  "\<lbrace>valid_queues and valid_idle\<rbrace>
      switch_to_idle_thread
    \<lbrace>\<lambda>rv s. not_queued (cur_thread s) s\<rbrace>"
   apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def
@@ -326,9 +329,12 @@ lemma switch_to_idle_thread_cur_thread_idle_thread [wp, DetSchedSchedule_AI_assm
   "\<lbrace>\<top>\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_ s. cur_thread s = idle_thread s\<rbrace>"
   by (wp | simp add:switch_to_idle_thread_def arch_switch_to_idle_thread_def)+
 
-lemma set_pt_valid_etcbs[wp]:
-  "\<lbrace>valid_etcbs\<rbrace> set_pt ptr pt \<lbrace>\<lambda>rv. valid_etcbs\<rbrace>"
-  by (wp hoare_drop_imps valid_etcbs_lift | simp add: set_pt_def)+
+lemma set_pt_etcbs[wp]:
+  "set_pt ptr pt \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
+  unfolding set_pt_def
+  apply (wpsimp wp: set_object_wp get_object_wp)
+  apply (auto elim!: rsubst[where P=P] simp: obj_at_def etcbs_of'_def split: kernel_object.splits)
+  done
 
 lemma set_pt_valid_sched[wp]:
   "\<lbrace>valid_sched\<rbrace> set_pt ptr pt \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
@@ -348,20 +354,14 @@ crunch
   (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp
        subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action)
 
+crunch arch_thread_set
+  for etcbs_of[wp]: "\<lambda>s. P (etcbs_of s)"
+  (wp: set_object_wp)
+
 lemma arch_thread_set_valid_sched[wp]:
   "arch_thread_set f p \<lbrace>valid_sched\<rbrace>"
   by (wpsimp wp: valid_sched_lift arch_thread_set_pred_tcb_at)
 
-lemma arch_thread_set_valid_etcbs[wp]:
-  "arch_thread_set f p \<lbrace>valid_etcbs\<rbrace>"
-  by (wp valid_etcbs_lift)
-
-crunch
-  arch_finalise_cap, prepare_thread_delete
-  for valid_etcbs[wp, DetSchedSchedule_AI_assms]: valid_etcbs
-  (wp: hoare_drop_imps unless_wp select_inv mapM_x_wp mapM_wp subset_refl
-       if_fun_split simp: crunch_simps ignore: set_object thread_set)
-
 crunch
   arch_finalise_cap, prepare_thread_delete
   for simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action
@@ -471,11 +471,9 @@ lemma arch_post_modify_registers_not_idle_thread[DetSchedSchedule_AI_assms]:
 
 crunch arch_post_cap_deletion
   for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched
-  and valid_etcbs[wp, DetSchedSchedule_AI_assms]: valid_etcbs
   and ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q
   and simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action
   and not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t"
-  and is_etcb_at[wp, DetSchedSchedule_AI_assms]: "is_etcb_at t"
   and not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t"
   and sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t"
   and weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action
@@ -490,6 +488,10 @@ crunch
   for arch_finalise_cap[wp, DetSchedSchedule_AI_assms]: "\<lambda>(s:: det_ext state). P (idle_thread s)"
   (wp: crunch_wps simp: if_fun_split)
 
+crunch arch_switch_to_thread
+  for etcbs_of[wp, DetSchedSchedule_AI_assms]: "\<lambda>s. P (etcbs_of s)"
+  and cur_domain[wp, DetSchedSchedule_AI_assms]: "\<lambda>s. P (cur_domain s)"
+
 end
 
 global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI
@@ -508,7 +510,7 @@ lemma dmo_scheduler_act_sane[wp]:
 lemma vgic_maintenance_irq_valid_sched[wp]:
   "\<lbrace>valid_sched and invs and scheduler_act_sane and ct_not_queued\<rbrace>
    vgic_maintenance
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   unfolding vgic_maintenance_def
   supply if_split[split del] valid_fault_def[simp]
   apply (wpsimp simp: get_gic_vcpu_ctrl_misr_def get_gic_vcpu_ctrl_eisr1_def
@@ -530,7 +532,7 @@ lemma vgic_maintenance_irq_valid_sched[wp]:
 lemma vppi_event_irq_valid_sched[wp]:
   "\<lbrace>valid_sched and invs and scheduler_act_sane and ct_not_queued\<rbrace>
    vppi_event irq
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   unfolding vppi_event_def
   supply if_split[split del] valid_fault_def[simp]
   apply (wpsimp simp: if_apply_def2
@@ -550,14 +552,14 @@ lemma vppi_event_irq_valid_sched[wp]:
 lemma handle_hyp_fault_valid_sched[wp]:
   "\<lbrace>valid_sched and invs and st_tcb_at active t and not_queued t and scheduler_act_not t
       and (ct_active or ct_idle)\<rbrace>
-    handle_hypervisor_fault t fault \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+    handle_hypervisor_fault t fault \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   supply if_split[split del]
   by (cases fault; wpsimp wp: handle_fault_valid_sched simp: valid_fault_def isFpuEnable_def)
 
 lemma handle_reserved_irq_valid_sched:
   "\<lbrace>valid_sched and invs and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> scheduler_act_sane s \<and> ct_not_queued s)\<rbrace>
    handle_reserved_irq irq
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   unfolding handle_reserved_irq_def
   apply (wpsimp simp: non_kernel_IRQs_def)
   apply (simp add: irq_vppi_event_index_def)
diff --git a/proof/invariant-abstract/AARCH64/ArchDetype_AI.thy b/proof/invariant-abstract/AARCH64/ArchDetype_AI.thy
index b7a66c2305..d54f1fc929 100644
--- a/proof/invariant-abstract/AARCH64/ArchDetype_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchDetype_AI.thy
@@ -528,9 +528,8 @@ lemma in_user_frame_eq:
                      Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
                      order_class.Icc_eq_Icc
     and [simp] = p2pm1_to_mask
-  shows "p \<notin> untyped_range cap \<Longrightarrow> in_user_frame p
-              (trans_state (\<lambda>_. detype_ext (untyped_range cap) (exst s)) s
-               \<lparr>kheap := \<lambda>x. if x \<in> untyped_range cap then None else kheap s x\<rparr>)
+  shows "p \<notin> untyped_range cap \<Longrightarrow>
+         in_user_frame p (s \<lparr>kheap := \<lambda>x. if x \<in> untyped_range cap then None else kheap s x\<rparr>)
          = in_user_frame p s"
     using cap_is_valid untyped
     apply (cases cap; simp add: in_user_frame_def valid_untyped_def valid_cap_def obj_at_def)
@@ -556,9 +555,7 @@ lemma in_device_frame_eq:
           order_class.Icc_eq_Icc
      and  p2pm1[simp] = p2pm1_to_mask
   shows "p \<notin> untyped_range cap
-       \<Longrightarrow> in_device_frame p
-              (trans_state (\<lambda>_. detype_ext (untyped_range cap) (exst s)) s
-               \<lparr>kheap := \<lambda>x. if x \<in> untyped_range cap then None else kheap s x\<rparr>)
+       \<Longrightarrow> in_device_frame p (s \<lparr>kheap := \<lambda>x. if x \<in> untyped_range cap then None else kheap s x\<rparr>)
          = in_device_frame p s"
     using cap_is_valid untyped
     unfolding in_device_frame_def
diff --git a/proof/invariant-abstract/AARCH64/ArchEmptyFail_AI.thy b/proof/invariant-abstract/AARCH64/ArchEmptyFail_AI.thy
index 8e229505a0..d72e44fb0a 100644
--- a/proof/invariant-abstract/AARCH64/ArchEmptyFail_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchEmptyFail_AI.thy
@@ -164,18 +164,6 @@ crunch
   for (empty_fail) empty_fail[wp, EmptyFail_AI_assms]
 end
 
-global_interpretation EmptyFail_AI_schedule_unit?: EmptyFail_AI_schedule_unit
-proof goal_cases
-  interpret Arch .
-  case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?)
-qed
-
-global_interpretation EmptyFail_AI_schedule_det?: EmptyFail_AI_schedule_det
-proof goal_cases
-  interpret Arch .
-  case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?)
-qed
-
 global_interpretation EmptyFail_AI_schedule?: EmptyFail_AI_schedule
 proof goal_cases
   interpret Arch .
@@ -201,23 +189,10 @@ crunch possible_switch_to, handle_event, activate_thread
          bool.splits apiobject_type.splits aobject_type.splits notification.splits
          thread_state.splits endpoint.splits catch_def sum.splits cnode_invocation.splits
          page_table_invocation.splits page_invocation.splits asid_control_invocation.splits
-         asid_pool_invocation.splits arch_invocation.splits irq_state.splits syscall.splits
-   ignore_del: possible_switch_to)
+         asid_pool_invocation.splits arch_invocation.splits irq_state.splits syscall.splits)
 
 end
 
-global_interpretation EmptyFail_AI_call_kernel_unit?: EmptyFail_AI_call_kernel_unit
-proof goal_cases
-  interpret Arch .
-  case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?)
-qed
-
-global_interpretation EmptyFail_AI_call_kernel_det?: EmptyFail_AI_call_kernel_det
-proof goal_cases
-  interpret Arch .
-  case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?)
-qed
-
 global_interpretation EmptyFail_AI_call_kernel?: EmptyFail_AI_call_kernel
 proof goal_cases
   interpret Arch .
diff --git a/proof/invariant-abstract/AARCH64/ArchInterrupt_AI.thy b/proof/invariant-abstract/AARCH64/ArchInterrupt_AI.thy
index d3948582f8..b9269e64da 100644
--- a/proof/invariant-abstract/AARCH64/ArchInterrupt_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchInterrupt_AI.thy
@@ -269,6 +269,10 @@ lemma handle_reserved_irq_invs[wp]:
   "\<lbrace>invs\<rbrace> handle_reserved_irq irq \<lbrace>\<lambda>_. invs\<rbrace>"
   unfolding handle_reserved_irq_def by (wpsimp simp: non_kernel_IRQs_def)
 
+crunch timer_tick
+  for invs[wp]: invs
+  (wp: thread_set_invs_trivial[OF ball_tcb_cap_casesI])
+
 lemma (* handle_interrupt_invs *) [Interrupt_AI_assms]:
   "\<lbrace>invs\<rbrace> handle_interrupt irq \<lbrace>\<lambda>_. invs\<rbrace>"
   apply (simp add: handle_interrupt_def)
diff --git a/proof/invariant-abstract/AARCH64/ArchInvariants_AI.thy b/proof/invariant-abstract/AARCH64/ArchInvariants_AI.thy
index ee66eb7045..d15c4d5486 100644
--- a/proof/invariant-abstract/AARCH64/ArchInvariants_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchInvariants_AI.thy
@@ -1428,6 +1428,9 @@ lemma tcb_arch_ref_simps[simp]:
   "\<And>f. tcb_arch_ref (tcb_fault_handler_update f tcb) = tcb_arch_ref tcb"
   "\<And>f. tcb_arch_ref (tcb_fault_update f tcb) = tcb_arch_ref tcb"
   "\<And>f. tcb_arch_ref (tcb_bound_notification_update f tcb) = tcb_arch_ref tcb"
+  "\<And>f. tcb_arch_ref (tcb_domain_update f tcb) = tcb_arch_ref tcb"
+  "\<And>f. tcb_arch_ref (tcb_priority_update f tcb) = tcb_arch_ref tcb"
+  "\<And>f. tcb_arch_ref (tcb_time_slice_update f tcb) = tcb_arch_ref tcb"
   "tcb_arch_ref (t\<lparr>tcb_arch := (arch_tcb_context_set a (tcb_arch t))\<rparr>) = tcb_arch_ref t"
   "tcb_arch_ref (tcb\<lparr>tcb_arch := arch_tcb_set_registers regs (tcb_arch tcb)\<rparr>) = tcb_arch_ref tcb"
   by (auto simp: tcb_arch_ref_def arch_tcb_set_registers_def arch_tcb_context_set_def)
@@ -1447,6 +1450,9 @@ lemma hyp_live_tcb_simps[simp]:
   "\<And>f. hyp_live (TCB (tcb_fault_handler_update f tcb)) = hyp_live (TCB tcb)"
   "\<And>f. hyp_live (TCB (tcb_fault_update f tcb)) = hyp_live (TCB tcb)"
   "\<And>f. hyp_live (TCB (tcb_bound_notification_update f tcb)) = hyp_live (TCB tcb)"
+  "\<And>f. hyp_live (TCB (tcb_domain_update f tcb)) = hyp_live (TCB tcb)"
+  "\<And>f. hyp_live (TCB (tcb_priority_update f tcb)) = hyp_live (TCB tcb)"
+  "\<And>f. hyp_live (TCB (tcb_time_slice_update f tcb)) = hyp_live (TCB tcb)"
   by (simp_all add: hyp_live_tcb_def)
 
 lemma wellformed_arch_typ:
diff --git a/proof/invariant-abstract/AARCH64/ArchKHeap_AI.thy b/proof/invariant-abstract/AARCH64/ArchKHeap_AI.thy
index bcd7840fc9..03c350f2b6 100644
--- a/proof/invariant-abstract/AARCH64/ArchKHeap_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchKHeap_AI.thy
@@ -941,7 +941,7 @@ lemma pspace_respects_region_cong[cong]:
 
 definition "obj_is_device tp dev \<equiv>
   case tp of Untyped \<Rightarrow> dev
-    | _ \<Rightarrow>(case (default_object tp dev 0) of (ArchObj (DataPage dev _)) \<Rightarrow> dev
+    | _ \<Rightarrow>(case default_object tp dev 0 0 of (ArchObj (DataPage dev _)) \<Rightarrow> dev
           | _ \<Rightarrow> False)"
 
 lemma cap_is_device_obj_is_device[simp]:
@@ -984,6 +984,30 @@ lemma state_hyp_refs_of_tcb_state_update:
   apply (clarsimp simp add: state_hyp_refs_of_def obj_at_def split: option.splits)
   done
 
+lemma state_hyp_refs_of_tcb_domain_update:
+  "kheap s t = Some (TCB tcb) \<Longrightarrow>
+   state_hyp_refs_of (s\<lparr>kheap := (kheap s)(t \<mapsto> TCB (tcb\<lparr>tcb_domain := d\<rparr>))\<rparr>)
+     = state_hyp_refs_of s"
+  apply (rule all_ext)
+  apply (clarsimp simp add: state_hyp_refs_of_def obj_at_def split: option.splits)
+  done
+
+lemma state_hyp_refs_of_tcb_priority_update:
+  "kheap s t = Some (TCB tcb) \<Longrightarrow>
+   state_hyp_refs_of (s\<lparr>kheap := (kheap s)(t \<mapsto> TCB (tcb\<lparr>tcb_priority := p\<rparr>))\<rparr>)
+     = state_hyp_refs_of s"
+  apply (rule all_ext)
+  apply (clarsimp simp add: state_hyp_refs_of_def obj_at_def split: option.splits)
+  done
+
+lemma state_hyp_refs_of_tcb_time_slice_update:
+  "kheap s t = Some (TCB tcb) \<Longrightarrow>
+   state_hyp_refs_of (s\<lparr>kheap := (kheap s)(t \<mapsto> TCB (tcb\<lparr>tcb_time_slice := ts\<rparr>))\<rparr>)
+     = state_hyp_refs_of s"
+  apply (rule all_ext)
+  apply (clarsimp simp add: state_hyp_refs_of_def obj_at_def split: option.splits)
+  done
+
 lemma valid_vcpu_lift:
   assumes x: "\<And>T p. \<lbrace>typ_at (AArch T) p\<rbrace> f \<lbrace>\<lambda>rv. typ_at (AArch T) p\<rbrace>"
   assumes t: "\<And>p. \<lbrace>typ_at ATCB p\<rbrace> f \<lbrace>\<lambda>rv. typ_at ATCB p\<rbrace>"
@@ -997,7 +1021,7 @@ lemma default_arch_object_not_live[simp]: "\<not> live (ArchObj (default_arch_ob
   by (clarsimp simp: default_arch_object_def live_def hyp_live_def arch_live_def default_vcpu_def
                split: aobject_type.splits)
 
-lemma default_tcb_not_live[simp]: "\<not> live (TCB default_tcb)"
+lemma default_tcb_not_live[simp]: "\<not> live (TCB (default_tcb d))"
   by (clarsimp simp: default_tcb_def default_arch_tcb_def live_def hyp_live_def)
 
 lemma valid_vcpu_same_type:
diff --git a/proof/invariant-abstract/AARCH64/ArchRetype_AI.thy b/proof/invariant-abstract/AARCH64/ArchRetype_AI.thy
index eaa296e016..1b29b4d022 100644
--- a/proof/invariant-abstract/AARCH64/ArchRetype_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchRetype_AI.thy
@@ -183,7 +183,7 @@ lemma valid_untyped_helper [Retype_AI_assms]:
   and     cn   : "caps_no_overlap ptr sz s"
   and     vp   : "valid_pspace s"
   shows "valid_cap c
-           (s\<lparr>kheap := \<lambda>x. if x \<in> set (retype_addrs ptr ty n us) then Some (default_object ty dev us) else kheap s x\<rparr>)"
+           (s\<lparr>kheap := \<lambda>x. if x \<in> set (retype_addrs ptr ty n us) then Some (default_object ty dev us (cur_domain s)) else kheap s x\<rparr>)"
   (is "valid_cap c ?ns")
   proof -
   have obj_at_pres: "\<And>P x. obj_at P x s \<Longrightarrow> obj_at P x ?ns"
@@ -191,7 +191,7 @@ lemma valid_untyped_helper [Retype_AI_assms]:
    (erule pspace_no_overlapC [OF pn _ _ cover vp])
   note blah[simp del] = atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
         Int_atLeastAtMost atLeastatMost_empty_iff
-  have cover':"range_cover ptr sz (obj_bits (default_object ty dev us)) n"
+  have cover':"range_cover ptr sz (obj_bits (default_object ty dev us (cur_domain s))) n"
     using cover tyunt
     by (clarsimp simp:obj_bits_dev_irr)
 
@@ -278,7 +278,7 @@ lemma valid_cap:
   proof -
   note blah[simp del] = atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
         Int_atLeastAtMost atLeastatMost_empty_iff
-  have cover':"range_cover ptr sz (obj_bits (default_object ty dev us)) n"
+  have cover':"range_cover ptr sz (obj_bits (default_object ty dev us (cur_domain s))) n"
     using cover tyunt
     by (clarsimp simp: obj_bits_dev_irr)
   show ?thesis
@@ -292,11 +292,11 @@ lemma valid_cap:
      apply clarsimp
      apply (drule disjoint_subset [OF retype_addrs_obj_range_subset [OF _ cover' tyunt]])
       apply (simp add: Int_ac p_assoc_help[symmetric])
-     apply simp
+     apply fastforce
     apply clarsimp
     apply (drule disjoint_subset [OF retype_addrs_obj_range_subset [OF _ cover' tyunt]])
      apply (simp add: Int_ac p_assoc_help[symmetric])
-    apply simp
+    apply fastforce
     done
   qed
 
@@ -345,7 +345,7 @@ lemma ptes_of:
   by (auto simp: level_pte_of_def obind_def pts_of if_option split: option.splits)
 
 lemma default_empty:
-  "default_object ty dev us = ArchObj (PageTable pt) \<Longrightarrow> pt = (empty_pt (pt_type pt))"
+  "default_object ty dev us d = ArchObj (PageTable pt) \<Longrightarrow> pt = (empty_pt (pt_type pt))"
   by (auto simp: default_object_def default_arch_object_def empty_pt_def tyunt
            split: apiobject_type.splits aobject_type.splits)
 
@@ -665,7 +665,7 @@ lemma pspace_respects_device_regionD:
 
 
 lemma default_obj_dev:
-  "\<lbrakk>ty \<noteq> Untyped;default_object ty dev us = ArchObj (DataPage dev' sz)\<rbrakk> \<Longrightarrow> dev = dev'"
+  "\<lbrakk>ty \<noteq> Untyped;default_object ty dev us d = ArchObj (DataPage dev' sz)\<rbrakk> \<Longrightarrow> dev = dev'"
   by (clarsimp simp: default_object_def default_arch_object_def
               split: apiobject_type.split_asm aobject_type.split_asm)
 
@@ -765,7 +765,7 @@ lemma pspace_respects_device_region:
   apply (rule pspace_respects_device_regionI)
      apply (clarsimp simp add: pspace_respects_device_region_def s'_def ps_def
                         split: if_split_asm )
-      apply (drule retype_addrs_obj_range_subset[OF _ _ tyunt])
+      apply (drule retype_addrs_obj_range_subset[OF _ _ tyunt, where d'="cur_domain s"])
        using cover tyunt
        apply (simp add: obj_bits_api_def3 split: if_splits)
       apply (frule default_obj_dev[OF tyunt],simp)
@@ -779,7 +779,7 @@ lemma pspace_respects_device_region:
      apply fastforce
     apply (clarsimp simp add: pspace_respects_device_region_def s'_def ps_def
                        split: if_split_asm )
-     apply (drule retype_addrs_obj_range_subset[OF _ _ tyunt])
+     apply (drule retype_addrs_obj_range_subset[OF _ _ tyunt, where d'="cur_domain s"])
       using cover tyunt
       apply (simp add: obj_bits_api_def4 split: if_splits)
      apply (frule default_obj_dev[OF tyunt],simp)
diff --git a/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy b/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy
index 01d12ad001..6e5fdf141f 100644
--- a/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy
@@ -37,8 +37,8 @@ lemma arch_stt_tcb [wp,Schedule_AI_assms]:
   "arch_switch_to_thread t' \<lbrace>tcb_at t'\<rbrace>"
   by (wpsimp simp: arch_switch_to_thread_def wp: tcb_at_typ_at)
 
-lemma arch_stt_runnable[Schedule_AI_assms]:
-  "arch_switch_to_thread t \<lbrace>st_tcb_at runnable t\<rbrace>"
+lemma arch_stt_st_tcb_at[Schedule_AI_assms]:
+  "arch_switch_to_thread t \<lbrace>st_tcb_at Q t\<rbrace>"
   by (wpsimp simp: arch_switch_to_thread_def)
 
 lemma idle_strg:
@@ -86,28 +86,19 @@ lemma stit_activatable[Schedule_AI_assms]:
                  elim!: pred_tcb_weaken_strongerE)
   done
 
-lemma stt_invs [wp,Schedule_AI_assms]:
-  "switch_to_thread t' \<lbrace>invs\<rbrace>"
-  apply (simp add: switch_to_thread_def)
-  apply wp
-     apply (simp add: trans_state_update[symmetric] del: trans_state_update)
-    apply (rule_tac Q'="\<lambda>_. invs and tcb_at t'" in hoare_strengthen_post, wp)
-    apply (clarsimp simp: invs_def valid_state_def valid_idle_def
-                          valid_irq_node_def valid_machine_state_def)
-    apply (fastforce simp: cur_tcb_def obj_at_def
-                     elim: valid_pspace_eqI ifunsafe_pspaceI)
-   apply wp+
-  apply clarsimp
-  apply (simp add: is_tcb_def)
-  done
-end
+crunch set_vm_root, vcpu_switch
+  for scheduler_action[wp]: "\<lambda>s. P (scheduler_action s)"
+  (wp: crunch_wps simp: crunch_simps)
 
-interpretation Schedule_AI_U?: Schedule_AI_U
-proof goal_cases
-  interpret Arch .
-  case 1 show ?case
-    by (intro_locales; (unfold_locales; fact Schedule_AI_assms)?)
-qed
+lemma arch_stt_scheduler_action [wp, Schedule_AI_assms]:
+  "\<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace> arch_switch_to_thread t' \<lbrace>\<lambda>_ s. P (scheduler_action s)\<rbrace>"
+  by (wpsimp simp: arch_switch_to_thread_def)
+
+lemma arch_stit_scheduler_action [wp, Schedule_AI_assms]:
+  "\<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_ s. P (scheduler_action s)\<rbrace>"
+  by (wpsimp simp: arch_switch_to_idle_thread_def)
+
+end
 
 interpretation Schedule_AI?: Schedule_AI
 proof goal_cases
diff --git a/proof/invariant-abstract/AARCH64/ArchUntyped_AI.thy b/proof/invariant-abstract/AARCH64/ArchUntyped_AI.thy
index 3a60b1f14a..1b06088640 100644
--- a/proof/invariant-abstract/AARCH64/ArchUntyped_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchUntyped_AI.thy
@@ -154,7 +154,7 @@ lemma retype_ret_valid_caps_captable[Untyped_AI_assms]:
       \<and> range_cover ptr sz (obj_bits_api CapTableObject us) n \<and> ptr \<noteq> 0
        \<rbrakk>
          \<Longrightarrow> \<forall>y\<in>{0..<n}. s
-                \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object CapTableObject dev us)) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api CapTableObject us)) [0..<n])
+                \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object CapTableObject dev us (cur_domain s))) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api CapTableObject us)) [0..<n])
                            (kheap s)\<rparr> \<turnstile> CNodeCap (ptr_add ptr (y * 2 ^ obj_bits_api CapTableObject us)) us []"
 by ((clarsimp simp:valid_cap_def default_object_def cap_aligned_def
         cte_level_bits_def is_obj_defs well_formed_cnode_n_def empty_cnode_def
@@ -167,7 +167,7 @@ lemma retype_ret_valid_caps_aobj[Untyped_AI_assms]:
   \<lbrakk>pspace_no_overlap_range_cover ptr sz s \<and> x6 \<noteq> ASIDPoolObj \<and>
   range_cover ptr sz (obj_bits_api (ArchObject x6) us) n \<and> ptr \<noteq> 0\<rbrakk>
             \<Longrightarrow> \<forall>y\<in>{0..<n}. s
-                   \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object (ArchObject x6) dev us)) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api (ArchObject x6) us)) [0..<n])
+                   \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object (ArchObject x6) dev us (cur_domain s))) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api (ArchObject x6) us)) [0..<n])
                               (kheap s)\<rparr> \<turnstile> ArchObjectCap (arch_default_cap x6 (ptr_add ptr (y * 2 ^ obj_bits_api (ArchObject x6) us)) us dev)"
   apply (rename_tac aobject_type us n)
   apply (case_tac aobject_type)
@@ -338,7 +338,7 @@ lemma nonempty_table_caps_of[Untyped_AI_assms]:
 
 
 lemma nonempty_default[simp, Untyped_AI_assms]:
-  "tp \<noteq> Untyped \<Longrightarrow> \<not> nonempty_table S (default_object tp dev us)"
+  "tp \<noteq> Untyped \<Longrightarrow> \<not> nonempty_table S (default_object tp dev us d)"
   apply (case_tac tp, simp_all add: default_object_def nonempty_table_def a_type_def)
   apply (rename_tac aobject_type)
   apply (case_tac aobject_type; simp add: default_arch_object_def empty_pt_def)
diff --git a/proof/invariant-abstract/AARCH64/ArchVCPU_AI.thy b/proof/invariant-abstract/AARCH64/ArchVCPU_AI.thy
index 35dc4a38bc..7199a17195 100644
--- a/proof/invariant-abstract/AARCH64/ArchVCPU_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchVCPU_AI.thy
@@ -139,10 +139,17 @@ lemma valid_cur_vcpu_arm_vmid_table_upd[simp]:
   "valid_cur_vcpu (s\<lparr>arch_state := arch_state s \<lparr>arm_vmid_table := x \<rparr>\<rparr>) = valid_cur_vcpu s"
   by (clarsimp simp: valid_cur_vcpu_def)
 
-crunch set_vm_root
+lemma active_cur_vcpu_of_ready_queues_upd[simp]:
+  "active_cur_vcpu_of (ready_queues_update f s) = active_cur_vcpu_of s"
+  by (clarsimp simp: active_cur_vcpu_of_def pred_tcb_at_def obj_at_def valid_cur_vcpu_def)
+
+crunch set_vm_root, set_tcb_queue
   for valid_cur_vcpu_cur_thread_update[wp]: "\<lambda>s. valid_cur_vcpu (s\<lparr>cur_thread := t\<rparr>)"
   (wp: valid_cur_vcpu_lift_cur_thread_update)
 
+crunch tcb_sched_action
+  for valid_cur_vcpu_cur_thread_update[wp]: "\<lambda>s. valid_cur_vcpu (s\<lparr>cur_thread := t\<rparr>)"
+
 lemma arch_switch_to_thread_valid_cur_vcpu_cur_thread_update[wp]:
   "\<lbrace>valid_cur_vcpu\<rbrace>
    arch_switch_to_thread t
@@ -155,7 +162,7 @@ lemma arch_switch_to_thread_valid_cur_vcpu_cur_thread_update[wp]:
 lemma switch_to_thread_valid_cur_vcpu[wp]:
   "switch_to_thread t \<lbrace>valid_cur_vcpu\<rbrace>"
   unfolding switch_to_thread_def
-  by (wpsimp simp: valid_cur_vcpu_def active_cur_vcpu_of_def)
+  by wpsimp
 
 lemma arch_switch_to_idle_thread_valid_cur_vcpu_cur_thread_update[wp]:
   "\<lbrace>\<lambda>s. valid_cur_vcpu s \<and> valid_idle s \<and> t = idle_thread s\<rbrace>
@@ -228,32 +235,14 @@ crunch set_thread_state
 crunch activate_thread
   for valid_cur_vcpu[wp]: valid_cur_vcpu
 
-crunch tcb_sched_action
-  for arch_tcb_at[wp]: "arch_tcb_at P t"
-  (simp: tcb_sched_action_def set_tcb_queue_def get_tcb_queue_def)
-
 crunch tcb_sched_action
   for valid_cur_vcpu[wp]: valid_cur_vcpu
   (wp: valid_cur_vcpu_lift_weak)
 
-crunch schedule_choose_new_thread
+crunch schedule
   for valid_cur_vcpu[wp]: valid_cur_vcpu
   (simp: crunch_simps valid_cur_vcpu_def active_cur_vcpu_of_def wp: crunch_wps)
 
-lemma schedule_valid_cur_vcpu_det_ext[wp]:
-  "\<lbrace>valid_cur_vcpu and valid_idle\<rbrace>
-   (schedule :: (unit, det_ext) s_monad)
-   \<lbrace>\<lambda>_. valid_cur_vcpu\<rbrace>"
-  unfolding schedule_def schedule_switch_thread_fastfail_def ethread_get_when_def ethread_get_def
-  by (wpsimp wp: hoare_drop_imps gts_wp)
-
-lemma schedule_valid_cur_vcpu[wp]:
-  "\<lbrace>valid_cur_vcpu and valid_idle\<rbrace>
-   (schedule :: (unit, unit) s_monad)
-   \<lbrace>\<lambda>_. valid_cur_vcpu\<rbrace>"
-  unfolding schedule_def allActiveTCBs_def
-  by wpsimp
-
 crunch cancel_all_ipc, blocked_cancel_ipc, unbind_maybe_notification, cancel_all_signals,
          bind_notification, fast_finalise, deleted_irq_handler, post_cap_deletion, cap_delete_one,
          reply_cancel_ipc, cancel_ipc, update_waiting_ntfn, send_signal, send_ipc, send_fault_ipc,
@@ -309,12 +298,7 @@ lemma send_fault_ipc_arch_tcb_at[wp]:
 
 crunch handle_fault, handle_interrupt, handle_vm_fault, handle_hypervisor_fault, send_signal
   for arch_tcb_at[wp]: "arch_tcb_at P t"
-  (wp: mapM_x_wp_inv crunch_wps)
-
-crunch reschedule_required, set_scheduler_action, tcb_sched_action
-  for arch_tcb_at[wp]: "arch_tcb_at P t"
-  (simp: reschedule_required_def set_scheduler_action_def tcb_sched_action_def set_tcb_queue_def
-         get_tcb_queue_def)
+  (wp: mapM_x_wp_inv crunch_wps thread_set_no_change_tcb_pred)
 
 lemma thread_set_fault_arch_tcb_at[wp]:
   "thread_set (tcb_fault_update f) r \<lbrace>arch_tcb_at P t\<rbrace>"
@@ -504,7 +488,7 @@ lemma valid_cur_vcpu_trans_state[simp]:
 
 crunch restart, reschedule_required, possible_switch_to, thread_set_priority
   for arch_tcb_at[wp]: "arch_tcb_at P t"
-  (simp: possible_switch_to_def set_tcb_queue_def get_tcb_queue_def)
+  (wp: thread_set_no_change_tcb_pred)
 
 crunch restart, reschedule_required, possible_switch_to, thread_set_priority
   for valid_cur_vcpu[wp]: valid_cur_vcpu
@@ -535,13 +519,6 @@ crunch set_mcpriority, set_priority
   for valid_cur_vcpu[wp]: valid_cur_vcpu
   (simp: set_priority_def)
 
-lemma ethread_set_state_hyp_refs_of[wp]:
-  "ethread_set f t \<lbrace>\<lambda>s. P (state_hyp_refs_of s)\<rbrace>"
-  unfolding ethread_set_def set_eobject_def
-  apply wp
-  apply (clarsimp dest!: get_tcb_SomeD)
-  done
-
 crunch tcb_sched_action, possible_switch_to, set_scheduler_action, reschedule_required
   for state_hyp_refs_of[wp]: "\<lambda>s. P (state_hyp_refs_of s)"
   (simp: tcb_sched_action_def set_tcb_queue_def get_tcb_queue_def possible_switch_to_def
@@ -568,7 +545,7 @@ crunch invoke_domain
   and arch_tcb_at[wp]: "arch_tcb_at P t"
   and cur_thread[wp]: "\<lambda>s. P (cur_thread s)"
   and valid_cur_vcpu[wp]: valid_cur_vcpu
-  (wp: valid_cur_vcpu_lift_weak)
+  (wp: valid_cur_vcpu_lift_weak thread_set_no_change_tcb_pred)
 
 crunch perform_asid_control_invocation
   for cur_thread[wp]: "\<lambda>s. P (cur_thread s )"
@@ -637,16 +614,7 @@ lemma handle_event_valid_cur_vcpu:
 
 lemma call_kernel_valid_cur_vcpu:
   "\<lbrace>valid_cur_vcpu and invs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_active s)\<rbrace>
-   (call_kernel e) :: (unit, unit) s_monad
-   \<lbrace>\<lambda>_ . valid_cur_vcpu\<rbrace>"
-  unfolding call_kernel_def
-  apply (simp flip: bind_assoc)
-  by (wpsimp wp: handle_event_valid_cur_vcpu hoare_vcg_if_lift2 hoare_drop_imps
-      | strengthen invs_valid_idle)+
-
-lemma call_kernel_valid_cur_vcpu_det_ext:
-  "\<lbrace>valid_cur_vcpu and invs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_active s)\<rbrace>
-   (call_kernel e) :: (unit, det_ext) s_monad
+   call_kernel e
    \<lbrace>\<lambda>_ . valid_cur_vcpu\<rbrace>"
   unfolding call_kernel_def
   apply (simp flip: bind_assoc)
diff --git a/proof/invariant-abstract/AARCH64/ArchVSpaceEntries_AI.thy b/proof/invariant-abstract/AARCH64/ArchVSpaceEntries_AI.thy
index 738278552e..67601e5d64 100644
--- a/proof/invariant-abstract/AARCH64/ArchVSpaceEntries_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchVSpaceEntries_AI.thy
@@ -131,15 +131,11 @@ lemma invoke_cnode_valid_vspace_objs'[wp]:
   unfolding invoke_cnode_def
   by (wpsimp wp: get_cap_wp split_del: if_split)
 
-crunch invoke_tcb
+crunch invoke_tcb, invoke_domain
   for valid_vspace_objs'[wp]: "valid_vspace_objs'"
   (wp: check_cap_inv crunch_wps simp: crunch_simps
        ignore: check_cap_at)
 
-lemma invoke_domain_valid_vspace_objs'[wp]:
-  "\<lbrace>valid_vspace_objs'\<rbrace> invoke_domain t d \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
-  by (simp add: invoke_domain_def | wp)+
-
 crunch set_extra_badge, transfer_caps_loop
   for valid_vspace_objs'[wp]: "valid_vspace_objs'"
   (rule: transfer_caps_loop_pres)
@@ -291,7 +287,8 @@ lemma handle_invocation_valid_vspace_objs'[wp]:
 
 crunch activate_thread,switch_to_thread, handle_hypervisor_fault,
        switch_to_idle_thread, handle_call, handle_recv, handle_reply,
-       handle_send, handle_yield, handle_interrupt
+       handle_send, handle_yield, handle_interrupt,
+       schedule_choose_new_thread
   for valid_vspace_objs'[wp]: "valid_vspace_objs'"
   (simp: crunch_simps wp: crunch_wps OR_choice_weak_wp select_ext_weak_wp
       ignore: without_preemption getActiveIRQ resetTimer ackInterrupt
@@ -302,15 +299,12 @@ lemma handle_event_valid_vspace_objs'[wp]:
   by (case_tac e; simp) (wpsimp simp: Let_def handle_vm_fault_def | wp (once) hoare_drop_imps)+
 
 lemma schedule_valid_vspace_objs'[wp]:
-  "\<lbrace>valid_vspace_objs'\<rbrace> schedule :: (unit,unit) s_monad \<lbrace>\<lambda>_. valid_vspace_objs'\<rbrace>"
-  apply (simp add: schedule_def allActiveTCBs_def)
-  apply wp
-  apply simp
-  done
+  "\<lbrace>valid_vspace_objs'\<rbrace> schedule \<lbrace>\<lambda>_. valid_vspace_objs'\<rbrace>"
+  unfolding schedule_def by (wpsimp wp: hoare_drop_imps)
 
 lemma call_kernel_valid_vspace_objs'[wp]:
   "\<lbrace>invs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running s) and valid_vspace_objs'\<rbrace>
-      (call_kernel e) :: (unit,unit) s_monad
+   call_kernel e
    \<lbrace>\<lambda>_. valid_vspace_objs'\<rbrace>"
   apply (cases e, simp_all add: call_kernel_def)
       apply (rule hoare_pre)
diff --git a/proof/invariant-abstract/AARCH64/ArchVSpace_AI.thy b/proof/invariant-abstract/AARCH64/ArchVSpace_AI.thy
index 48bb3f688a..6eb5ae2a2f 100644
--- a/proof/invariant-abstract/AARCH64/ArchVSpace_AI.thy
+++ b/proof/invariant-abstract/AARCH64/ArchVSpace_AI.thy
@@ -2580,7 +2580,7 @@ lemma valid_vspace_obj_default:
   assumes "ty \<noteq> Structures_A.apiobject_type.Untyped"
   assumes "ty = ArchObject VSpaceObj \<Longrightarrow> level = max_pt_level"
   assumes "ty = ArchObject PageTableObj \<Longrightarrow> level \<noteq> max_pt_level"
-  shows "ArchObj ao = default_object ty dev us \<Longrightarrow> valid_vspace_obj level ao s'"
+  shows "ArchObj ao = default_object ty dev us d \<Longrightarrow> valid_vspace_obj level ao s'"
   by (cases ty; simp add: default_object_def assms)
 
 
diff --git a/proof/invariant-abstract/ADT_AI.thy b/proof/invariant-abstract/ADT_AI.thy
index 9ae0cf8f98..4cd6033cb0 100644
--- a/proof/invariant-abstract/ADT_AI.thy
+++ b/proof/invariant-abstract/ADT_AI.thy
@@ -244,7 +244,7 @@ text \<open>
    in restore_user_context, which is currently invisible to verification.
    The effect should be modelled in the ADT. *)
 definition
-  kernel_entry :: "event \<Rightarrow> user_context \<Rightarrow> (user_context,'z::state_ext_sched) s_monad"
+  kernel_entry :: "event \<Rightarrow> user_context \<Rightarrow> (user_context,'z::state_ext) s_monad"
   where
   "kernel_entry e tc \<equiv> do
     t \<leftarrow> gets cur_thread;
@@ -257,7 +257,7 @@ definition
 
 definition
   kernel_call_A
-    :: "event \<Rightarrow> ((user_context \<times> ('a::state_ext_sched state)) \<times> mode \<times> (user_context \<times> 'a state)) set"
+    :: "event \<Rightarrow> ((user_context \<times> ('a::state_ext state)) \<times> mode \<times> (user_context \<times> 'a state)) set"
   where
   "kernel_call_A e \<equiv>
       {(s, m, s'). s' \<in> fst (split (kernel_entry e) s) \<and>
@@ -279,7 +279,7 @@ definition
   "abs_state s \<equiv> s\<lparr>machine_state:= observable_memory (machine_state s) (user_mem s)\<rparr>"
 
 definition
-  ADT_A :: "user_transition \<Rightarrow> (('a::state_ext_sched state) global_state, 'a observable, unit) data_type"
+  ADT_A :: "user_transition \<Rightarrow> (('a::state_ext state) global_state, 'a observable, unit) data_type"
 where
  "ADT_A uop \<equiv>
   \<lparr> Init = \<lambda>s. Init_A, Fin = \<lambda>((tc,s),m,e). ((tc, abs_state s),m,e),
diff --git a/proof/invariant-abstract/BCorres2_AI.thy b/proof/invariant-abstract/BCorres2_AI.thy
index bb2bd420c2..60ab8c8478 100644
--- a/proof/invariant-abstract/BCorres2_AI.thy
+++ b/proof/invariant-abstract/BCorres2_AI.thy
@@ -22,29 +22,12 @@ locale BCorres2_AI =
     "\<And> a b.
       bcorres (make_arch_fault_msg a b :: 'a state \<Rightarrow> _)
               (make_arch_fault_msg a b)"
-  assumes arch_switch_to_thread_bcorres[wp]:
-    "\<And>t. bcorres (arch_switch_to_thread t :: 'a state \<Rightarrow> _)
-        (arch_switch_to_thread t)"
-  assumes arch_switch_to_idle_thread_bcorres[wp]:
-    "bcorres (arch_switch_to_idle_thread :: 'a state \<Rightarrow> _)
-        arch_switch_to_idle_thread"
-
-crunch deleting_irq_handler
-  for (bcorres) bcorres[wp]: truncate_state
-  (simp: gets_the_def swp_def)
-
-lemma update_restart_pc_bcorres[wp]:
-  "bcorres (update_restart_pc t) (update_restart_pc t)"
-  by (wp
-      | clarsimp simp: update_restart_pc_def as_user_def bind_select_f_bind'
-                split: prod.splits)+
-
-crunch suspend, finalise_cap
-  for (bcorres) bcorres[wp]: truncate_state
 
 definition all_but_exst where
   "all_but_exst P \<equiv> (\<lambda>s. P (kheap s) (cdt s) (is_original_cap s)
                       (cur_thread s) (idle_thread s)
+                      (scheduler_action s) (domain_list s) (domain_index s)
+                      (cur_domain s) (domain_time s) (ready_queues s)
                       (machine_state s) (interrupt_irq_node s)
                       (interrupt_states s) (arch_state s))"
 
@@ -55,26 +38,32 @@ lemma ef_mk_ef: "empty_fail f \<Longrightarrow> mk_ef (f s) = f s"
   apply force
   done
 
-lemma all_but_obvious: "all_but_exst (\<lambda>a b c d e f g h i.
-                    x = \<lparr>kheap = a, cdt = b, is_original_cap = c,
-                     cur_thread = d, idle_thread = e,
-                     machine_state = f, interrupt_irq_node = g,
-                     interrupt_states = h, arch_state = i, exst = (exst x)\<rparr>) x"
+lemma all_but_obvious:
+  "all_but_exst (\<lambda>kheap cdt is_original_cap cur_thread idle_thread
+       scheduler_action domain_list domain_index cur_domain domain_time
+       ready_queues machine_state interrupt_irq_node interrupt_states arch_state.
+       x = \<lparr>kheap = kheap, cdt = cdt, is_original_cap = is_original_cap, cur_thread = cur_thread,
+            idle_thread = idle_thread, scheduler_action = scheduler_action,
+            domain_list = domain_list, domain_index = domain_index, cur_domain = cur_domain,
+            domain_time = domain_time, ready_queues = ready_queues,
+            machine_state = machine_state, interrupt_irq_node = interrupt_irq_node,
+            interrupt_states = interrupt_states, arch_state = arch_state,
+         exst = (exst x)\<rparr>) x"
   apply (simp add: all_but_exst_def)
   done
 
-lemma bluh: assumes a: "x =
-        \<lparr>kheap = kheap ba, cdt = cdt ba,
-           is_original_cap = is_original_cap ba,
-           cur_thread = cur_thread ba, idle_thread = idle_thread ba,
-           machine_state = machine_state ba,
-           interrupt_irq_node = interrupt_irq_node ba,
-           interrupt_states = interrupt_states ba,
-           arch_state = arch_state ba, exst = exst x\<rparr>"
-     shows "x\<lparr>exst := exst ba\<rparr> = ba"
-  apply (subst a)
-  apply simp
-  done
+crunch deleting_irq_handler
+  for (bcorres) bcorres[wp]: truncate_state
+  (simp: gets_the_def swp_def)
+
+lemma update_restart_pc_bcorres[wp]:
+  "bcorres (update_restart_pc t) (update_restart_pc t)"
+  by (wp
+      | clarsimp simp: update_restart_pc_def as_user_def bind_select_f_bind'
+                split: prod.splits)+
+
+crunch suspend, finalise_cap
+  for (bcorres) bcorres[wp]: truncate_state
 
 lemma valid_cs_trans_state[simp]: "valid_cs a b (trans_state g s) = valid_cs a b s"
   by(simp add: valid_cs_def)
@@ -126,13 +115,14 @@ locale is_extended' =
 
 context is_extended' begin
 
-lemmas v = use_valid[OF _ a, OF _ all_but_obvious,simplified all_but_exst_def, THEN bluh]
+lemmas v = use_valid[OF _ a, OF _ all_but_obvious,simplified all_but_exst_def]
 
-lemma ex_st: "(a,x :: det_ext state) \<in> fst (f s) \<Longrightarrow>
-       \<exists>e :: det_ext. x = (trans_state (\<lambda>_. e) s)"
+lemma ex_st:
+  "(a,x :: det_ext state) \<in> fst (f s) \<Longrightarrow> \<exists>e :: det_ext. x = (trans_state (\<lambda>_. e) s)"
   apply (drule v)
   apply (simp add: trans_state_update')
   apply (rule_tac x="exst x" in exI)
+  apply (cases s)
   apply simp
   done
 
@@ -232,6 +222,13 @@ locale is_extended = is_extended' +
 
 context is_extended begin
 
+lemma in_f_exst:
+  "(r, s') \<in> fst (f s) \<Longrightarrow> s\<lparr>exst := exst s'\<rparr> = s'"
+  apply (drule v)
+  apply (cases s)
+  apply simp
+  done
+
 lemma dxo_eq[simp]:
   "do_extended_op f = f"
   apply (simp add: do_extended_op_def all_but_exst_def
@@ -242,7 +239,7 @@ lemma dxo_eq[simp]:
   apply rule
    apply simp
    apply safe
-     apply (simp | force | frule v)+
+     apply (simp | force | frule in_f_exst)+
   done
 
 end
@@ -253,8 +250,7 @@ lemma all_but_exst_update[simp]:
   apply (simp add: all_but_exst_def)
   done
 
-crunch set_scheduler_action,tcb_sched_action,next_domain,
-                         cap_move_ext
+crunch cap_move_ext
   for all_but_exst[wp]: "all_but_exst P"
   (simp: Let_def ignore_del: tcb_sched_action cap_move_ext)
 
@@ -262,15 +258,6 @@ crunch cap_move_ext
   for (empty_fail) empty_fail[wp]
   (ignore_del: cap_move_ext)
 
-global_interpretation set_scheduler_action_extended: is_extended "set_scheduler_action a"
-  by (unfold_locales; wp)
-
-global_interpretation tcb_sched_action_extended: is_extended "tcb_sched_action a b"
-  by (unfold_locales; wp)
-
-global_interpretation next_domain_extended: is_extended "next_domain"
-  by (unfold_locales; wp)
-
 global_interpretation cap_move_ext: is_extended "cap_move_ext a b c d"
   by (unfold_locales; wp)
 
@@ -353,12 +340,9 @@ lemma check_cap_at_bcorres[wp]: "bcorres f f' \<Longrightarrow> bcorres (check_c
   apply (wp | simp)+
   done
 
-lemma invoke_domain_bcorres[wp]: "bcorres (invoke_domain t d) (invoke_domain t d)"
-  by (simp add: invoke_domain_def, wp)
-
-lemma truncate_state_detype[simp]: "truncate_state (detype x s) = detype x (truncate_state s)"
-  apply (simp add: detype_def trans_state_def)
-  done
+lemma truncate_state_detype[simp]:
+  "truncate_state (detype x s) = detype x (truncate_state s)"
+  by (simp add: detype_def)
 
 lemma resolve_address_bits'_sbcorres:
   shows
@@ -458,23 +442,6 @@ lemma bcorres_underlying_dest: "bcorres_underlying l f k \<Longrightarrow> ((),s
   apply force
   done
 
-lemma trans_state_twice[simp]: "trans_state (\<lambda>_. e) (trans_state f s) = trans_state (\<lambda>_. e) s"
-  by (rule trans_state_update'')
-
-lemma guarded_sub_switch: "((),x) \<in> fst (guarded_switch_to word s) \<Longrightarrow>
-       ((),x) \<in> fst (switch_to_thread word s)
-       \<and> (\<exists>y. get_tcb word s = Some y \<and> runnable (tcb_state y))"
-  apply (clarsimp simp add: guarded_switch_to_def bind_def
-                            get_thread_state_def
-                            thread_get_def
-                            in_monad)
-  done
-
-lemma truncate_state_updates[simp]:
-  "truncate_state (scheduler_action_update f s) = truncate_state s"
-  "truncate_state (ready_queues_update g s) = truncate_state s"
-  by (rule trans_state_update'')+
-
 lemma get_before_assert_opt:
   "do s \<leftarrow> assert_opt x; s' \<leftarrow> get; f s s' od
     = do s' \<leftarrow> get; s \<leftarrow> assert_opt x; f s s' od"
@@ -492,128 +459,10 @@ lemma get_outside_alternative:
     = do s \<leftarrow> get; alternative (f s) g od"
   by (simp add: alternative_def exec_get fun_eq_iff)
 
-lemmas schedule_unfold_all = schedule_def allActiveTCBs_def
-                        get_thread_state_def thread_get_def getActiveTCB_def
-
-context BCorres2_AI begin
-
-lemma switch_thread_bcorreses:
-  "bcorres (switch_to_idle_thread :: 'a state \<Rightarrow> _) switch_to_idle_thread"
-  "bcorres (switch_to_thread t :: 'a state \<Rightarrow> _) (switch_to_thread t)"
-  apply (simp_all add: switch_to_idle_thread_def switch_to_thread_def)
-  apply (wp | simp)+
-  done
-
-lemma guarded_switch_bcorres: "s_bcorres (guarded_switch_to t :: 'a state \<Rightarrow> _) schedule s"
-  using switch_thread_bcorreses(2)[where t=t]
-  apply (clarsimp simp: schedule_unfold_all s_bcorres_underlying_def
-                        in_monad in_select
-            split del: if_split)
-  apply (drule guarded_sub_switch)
-  apply (rule_tac x=t in exI, clarsimp split del: if_split)
-  apply (drule_tac s=s in drop_sbcorres_underlying)
-  apply (clarsimp simp: s_bcorres_underlying_def)
-  apply (auto intro!: alternative_second)
-  done
-
-end
-
-lemma choose_thread_bcorres: "BCorres2_AI TYPE(det_ext)
-    \<Longrightarrow> s_bcorres choose_thread schedule s"
-  apply (frule BCorres2_AI.switch_thread_bcorreses(1))
-  apply (simp add: choose_thread_def gets_def s_bcorres_get_left
-                   BCorres2_AI.guarded_switch_bcorres)
-  apply (clarsimp simp: schedule_def s_bcorres_underlying_def)
-  apply (drule_tac s=s in drop_sbcorres_underlying)
-  apply (clarsimp simp: s_bcorres_underlying_def)
-  apply (auto intro!: alternative_second simp: exec_gets)
-  done
-
-lemma tcb_sched_action_bcorres:
-  "bcorres (tcb_sched_action a b) (return ())"
-  by (clarsimp simp: bcorres_underlying_def s_bcorres_underlying_def return_def
-              dest!: tcb_sched_action_extended.ex_st)
-
 (* FIXME move if useful *)
 lemma if_s_bcorres_underlying[wp]:
   "(P \<Longrightarrow> s_bcorres_underlying t f f' s) \<Longrightarrow> (\<not>P \<Longrightarrow> s_bcorres_underlying t g g' s)
   \<Longrightarrow> s_bcorres_underlying t (if P then f else g) (if P then f' else g') s"
   by (simp add: return_s_bcorres_underlying)
 
-lemma schedule_choose_new_thread_bcorres1:
-  "BCorres2_AI TYPE(det_ext) \<Longrightarrow> bcorres schedule_choose_new_thread schedule"
-  unfolding schedule_choose_new_thread_def
-  apply (clarsimp simp: bcorres_underlying_def)
-  apply (simp add: schedule_det_ext_ext_def s_bcorres_get_left
-                   gets_def get_thread_state_def thread_get_def gets_the_def
-                   bind_assoc get_before_assert_opt ethread_get_def schedule_switch_thread_fastfail_def
-                   when_def)
-  apply (rule conjI; clarsimp)
-   apply (rule s_bcorres_underlying_split[where g'="\<lambda>_. return ()",
-                  OF _ choose_thread_bcorres, simplified]
-               s_bcorres_underlying_split[where f'="return ()", simplified]
-         | fastforce simp: s_bcorres_underlying_def set_scheduler_action_def
-                           when_def exec_gets simpler_modify_def return_def
-                           next_domain_def Let_def)+
-  done
-
-lemma schedule_bcorres1:
-  notes bsplits =
-          s_bcorres_underlying_split[where g'="\<lambda>_. return ()",
-                                     OF _ choose_thread_bcorres, simplified]
-          s_bcorres_underlying_split[where g'="\<lambda>_. return ()",
-                                     OF _ BCorres2_AI.guarded_switch_bcorres, simplified]
-          s_bcorres_underlying_split[where f'="return ()", simplified]
-  notes bdefs = schedule_det_ext_ext_def s_bcorres_get_left
-                gets_def get_thread_state_def thread_get_def gets_the_def
-                bind_assoc get_before_assert_opt ethread_get_def
-                schedule_switch_thread_fastfail_def when_def
-                tcb_sched_action_bcorres drop_sbcorres_underlying return_s_bcorres_underlying
-  notes unfolds = s_bcorres_underlying_def set_scheduler_action_def
-                   simpler_modify_def return_def
-  shows "BCorres2_AI TYPE(det_ext) \<Longrightarrow> bcorres (schedule :: (unit,det_ext) s_monad) schedule"
-  supply if_split[split del]
-  apply (clarsimp simp: bcorres_underlying_def fail_def)
-  apply (simp add: bdefs)
-  apply (simp add: assert_opt_def)
-  apply (simp split: option.split, intro conjI impI)
-   apply (simp add: s_bcorres_underlying_def fail_def)
-  apply clarsimp
-  apply (split scheduler_action.split, intro conjI impI)
-    (* resume current *)
-    subgoal for s
-      apply (clarsimp simp: s_bcorres_underlying_def schedule_def allActiveTCBs_def
-                            in_monad in_select getActiveTCB_def
-                       split: if_split)
-      apply (fastforce simp add: switch_to_idle_thread_def in_monad in_select ex_bool_eq)
-      done
-   (* switch to *)
-   subgoal for s cttcb
-     apply clarsimp
-     apply (rule bsplits)+
-      apply (simp add: bdefs)
-      apply (simp add: assert_opt_def)
-      apply (split option.split, simp, intro conjI impI)
-       apply (simp add: s_bcorres_underlying_def fail_def)
-
-      apply (clarsimp simp: ethread_get_when_def split: if_split)
-
-      apply (rule conjI; clarsimp)
-       apply (simp add: bdefs)
-       apply (simp add: assert_opt_def)
-       apply (split option.split, simp, intro conjI impI)
-        apply (simp add: s_bcorres_underlying_def fail_def)
-
-       apply (clarsimp simp: bdefs split: if_split
-              | rule conjI
-              | rule bsplits
-              | erule drop_sbcorres_underlying[OF schedule_choose_new_thread_bcorres1]
-              | fastforce simp: unfolds)+
-     done
-  apply (clarsimp simp: bdefs split: if_split
-         | rule conjI
-         | rule bsplits
-         | erule drop_sbcorres_underlying[OF schedule_choose_new_thread_bcorres1])+
-  done
-
 end
diff --git a/proof/invariant-abstract/BCorres_AI.thy b/proof/invariant-abstract/BCorres_AI.thy
index 90e3432323..fbb652bcf3 100644
--- a/proof/invariant-abstract/BCorres_AI.thy
+++ b/proof/invariant-abstract/BCorres_AI.thy
@@ -16,25 +16,6 @@ abbreviation "bcorres \<equiv> bcorres_underlying truncate_state"
 
 abbreviation "s_bcorres \<equiv> s_bcorres_underlying truncate_state"
 
-crunch_ignore (bcorres)
-  (add: Nondet_Monad.bind gets modify get put do_extended_op empty_slot_ext mapM_x "when"
-        select unless mapM catch bindE liftE whenE alternative cap_swap_ext
-        cap_insert_ext cap_move_ext liftM create_cap_ext
-        possible_switch_to reschedule_required set_priority
-        set_thread_state_ext tcb_sched_action timer_tick
-        lookup_error_on_failure getActiveIRQ
-        gets_the liftME zipWithM_x unlessE mapME_x handleE forM_x)
-
-context Arch begin arch_global_naming
-
-crunch arch_post_cap_deletion
-  for (bcorres) bcorres[wp]: truncate_state
-
-end
-
-arch_requalify_facts
-  arch_post_cap_deletion_bcorres
-
 lemma dxo_bcorres[wp]:
   "bcorres (do_extended_op f) (do_extended_op f)"
   apply (simp add: do_extended_op_def)
@@ -68,11 +49,28 @@ lemma OR_choiceE_bcorres[wp]:
   apply force
   done
 
+crunch_ignore (bcorres)
+  (add: Nondet_Monad.bind gets modify get put do_extended_op empty_slot_ext mapM_x "when"
+        select unless mapM catch bindE liftE whenE alternative cap_swap_ext
+        cap_insert_ext cap_move_ext liftM create_cap_ext
+        lookup_error_on_failure getActiveIRQ
+        gets_the liftME zipWithM_x unlessE mapME_x handleE forM_x)
+
 lemma bcorres_select_ext[wp]:
   "bcorres (select_ext a A) (select_ext a A)"
   by (clarsimp simp: select_ext_def bind_def gets_def return_def select_def assert_def get_def
                      select_switch_unit_def bcorres_underlying_def s_bcorres_underlying_def fail_def)
 
+context Arch begin arch_global_naming
+
+crunch arch_post_cap_deletion
+  for (bcorres) bcorres[wp]: truncate_state
+
+end
+
+arch_requalify_facts
+  arch_post_cap_deletion_bcorres
+
 crunch
   set_original, set_object, set_cap, set_irq_state, deleted_irq_handler, get_cap,set_cdt, empty_slot
   for (bcorres) bcorres[wp]: truncate_state
@@ -120,6 +118,10 @@ lemma is_final_cap_bcorres[wp]:
 lemma get_tcb_truncate[simp]: "get_tcb a (truncate_state s) = get_tcb a s"
   by (simp add: get_tcb_def)
 
+lemma set_tcb_queue_bcorres[wp]:
+  "bcorres (set_tcb_queue a b c) (set_tcb_queue a b c)"
+  by (wpsimp simp: set_tcb_queue_def cong: if_cong)
+
 crunch
   cancel_all_ipc, cancel_all_signals, unbind_maybe_notification, unbind_notification, bind_notification
   for (bcorres) bcorres[wp]: truncate_state
diff --git a/proof/invariant-abstract/CSpaceInv_AI.thy b/proof/invariant-abstract/CSpaceInv_AI.thy
index 1c04ad3cfe..c5b390470d 100644
--- a/proof/invariant-abstract/CSpaceInv_AI.thy
+++ b/proof/invariant-abstract/CSpaceInv_AI.thy
@@ -352,13 +352,6 @@ lemma gbn_bound_tcb:
   apply (clarsimp simp: pred_tcb_at_def)
   done
 
-lemma allActiveTCBs_valid_state:
-  "\<lbrace>valid_state\<rbrace> allActiveTCBs \<lbrace>\<lambda>R s. valid_state s \<and> (\<forall>t \<in> R. st_tcb_at runnable t s) \<rbrace>"
-  apply (simp add: allActiveTCBs_def, wp)
-  apply (simp add: getActiveTCB_def pred_tcb_at_def obj_at_def get_tcb_def
-              split: option.splits if_split_asm Structures_A.kernel_object.splits)
-  done
-
 
 definition
   cap_master_cap :: "cap \<Rightarrow> cap"
@@ -1699,14 +1692,6 @@ lemma cap_insert_typ_at [wp]:
          |simp split del: if_split)+
   done
 
-lemma cur_mdb [simp]:
-  "cur_tcb (cdt_update f s) = cur_tcb s"
-  by (simp add: cur_tcb_def)
-
-lemma cur_tcb_more_update[iff]:
-  "cur_tcb (trans_state f s) = cur_tcb s"
-  by (simp add: cur_tcb_def)
-
 crunch cap_insert
   for cur[wp]: cur_tcb (wp: hoare_drop_imps)
 
@@ -1803,10 +1788,6 @@ lemma valid_cap_free_index_update[simp]:
   done
 
 
-lemma ex_nonz_cap_to_more_update[iff]:
-  "ex_nonz_cap_to w (trans_state f s) = ex_nonz_cap_to w s"
-   by (simp add: ex_nonz_cap_to_def)
-
 lemma cap_insert_ex_cap:
   "\<lbrace>ex_nonz_cap_to p\<rbrace>
      cap_insert cap src dest
diff --git a/proof/invariant-abstract/CSpace_AI.thy b/proof/invariant-abstract/CSpace_AI.thy
index ce1073f672..9f04205ef8 100644
--- a/proof/invariant-abstract/CSpace_AI.thy
+++ b/proof/invariant-abstract/CSpace_AI.thy
@@ -3864,22 +3864,10 @@ lemma cap_insert_vms[wp]:
   apply (wp get_object_wp get_cap_wp| simp only: vms_ioc_update | rule hoare_drop_imp | simp split del: if_split)+
   done
 
-lemma valid_irq_states_cdt_update[simp]:
-  "valid_irq_states (s\<lparr>cdt := x\<rparr>) = valid_irq_states s"
-  by(auto simp: valid_irq_states_def)
-
-lemma valid_irq_states_is_original_cap_update[simp]:
-  "valid_irq_states (s\<lparr>is_original_cap := x\<rparr>) = valid_irq_states s"
-  by(auto simp: valid_irq_states_def)
-
 crunch cap_insert
   for valid_irq_states[wp]: "valid_irq_states"
   (wp: crunch_wps simp: crunch_simps)
 
-lemma valid_irq_states_exst_update[simp]:
-  "valid_irq_states (s\<lparr>exst := x\<rparr>) = valid_irq_states s"
-  by(auto simp: valid_irq_states_def)
-
 
 context CSpace_AI_cap_insert begin
 
diff --git a/proof/invariant-abstract/DetSchedAux_AI.thy b/proof/invariant-abstract/DetSchedAux_AI.thy
index 8f1b4eb67b..f939efd0f5 100644
--- a/proof/invariant-abstract/DetSchedAux_AI.thy
+++ b/proof/invariant-abstract/DetSchedAux_AI.thy
@@ -8,88 +8,34 @@ theory DetSchedAux_AI
 imports DetSchedInvs_AI
 begin
 
-crunch_ignore (del:
-  cap_swap_ext cap_move_ext cap_insert_ext empty_slot_ext create_cap_ext tcb_sched_action
-  reschedule_required set_thread_state_ext
-  possible_switch_to timer_tick set_priority retype_region_ext)
-
-crunch_ignore (add: do_extended_op)
-
-crunch update_cdt_list
-  for ekheap[wp]: "\<lambda>s. P (ekheap s)"
-crunch update_cdt_list
-  for rqueues[wp]: "\<lambda>s. P (ready_queues s)"
-crunch update_cdt_list
-  for schedact[wp]: "\<lambda>s. P (scheduler_action s)"
-crunch update_cdt_list
-  for cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
-
-crunch create_cap, cap_insert
-  for ekheap[wp]: "\<lambda>s :: det_ext state. P (ekheap s)" (wp: crunch_wps)
-
-crunch create_cap, cap_insert
-  for rqueues[wp]: "\<lambda>s :: det_ext state. P (ready_queues s)" (wp: crunch_wps)
-
-crunch create_cap, cap_insert
-  for schedact[wp]: "\<lambda>s :: det_ext state. P (scheduler_action s)" (wp: crunch_wps)
-
-crunch create_cap, cap_insert
-  for cur_domain[wp]: "\<lambda>s :: det_ext state. P (cur_domain s)" (wp: crunch_wps)
-
-lemma create_cap_ct[wp]: "\<lbrace>\<lambda>s. P (cur_thread s)\<rbrace> create_cap a b c d e \<lbrace>\<lambda>r s. P (cur_thread s)\<rbrace>"
-  apply (simp add: create_cap_def)
-  apply (rule hoare_pre)
-   apply (wp dxo_wp_weak | wpc | simp)+
-  done
-
-crunch create_cap,cap_insert,set_cap
-  for valid_etcbs[wp]: valid_etcbs (wp: valid_etcbs_lift set_cap_typ_at)
-
-lemma valid_etcb_fold_update: "valid_etcbs_2 ekh kh \<Longrightarrow> type \<noteq> apiobject_type.Untyped \<Longrightarrow> valid_etcbs_2
-          (foldr (\<lambda>p ekh. ekh(p := default_ext type cdom))
-            ptrs
-            ekh)
-          (foldr (\<lambda>p kh. kh(p \<mapsto> default_object type dev o_bits))
-            ptrs
-            kh)"
-  apply (induct ptrs)
-  apply simp
-  apply (case_tac type)
-  apply (clarsimp simp add: valid_etcbs_def st_tcb_at_kh_def obj_at_kh_def obj_at_def is_etcb_at_def default_object_def default_ext_def)+
+arch_requalify_facts
+  init_arch_objects_typ_at
+  init_arch_objects_pred_tcb_at
+  init_arch_objects_cur_thread
+
+lemmas [wp] =
+  init_arch_objects_typ_at
+  init_arch_objects_pred_tcb_at
+  init_arch_objects_cur_thread
+
+lemma set_cap_etcbs[wp]:
+  "set_cap p c \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
+  unfolding set_cap_def
+  apply (wpsimp wp: set_object_wp get_object_wp)
+  apply (auto simp: obj_at_def etcbs_of'_def etcb_of_def elim!: rsubst[where P=P])
   done
 
+crunch update_cdt_list, create_cap, cap_insert
+  for etcbs[wp]: "\<lambda>s. P (etcbs_of s)"
+  and rqueues[wp]: "\<lambda>s. P (ready_queues s)"
+  and schedact[wp]: "\<lambda>s. P (scheduler_action s)"
+  and cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
+  and ct[wp]: "\<lambda>s. P (cur_thread s)"
+  (wp: crunch_wps dxo_wp_weak)
 
-lemma retype_etcb_at_helper: "\<lbrakk>etcb_at' P t ekh; valid_etcbs_2 ekh kh; d \<noteq> apiobject_type.Untyped;
-        foldr (\<lambda>p kh. kh(p \<mapsto> default_object d dev c))
-         ptrs
-         kh t =
-        Some (TCB tcb);
-        tcb_state tcb \<noteq> Inactive\<rbrakk>
-       \<Longrightarrow> etcb_at' P t
-           ((foldr (\<lambda>p ekh. ekh(p := default_ext d cdom))
-             ptrs)
-             ekh)"
-  apply (induct ptrs)
-  apply simp
-  apply (case_tac d)
-  apply (clarsimp split: if_split_asm simp: default_tcb_def default_object_def default_ext_def etcb_at'_def)+
-  done
-
-lemma retype_region_etcb_at:"\<lbrace>(\<lambda>s. etcb_at P t s) and valid_etcbs\<rbrace> retype_region a b c d dev \<lbrace>\<lambda>r s. st_tcb_at (Not o inactive) t s \<longrightarrow> etcb_at P t s\<rbrace> "
-  apply (simp add: retype_region_def)
-  apply (simp add: retype_region_ext_def bind_assoc)
-  apply wp
-  apply (clarsimp simp add: pred_tcb_at_def obj_at_def simp del: fun_upd_apply)
-  apply (blast intro: retype_etcb_at_helper)
-  done
-
-lemma retype_region_valid_etcbs[wp]:"\<lbrace>valid_etcbs\<rbrace> retype_region a b c d dev \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
-  apply (simp add: retype_region_def)
-  apply (simp add: retype_region_ext_def bind_assoc)
-  apply wp
-  apply (clarsimp simp del: fun_upd_apply)
-  apply (blast intro: valid_etcb_fold_update)
-  done
+crunch create_cap, cap_insert
+  for valid_queues[wp]: valid_queues
+  (wp: valid_queues_lift)
 
 lemma typ_at_pred_tcb_at_lift:
   assumes typ_lift: "\<And>P T p. \<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> f \<lbrace>\<lambda>r s. P (typ_at T p s)\<rbrace>"
@@ -130,59 +76,94 @@ lemma cap_insert_no_pred_tcb_at:
   by (rule typ_at_pred_tcb_at_lift; wp)
 
 
+\<comment> \<open>FIXME: can some of these be removed\<close>
 locale DetSchedAux_AI =
   fixes state_ext_t :: "'state_ext::state_ext itself"
-  assumes invoke_untyped_ct[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s::'state_ext state. P (cur_thread s)\<rbrace> invoke_untyped i \<lbrace>\<lambda>_ s. P (cur_thread s)\<rbrace>"
-  assumes invoke_untyped_idle_thread[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s::'state_ext state. P (idle_thread s)\<rbrace> invoke_untyped i \<lbrace>\<lambda>_ s. P (idle_thread s)\<rbrace>"
-
-locale DetSchedAux_AI_det_ext = DetSchedAux_AI "TYPE(det_ext)" +
-  assumes delete_objects_etcb_at[wp]:
-    "\<And>P t a b. \<lbrace>\<lambda>s::det_ext state. etcb_at P t s\<rbrace> delete_objects a b \<lbrace>\<lambda>r s. etcb_at P t s\<rbrace>"
-  assumes invoke_untyped_etcb_at:
-    "\<And>P t ui.
-      \<lbrace>(\<lambda>s :: det_ext state. etcb_at P t s) and valid_etcbs\<rbrace>
-        invoke_untyped ui
-      \<lbrace>\<lambda>r s. st_tcb_at (Not o inactive) t s \<longrightarrow> etcb_at P t s\<rbrace> "
-  assumes init_arch_objects_valid_etcbs[wp]:
-    "\<And>t d r n sz refs. \<lbrace>valid_etcbs\<rbrace> init_arch_objects t d r n sz refs \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
+  assumes init_arch_objects_idle_thread[wp]:
+    "\<And>t d r n sz refs P. init_arch_objects t d r n sz refs \<lbrace>\<lambda>s::'state_ext state. P (idle_thread s)\<rbrace>"
+  assumes init_arch_objects_etcbs_of[wp]:
+    "\<And>t d r n sz refs P.
+      init_arch_objects t d r n sz refs \<lbrace>\<lambda>s::'state_ext state. P (etcbs_of s)\<rbrace>"
   assumes init_arch_objects_valid_blocked[wp]:
-    "\<And>t d r n sz refs. \<lbrace>valid_blocked\<rbrace> init_arch_objects t d r n sz refs \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
-  assumes invoke_untyped_cur_domain[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s. P (cur_domain s)\<rbrace> invoke_untyped i \<lbrace>\<lambda>_ s. P (cur_domain s)\<rbrace>"
-  assumes invoke_untyped_ready_queues[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace> invoke_untyped i \<lbrace>\<lambda>_ s. P (ready_queues s)\<rbrace>"
-  assumes invoke_untyped_scheduler_action[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace> invoke_untyped i \<lbrace>\<lambda>_ s. P (scheduler_action s)\<rbrace>"
-
-lemma delete_objects_valid_etcbs[wp]: "\<lbrace>valid_etcbs\<rbrace> delete_objects a b \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
+    "\<And>t d r n sz refs. init_arch_objects t d r n sz refs \<lbrace>valid_blocked :: 'state_ext state \<Rightarrow> _\<rbrace>"
+  assumes init_arch_objects_cur_domain[wp]:
+    "\<And>t d r n sz refs P. init_arch_objects t d r n sz refs \<lbrace>\<lambda>s::'state_ext state. P (cur_domain s)\<rbrace>"
+  assumes init_arch_objects_ready_queues[wp]:
+    "\<And>t d r n sz refs P. init_arch_objects t d r n sz refs \<lbrace>\<lambda>s::'state_ext state. P (ready_queues s)\<rbrace>"
+  assumes init_arch_objects_scheduler_action[wp]:
+    "\<And>t d r n sz refs P. init_arch_objects t d r n sz refs \<lbrace>\<lambda>s::'state_ext state. P (scheduler_action s)\<rbrace>"
+
+lemmas mapM_x_defsym = mapM_x_def[symmetric]
+
+lemma delete_objects_etcb_at[wp]:
+  "delete_objects a b \<lbrace>\<lambda>s. etcb_at P t s\<rbrace>"
   apply (simp add: delete_objects_def)
-  apply (wpsimp simp: detype_def detype_ext_def wrap_ext_det_ext_ext_def do_machine_op_def)
-  apply (simp add: valid_etcbs_def st_tcb_at_kh_def obj_at_kh_def obj_at_def is_etcb_at_def)
+  apply (wpsimp simp: detype_def)
+  apply (auto simp: detype_def etcbs_of'_def etcb_at'_def)
   done
 
-lemmas mapM_x_defsym = mapM_x_def[symmetric]
+crunch reset_untyped_cap
+  for etcb_at[wp]: "etcb_at P t"
+  (wp: preemption_point_inv mapME_x_inv_wp crunch_wps)
+
+lemma foldr_kh_eq:
+  "foldr (\<lambda>p kh. kh(p \<mapsto> ko')) ptrs kh t = Some ko \<Longrightarrow>
+  if t \<in> set ptrs then ko = ko' else kh t = Some ko"
+  by (induct ptrs) (auto split: if_split_asm)
+
+lemma TCB_default_objectD[dest!]:
+  "\<lbrakk>  TCB tcb = default_object t dev c dm; t \<noteq> Untyped \<rbrakk> \<Longrightarrow> tcb = default_tcb dm"
+  by (simp add: default_object_def split: apiobject_type.splits)
+
+declare tcb_state_merge_tcb_state_default[simp]
+
+lemma retype_region_etcb_at[wp]:
+  "\<lbrace>etcb_at P t\<rbrace> retype_region a b c d dev \<lbrace>\<lambda>r s. st_tcb_at (Not o inactive) t s \<longrightarrow> etcb_at P t s\<rbrace> "
+  apply (simp add: retype_region_def)
+  apply wp
+  apply (clarsimp simp add: pred_tcb_at_def obj_at_def simp del: fun_upd_apply)
+  apply (clarsimp simp: etcbs_of'_def etcb_at'_def etcb_of_def)
+  apply (drule foldr_kh_eq)
+  apply (auto simp: etcb_of_def split: if_split_asm option.splits elim!: rsubst[where P=P])
+  done
+
+crunch do_machine_op
+  for ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
+  and scheduler_action[wp]: "\<lambda>s. P (scheduler_action s)"
+  and cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
 
-context DetSchedAux_AI_det_ext begin
+context DetSchedAux_AI begin
 
 crunch invoke_untyped
-  for valid_etcbs[wp]: "valid_etcbs"
-  (wp: preemption_point_inv' mapME_x_inv_wp crunch_wps whenE_inv
-   simp: mapM_x_defsym crunch_simps unless_def)
+  for ready_queues[wp]: "\<lambda>s::'state_ext state. P (ready_queues s)"
+  and scheduler_action[wp]: "\<lambda>s::'state_ext state. P (scheduler_action s)"
+  and cur_domain[wp]: "\<lambda>s::'state_ext state. P (cur_domain s)"
+  and idle_thread[wp]: "\<lambda>s::'state_ext state. P (idle_thread s)"
+  (wp: crunch_wps mapME_x_inv_wp preemption_point_inv
+   simp: detype_def crunch_simps mapM_x_defsym)
+
+lemma invoke_untyped_etcb_at:
+  "\<lbrace>etcb_at P t\<rbrace>
+   invoke_untyped ui
+   \<lbrace>\<lambda>_ s::'state_ext state. st_tcb_at (Not o inactive) t s \<longrightarrow> etcb_at P t s\<rbrace>"
+  apply (cases ui)
+  apply (simp add: mapM_x_def[symmetric] invoke_untyped_def)
+  apply (wpsimp wp: mapM_x_wp'
+                    create_cap_no_pred_tcb_at typ_at_pred_tcb_at_lift
+                    hoare_convert_imp[OF create_cap_no_pred_tcb_at]
+                    hoare_convert_imp[OF _ init_arch_objects_etcbs_of]
+                    hoare_drop_impE_E)
+  done
 
 end
 
-
 crunch create_cap,cap_insert,set_cap
   for valid_blocked[wp]: valid_blocked
   (wp: valid_blocked_lift set_cap_typ_at)
 
-lemma valid_blocked_fold_update: "valid_blocked_2 queues kh sa ct \<Longrightarrow> type \<noteq> apiobject_type.Untyped \<Longrightarrow> valid_blocked_2
-          queues
-          (foldr (\<lambda>p kh. kh(p \<mapsto> default_object type dev o_bits))
-            ptrs
-            kh) sa ct"
+lemma valid_blocked_fold_update:
+  "\<lbrakk> valid_blocked_2 queues kh sa ct; type \<noteq> apiobject_type.Untyped \<rbrakk> \<Longrightarrow>
+   valid_blocked_2 queues (foldr (\<lambda>p kh. kh(p \<mapsto> default_object type dev o_bits d)) ptrs kh) sa ct"
   apply (induct ptrs)
    apply simp
   apply (case_tac type)
@@ -190,46 +171,52 @@ lemma valid_blocked_fold_update: "valid_blocked_2 queues kh sa ct \<Longrightarr
       apply (clarsimp,
              clarsimp simp: valid_blocked_def st_tcb_at_kh_def obj_at_kh_def obj_at_def
                             default_object_def default_tcb_def)+
-      done
+  done
 
 lemma retype_region_valid_blocked[wp]:
   "\<lbrace>valid_blocked\<rbrace> retype_region a b c d dev \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
   apply (simp add: retype_region_def)
-  apply (simp add: retype_region_ext_def bind_assoc)
   apply wp
   apply (clarsimp simp del: fun_upd_apply)
   apply (blast intro: valid_blocked_fold_update)
   done
 
-lemma delete_objects_valid_blocked[wp]: "\<lbrace>valid_blocked\<rbrace> delete_objects a b \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
+lemma delete_objects_valid_blocked[wp]:
+  "\<lbrace>valid_blocked\<rbrace> delete_objects a b \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
   apply (simp add: delete_objects_def)
-  apply (wpsimp simp: detype_def detype_ext_def wrap_ext_det_ext_ext_def do_machine_op_def)
+  apply (wpsimp simp: detype_def do_machine_op_def)
   apply (simp add: valid_blocked_def st_tcb_at_kh_def obj_at_kh_def obj_at_def is_etcb_at_def)
   done
 
-context DetSchedAux_AI_det_ext begin
+crunch reset_untyped_cap
+  for valid_blocked[wp]: "valid_blocked"
+  (wp: preemption_point_inv mapME_x_inv_wp crunch_wps
+   simp: unless_def)
+
+context DetSchedAux_AI begin
 
 crunch invoke_untyped
-  for valid_blocked[wp]: "valid_blocked"
-  (wp: preemption_point_inv' mapME_x_inv_wp crunch_wps whenE_inv
-   simp: mapM_x_defsym crunch_simps unless_def)
+  for valid_blocked[wp]: "valid_blocked :: 'state_ext state \<Rightarrow> _"
+  (wp: crunch_wps simp: mapM_x_defsym crunch_simps)
 
 end
 
+lemma st_tcb_at_is_etcb:
+  "st_tcb_at P t s \<Longrightarrow> is_etcb_at' t (etcbs_of s)"
+  by (auto simp: etcbs_of'_def is_etcb_at'_def st_tcb_at_def obj_at_def)
+
 (*Leverages the fact that retype only clears out inactive tcbs under
   the invariants*)
 lemma valid_sched_tcb_state_preservation:
   assumes st_tcb: "\<And>P t. \<lbrace>I and ct_active and st_tcb_at (P and Not o inactive and Not o idle) t\<rbrace> f \<lbrace>\<lambda>_.st_tcb_at P t\<rbrace>"
-  assumes stuff: "\<And>P t. \<lbrace>(\<lambda>s. etcb_at P t s) and valid_etcbs\<rbrace> f \<lbrace>\<lambda>r s. st_tcb_at (Not o inactive) t s \<longrightarrow> etcb_at P t s\<rbrace>"
+  assumes stuff: "\<And>P t. \<lbrace>(\<lambda>s. etcb_at P t s)\<rbrace> f \<lbrace>\<lambda>r s. st_tcb_at (Not o inactive) t s \<longrightarrow> etcb_at P t s\<rbrace>"
   assumes cur_thread: "\<And>P. \<lbrace>\<lambda>s. P (cur_thread s)\<rbrace> f \<lbrace>\<lambda>r s. P (cur_thread s)\<rbrace>"
   assumes idle_thread: "\<And>P. \<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> f \<lbrace>\<lambda>r s. P (idle_thread s)\<rbrace>"
-  assumes valid_etcb: "\<lbrace>valid_etcbs\<rbrace> f \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
   assumes valid_blocked: "\<lbrace>valid_blocked\<rbrace> f \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
   assumes valid_idle: "\<lbrace>I\<rbrace> f \<lbrace>\<lambda>_. valid_idle\<rbrace>"
   assumes valid_others: "\<And>P. \<lbrace>\<lambda>s. P (scheduler_action s) (ready_queues s) (cur_domain s)\<rbrace> f \<lbrace>\<lambda>r s. P (scheduler_action s) (ready_queues s) (cur_domain s)\<rbrace>"
   shows "\<lbrace>I and ct_active and valid_sched and valid_idle\<rbrace> f \<lbrace>\<lambda>_. valid_sched\<rbrace>"
   apply (clarsimp simp add: valid_sched_def valid_def)
-  apply (frule(1) use_valid[OF _ valid_etcb])
   apply (frule(1) use_valid[OF _ valid_blocked])
   apply simp
   apply (frule_tac P1="\<lambda>sa rq cdom. rq = ready_queues s \<and> sa = scheduler_action s \<and> cdom = cur_domain s" in use_valid[OF _ valid_others])
@@ -245,8 +232,8 @@ lemma valid_sched_tcb_state_preservation:
    apply (subgoal_tac "st_tcb_at runnable t b")
     apply simp
     apply (rule conjI)
-     apply (fastforce simp: valid_etcbs_def pred_tcb_at_def obj_at_def)
-    apply (frule_tac P1="(\<lambda>t. tcb_priority t = p \<and> tcb_domain t = d)" and t1=t in use_valid[OF _ stuff])
+     apply (fastforce simp: st_tcb_at_is_etcb)
+    apply (frule_tac P1="\<lambda>t. etcb_priority t = p \<and> etcb_domain t = d" and t1=t in use_valid[OF _ stuff])
      apply simp
     apply (simp add: pred_tcb_at_def obj_at_def)
     apply force
@@ -291,7 +278,7 @@ lemma valid_sched_tcb_state_preservation:
   apply (rule conjI)
    apply (rule impI)
    apply (simp, erule disjE, simp)
-   apply (frule_tac P1="(\<lambda>t. tcb_domain t = cur_domain s)" and t1="cur_thread s" in use_valid[OF _ stuff])
+   apply (frule_tac P1="\<lambda>t. etcb_domain t = cur_domain s" and t1="cur_thread s" in use_valid[OF _ stuff])
     apply (clarsimp simp: etcb_at_def split: option.splits)
    apply clarsimp
    apply (erule notE, rule use_valid[OF _ st_tcb],assumption)
@@ -314,12 +301,17 @@ lemma valid_idle_etcb_lift:
   apply(wp assms)
   done
 
-context DetSchedAux_AI_det_ext begin
+crunch invoke_untyped
+  for cur_thread[wp]: "\<lambda>s. P (cur_thread s)"
+  (wp: crunch_wps mapME_x_inv_wp preemption_point_inv
+   simp: crunch_simps mapM_x_defsym)
+
+context DetSchedAux_AI begin
 
 lemma invoke_untyped_valid_sched:
   "\<lbrace>invs and valid_untyped_inv ui and ct_active and valid_sched and valid_idle \<rbrace>
-     invoke_untyped ui
-   \<lbrace> \<lambda>_ . valid_sched \<rbrace>"
+   invoke_untyped ui
+   \<lbrace>\<lambda>_ . valid_sched :: 'state_ext state \<Rightarrow> _\<rbrace>"
   apply (rule hoare_pre)
    apply (rule_tac I="invs and valid_untyped_inv ui and ct_active"
                 in valid_sched_tcb_state_preservation)
@@ -336,10 +328,6 @@ end
 
 lemmas hoare_imp_lift_something = hoare_convert_imp
 
-crunch create_cap,cap_insert
-  for valid_queues[wp]: valid_queues
-  (wp: valid_queues_lift)
-
 crunch create_cap,cap_insert
   for valid_sched_action[wp]: valid_sched_action
   (wp: valid_sched_action_lift)
@@ -354,9 +342,4 @@ crunch thread_set_time_slice, dec_domain_time
 crunch get_tcb_queue
   for inv[wp]: "\<lambda>s. P s"
 
-lemma ethread_get_when_wp:
-  "\<lbrace>\<lambda>s. (b \<longrightarrow> etcb_at (\<lambda>t. P (f t) s) ptr s) \<and> (\<not>b \<longrightarrow> P undefined s)\<rbrace> ethread_get_when b f ptr \<lbrace>P\<rbrace>"
-  unfolding ethread_get_when_def ethread_get_def
-  by (wpsimp simp: etcb_at_def get_etcb_def)
-
 end
diff --git a/proof/invariant-abstract/DetSchedDomainTime_AI.thy b/proof/invariant-abstract/DetSchedDomainTime_AI.thy
index 249d856540..9d767e3643 100644
--- a/proof/invariant-abstract/DetSchedDomainTime_AI.thy
+++ b/proof/invariant-abstract/DetSchedDomainTime_AI.thy
@@ -18,193 +18,192 @@ definition
   "valid_domain_list_2 dlist \<equiv> 0 < length dlist \<and> (\<forall>(d,time) \<in> set dlist. 0 < time)"
 
 abbreviation
-  valid_domain_list :: "det_ext state \<Rightarrow> bool"
+  valid_domain_list :: "'z state \<Rightarrow> bool"
 where
-  "valid_domain_list \<equiv> (\<lambda>s. valid_domain_list_2 (domain_list s))"
+  "valid_domain_list \<equiv> \<lambda>s. valid_domain_list_2 (domain_list s)"
 
 lemmas valid_domain_list_def = valid_domain_list_2_def
 
 
 section \<open>Preservation of domain list validity\<close>
 
-lemma ethread_get_wp[wp]:
-  "\<lbrace>\<lambda>s. etcb_at (\<lambda>t. P (f t) s) ptr s\<rbrace> ethread_get f ptr \<lbrace>P\<rbrace>"
-  unfolding ethread_get_def
-  by (wp | clarsimp simp add: get_etcb_def etcb_at'_def is_etcb_at'_def)+
-
-(* We want wp to use ethread_get_inv before ethread_get_wp *)
-declare ethread_get_inv[wp del, wp]
-
+(*
+  FIXME: cleanup
+  Many of these could be factored out into the general state_ext class instead, but they will be
+  applied to det_ext lemmas that contain e.g. preemption_point which needs the det_ext work_units,
+  i.e. those will need additional locales, because 'state_ext needs to be interpreted first
+  into ?'state_ext.
+*)
 locale DetSchedDomainTime_AI =
   assumes finalise_cap_domain_list_inv'[wp]:
-    "\<And>P cap fin. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_finalise_cap cap fin \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P cap fin. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> arch_finalise_cap cap fin \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes arch_activate_idle_thread_domain_list_inv'[wp]:
-    "\<And>P t. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_activate_idle_thread t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P t. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> arch_activate_idle_thread t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes arch_switch_to_thread_domain_list_inv'[wp]:
-    "\<And>P t. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P t. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes arch_get_sanitise_register_info_domain_list_inv'[wp]:
-    "\<And>P t. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_get_sanitise_register_info t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P t. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> arch_get_sanitise_register_info t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes arch_switch_to_idle_thread_domain_list_inv'[wp]:
-    "\<And>P. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes handle_arch_fault_reply_domain_list_inv'[wp]:
-    "\<And>P f t x y. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P f t x y. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes init_arch_objects_domain_list_inv'[wp]:
-    "\<And>P t d p n s r. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> init_arch_objects t d p n s r \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P t d p n s r. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> init_arch_objects t d p n s r \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes arch_post_modify_registers_domain_list_inv'[wp]:
-    "\<And>P t p. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_post_modify_registers t p \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P t p. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> arch_post_modify_registers t p \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes arch_invoke_irq_control_domain_list_inv'[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_invoke_irq_control i \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P i. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> arch_invoke_irq_control i \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes handle_vm_fault_domain_list_inv'[wp]:
-    "\<And>P t f. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P t f. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes prepare_thread_delete_domain_list_inv'[wp]:
-    "\<And>P t. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P t. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes finalise_cap_domain_time_inv'[wp]:
-    "\<And>P cap fin. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_finalise_cap cap fin \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P cap fin. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> arch_finalise_cap cap fin \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes arch_activate_idle_thread_domain_time_inv'[wp]:
-    "\<And>P t. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_activate_idle_thread t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P t. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> arch_activate_idle_thread t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes arch_switch_to_thread_domain_time_inv'[wp]:
-    "\<And>P t. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P t. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes arch_get_sanitise_register_info_domain_time_inv'[wp]:
-    "\<And>P t. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_get_sanitise_register_info t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P t. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> arch_get_sanitise_register_info t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes arch_switch_to_idle_thread_domain_time_inv'[wp]:
-    "\<And>P. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes handle_arch_fault_reply_domain_time_inv'[wp]:
-    "\<And>P f t x y. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P f t x y. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes init_arch_objects_domain_time_inv'[wp]:
-    "\<And>P t d p n s r. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> init_arch_objects t d p n s r \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P t d p n s r. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> init_arch_objects t d p n s r \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes arch_post_modify_registers_domain_time_inv'[wp]:
-    "\<And>P t p. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_post_modify_registers t p \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P t p. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> arch_post_modify_registers t p \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes arch_invoke_irq_control_domain_time_inv'[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_invoke_irq_control i \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P i. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> arch_invoke_irq_control i \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes handle_vm_fault_domain_time_inv'[wp]:
-    "\<And>P t f. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P t f. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes prepare_thread_delete_domain_time_inv'[wp]:
-    "\<And>P t. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P t. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes make_arch_fault_msg_domain_time_inv'[wp]:
-    "\<And>P ft t. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> make_arch_fault_msg ft t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P ft t. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> make_arch_fault_msg ft t \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes make_arch_fault_msg_domain_list_inv'[wp]:
-    "\<And>P ft t. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> make_arch_fault_msg ft t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P ft t. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> make_arch_fault_msg ft t \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes arch_post_cap_deletion_domain_time_inv'[wp]:
-    "\<And>P ft. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_post_cap_deletion ft \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P ft. \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace> arch_post_cap_deletion ft \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
   assumes arch_post_cap_deletion_domain_list_inv'[wp]:
-    "\<And>P ft. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_post_cap_deletion ft \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P ft. \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace> arch_post_cap_deletion ft \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
   assumes arch_invoke_irq_handler_domain_list_inv'[wp]:
-    "\<And>P i. arch_invoke_irq_handler i \<lbrace>\<lambda>s. P (domain_list s)\<rbrace>"
+    "\<And>P i. arch_invoke_irq_handler i \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace>"
   assumes arch_invoke_irq_handler_domain_time_inv'[wp]:
-    "\<And>P i. arch_invoke_irq_handler i \<lbrace>\<lambda>s. P (domain_time s)\<rbrace>"
+    "\<And>P i. arch_invoke_irq_handler i \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace>"
 
 crunch update_restart_pc
   for domain_list[wp]: "\<lambda>s. P (domain_list s)"
   and domain_time[wp]: "\<lambda>s. P (domain_time s)"
+  (wp: crunch_wps)
 
 locale DetSchedDomainTime_AI_2 = DetSchedDomainTime_AI +
   assumes handle_hypervisor_fault_domain_list_inv'[wp]:
-    "\<And>P t f. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> handle_hypervisor_fault t f \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P t f. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> handle_hypervisor_fault t f \<lbrace>\<lambda>_ s::det_state. P (domain_list s)\<rbrace>"
   assumes handle_hypervisor_fault_domain_time_inv'[wp]:
-    "\<And>P t f. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> handle_hypervisor_fault t f \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P t f. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> handle_hypervisor_fault t f \<lbrace>\<lambda>_ s::det_state. P (domain_time s)\<rbrace>"
   assumes arch_perform_invocation_domain_list_inv'[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_perform_invocation i \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P i. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_perform_invocation i \<lbrace>\<lambda>_ s::det_state. P (domain_list s)\<rbrace>"
   assumes arch_perform_invocation_domain_time_inv'[wp]:
-    "\<And>P i. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_perform_invocation i \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P i. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> arch_perform_invocation i \<lbrace>\<lambda>_ s::det_state. P (domain_time s)\<rbrace>"
   assumes handle_interrupt_valid_domain_time:
     "\<And>i.
       \<lbrace>\<lambda>s :: det_ext state. 0 < domain_time s \<rbrace>
         handle_interrupt i
       \<lbrace>\<lambda>rv s.  domain_time s = 0 \<longrightarrow> scheduler_action s = choose_new_thread \<rbrace>"
   assumes handle_reserved_irq_some_time_inv'[wp]:
-    "\<And>P irq. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> handle_reserved_irq irq \<lbrace>\<lambda>_ s. P (domain_time s)\<rbrace>"
+    "\<And>P irq. \<lbrace>\<lambda>s. P (domain_time s)\<rbrace> handle_reserved_irq irq \<lbrace>\<lambda>_ s::det_state. P (domain_time s)\<rbrace>"
   assumes handle_reserved_irq_domain_list_inv'[wp]:
-    "\<And>P irq. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> handle_reserved_irq irq \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
+    "\<And>P irq. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> handle_reserved_irq irq \<lbrace>\<lambda>_ s::det_state. P (domain_list s)\<rbrace>"
   assumes arch_mask_irq_signal_domain_list_inv'[wp]:
-    "\<And>P irq. arch_mask_irq_signal irq \<lbrace>\<lambda>s. P (domain_list s)\<rbrace>"
+    "\<And>P irq. arch_mask_irq_signal irq \<lbrace>\<lambda>s::det_state. P (domain_list s)\<rbrace>"
   assumes arch_mask_irq_signal_domain_time_inv'[wp]:
-    "\<And>P irq. arch_mask_irq_signal irq \<lbrace>\<lambda>s. P (domain_time s)\<rbrace>"
+    "\<And>P irq. arch_mask_irq_signal irq \<lbrace>\<lambda>s::det_state. P (domain_time s)\<rbrace>"
 
 
 context DetSchedDomainTime_AI begin
 
 crunch
   cap_swap_for_delete, empty_slot, get_object, get_cap, tcb_sched_action
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
 
 crunch finalise_cap
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps unless_wp select_inv simp: crunch_simps)
 
 lemma rec_del_domain_list[wp]:
-  "\<lbrace>\<lambda>s. P (domain_list s)\<rbrace> rec_del call \<lbrace>\<lambda>rv s. P (domain_list s)\<rbrace>"
+  "\<lbrace>\<lambda>s. P (domain_list s)\<rbrace> rec_del call \<lbrace>\<lambda>rv s::det_state. P (domain_list s)\<rbrace>"
   by (wp rec_del_preservation preemption_point_inv' | simp)+
 
 crunch cap_delete, activate_thread
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
 
 crunch schedule
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
-  (wp: hoare_drop_imp simp: Let_def)
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
+  (wp: hoare_drop_imp dxo_wp_weak simp: Let_def)
 
 end
 
 crunch (in DetSchedDomainTime_AI_2) handle_interrupt
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
+
+crunch cap_insert
+ for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
+  (wp: hoare_drop_imps)
 
 crunch
-  lookup_cap_and_slot, cap_insert, set_extra_badge
+  lookup_cap_and_slot, set_extra_badge
   for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
   (wp: hoare_drop_imps)
 
 context DetSchedDomainTime_AI begin
 crunch do_ipc_transfer
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps simp: zipWithM_x_mapM rule: transfer_caps_loop_pres)
 
 crunch handle_fault
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: mapM_wp hoare_drop_imps simp: crunch_simps ignore:copy_mrs)
 
 
 crunch
   reply_from_kernel, create_cap, retype_region, do_reply_transfer
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: hoare_drop_imps)
 end
 
 crunch delete_objects
   for domain_list_inv[wp]: "\<lambda>s :: det_ext state. P (domain_list s)"
-  (wp: crunch_wps
-   simp: detype_def detype_ext_def wrap_ext_det_ext_ext_def cap_insert_ext_def
-   ignore: freeMemory)
-
-crunch update_work_units
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  (wp: crunch_wps simp: detype_def)
 
 crunch preemption_point
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: OR_choiceE_weak_wp ignore_del: preemption_point)
 
 crunch reset_untyped_cap
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps unless_wp mapME_x_inv_wp select_inv
    simp: crunch_simps)
 
 context DetSchedDomainTime_AI begin
 
 crunch invoke_untyped
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps
     simp: crunch_simps mapM_x_defsym)
 
 crunch
   invoke_tcb, invoke_domain, invoke_irq_control, invoke_irq_handler
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps check_cap_inv)
 end
 
 crunch cap_move
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
 
 context DetSchedDomainTime_AI begin
 lemma cap_revoke_domain_list_inv[wp]:
-  "\<lbrace>(\<lambda>s :: det_ext state. P (domain_list s))\<rbrace> cap_revoke a \<lbrace>\<lambda>rv s. P (domain_list s)\<rbrace>"
+  "\<lbrace>\<lambda>s :: det_ext state. P (domain_list s)\<rbrace> cap_revoke a \<lbrace>\<lambda>rv s. P (domain_list s)\<rbrace>"
   by (rule cap_revoke_preservation2)
      (wp preemption_point_inv'|simp)+
 end
@@ -227,18 +226,18 @@ lemma invoke_cnode_domain_list_inv[wp]:
   done
 
 crunch perform_invocation, handle_invocation
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps syscall_valid simp: crunch_simps ignore: syscall)
 
 crunch
   handle_recv, handle_yield, handle_call, handle_reply, handle_vm_fault, handle_hypervisor_fault
-  for domain_list_inv[wp]: "\<lambda>s. P (domain_list s)"
+  for domain_list_inv[wp]: "\<lambda>s::det_state. P (domain_list s)"
   (wp: crunch_wps simp: crunch_simps)
 
 lemma handle_event_domain_list_inv[wp]:
   "\<lbrace>\<lambda>s. P (domain_list s) \<rbrace>
    handle_event e
-   \<lbrace>\<lambda>_ s. P (domain_list s) \<rbrace>"
+   \<lbrace>\<lambda>_ s::det_state. P (domain_list s) \<rbrace>"
   apply (cases e, simp_all)
       apply (rename_tac syscall)
       apply (case_tac syscall, simp_all add: handle_send_def)
@@ -268,41 +267,41 @@ context DetSchedDomainTime_AI begin
 
 crunch
   get_cap, activate_thread, set_scheduler_action, tcb_sched_action, thread_set_time_slice
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
 
 crunch guarded_switch_to
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: hoare_drop_imp whenE_inv)
 
 crunch choose_thread
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
 
 
 crunch send_signal
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: hoare_drop_imps mapM_x_wp_inv simp: crunch_simps unless_def)
 
 crunch
   cap_swap_for_delete, empty_slot, get_object, get_cap, tcb_sched_action
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
 
 crunch finalise_cap
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp
        subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action)
 
 lemma rec_del_domain_time[wp]:
-  "\<lbrace>\<lambda>s. P (domain_time s)\<rbrace> rec_del call \<lbrace>\<lambda>rv s. P (domain_time s)\<rbrace>"
+  "\<lbrace>\<lambda>s. P (domain_time s)\<rbrace> rec_del call \<lbrace>\<lambda>rv s::det_state. P (domain_time s)\<rbrace>"
   by (wp rec_del_preservation preemption_point_inv' | simp)+
 
 crunch
   cap_delete, activate_thread, lookup_cap_and_slot
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
 
 end
 
 crunch cap_insert
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: hoare_drop_imps)
 
 crunch set_extra_badge
@@ -311,56 +310,51 @@ crunch set_extra_badge
 context DetSchedDomainTime_AI begin
 
 crunch do_ipc_transfer
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: crunch_wps simp: zipWithM_x_mapM rule: transfer_caps_loop_pres)
 
 crunch handle_fault
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: mapM_wp hoare_drop_imps simp: crunch_simps ignore:copy_mrs)
 
 crunch
   reply_from_kernel, create_cap, retype_region
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
 
 crunch do_reply_transfer
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: hoare_drop_imps)
 end
 
 crunch delete_objects
   for domain_time_inv[wp]: "\<lambda>s :: det_ext state. P (domain_time s)"
-  (wp: crunch_wps
-   simp: detype_def detype_ext_def wrap_ext_det_ext_ext_def cap_insert_ext_def
-   ignore: freeMemory)
-
-crunch update_work_units
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  (wp: crunch_wps simp: detype_def)
 
 crunch preemption_point
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: OR_choiceE_weak_wp ignore_del: preemption_point)
 
 crunch reset_untyped_cap
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: crunch_wps unless_wp mapME_x_inv_wp select_inv
    simp: crunch_simps)
 
 context DetSchedDomainTime_AI begin
 
 crunch invoke_untyped
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: crunch_wps
     simp: crunch_simps mapM_x_defsym)
 
 crunch
   invoke_tcb, invoke_domain, invoke_irq_control,invoke_irq_handler
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: crunch_wps check_cap_inv)
 
 end
 
 crunch cap_move
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
 
 context DetSchedDomainTime_AI begin
 lemma cap_revoke_domain_time_inv[wp]:
@@ -388,16 +382,16 @@ lemma invoke_cnode_domain_time_inv[wp]:
   done
 
 crunch perform_invocation, handle_invocation
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: crunch_wps syscall_valid simp: crunch_simps ignore: syscall)
 
 crunch
   handle_recv, handle_yield, handle_call, handle_reply, handle_vm_fault, handle_hypervisor_fault
-  for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
+  for domain_time_inv[wp]: "\<lambda>s::det_state. P (domain_time s)"
   (wp: crunch_wps simp: crunch_simps)
 
 lemma handle_event_domain_time_inv:
-  "\<lbrace>\<lambda>s. P (domain_time s) \<and> e \<noteq> Interrupt \<rbrace>
+  "\<lbrace>\<lambda>s::det_state. P (domain_time s) \<and> e \<noteq> Interrupt \<rbrace>
    handle_event e
    \<lbrace>\<lambda>_ s. P (domain_time s) \<rbrace>"
   apply (cases e, simp_all)
@@ -410,21 +404,21 @@ end
 
 lemma next_domain_domain_time_left[wp]:
   "\<lbrace> valid_domain_list \<rbrace> next_domain \<lbrace>\<lambda>_ s. 0 < domain_time s \<rbrace>"
-  apply (rule hoare_pre)
-   apply (simp add: next_domain_def Let_def)
-    apply wp
-   apply (clarsimp simp: valid_domain_list_def)
-   apply (simp add: all_set_conv_all_nth)
-   apply (erule_tac x="Suc (domain_index s) mod length (domain_list s)" in allE)
-   apply clarsimp
-   done
+  apply (clarsimp simp: next_domain_def)
+  apply (rule_tac Q'="\<lambda>_ s. 0 < domain_time s" in bind_wp)
+   apply (wpsimp wp: dxo_wp_weak)
+  apply wpsimp
+  apply (clarsimp simp: valid_domain_list_def all_set_conv_all_nth)
+  apply (erule_tac x="Suc (domain_index s) mod length (domain_list s)" in allE)
+  apply clarsimp
+  done
 
 context DetSchedDomainTime_AI begin
 
 lemma schedule_choose_new_thread_domain_time_left[wp]:
   "\<lbrace> valid_domain_list \<rbrace>
    schedule_choose_new_thread
-   \<lbrace>\<lambda>_ s. 0 < domain_time s \<rbrace>"
+   \<lbrace>\<lambda>_ s::det_state. 0 < domain_time s \<rbrace>"
   unfolding schedule_choose_new_thread_def
   by (wpsimp simp: word_gt_0)
 
@@ -434,12 +428,12 @@ crunch tcb_sched_action
 lemma schedule_domain_time_left:
   "\<lbrace>valid_domain_list and (\<lambda>s. domain_time s = 0 \<longrightarrow> scheduler_action s = choose_new_thread) \<rbrace>
    schedule
-   \<lbrace>\<lambda>_ s. 0 < domain_time s \<rbrace>" (is "\<lbrace>?P\<rbrace> _ \<lbrace>\<lambda>_ . ?Q\<rbrace>")
+   \<lbrace>\<lambda>_ s::det_state. 0 < domain_time s \<rbrace>" (is "\<lbrace>?P\<rbrace> _ \<lbrace>\<lambda>_ . ?Q\<rbrace>")
   supply word_neq_0_conv[simp]
   apply (simp add: schedule_def)
   apply (wp|wpc)+
            apply (wp hoare_drop_imp)[1]
-          apply (wpsimp wp: gts_wp ethread_get_inv)+
+          apply (wpsimp wp: gts_wp)+
   apply auto
   done
 end
diff --git a/proof/invariant-abstract/DetSchedInvs_AI.thy b/proof/invariant-abstract/DetSchedInvs_AI.thy
index 5e4395749a..a7a1b142a4 100644
--- a/proof/invariant-abstract/DetSchedInvs_AI.thy
+++ b/proof/invariant-abstract/DetSchedInvs_AI.thy
@@ -8,46 +8,53 @@ theory DetSchedInvs_AI
 imports ArchDeterministic_AI
 begin
 
-lemma get_etcb_rev:
-  "ekheap s p = Some etcb \<Longrightarrow> get_etcb p s = Some etcb"
-   by (clarsimp simp: get_etcb_def)
+\<comment> \<open>These records originally made up the "extended kheap" used in the
+    deterministic version of the specification but they are now part of tcb objects
+    in the main kheap. We project them together, since they are typically used together.\<close>
 
-lemma get_etcb_SomeD: "get_etcb ptr s = Some v \<Longrightarrow> ekheap s ptr = Some v"
-  apply (case_tac "ekheap s ptr", simp_all add: get_etcb_def)
-  done
+record etcb =
+  etcb_priority :: priority
+  \<comment> \<open>etcb_time_slice :: nat FIXME: time_slice was part of the ekheap but isn't used in valid_sched, do we want it here?\<close>
+  etcb_domain :: domain
 
-definition obj_at_kh where
-"obj_at_kh P ref kh \<equiv> obj_at P ref ((undefined :: det_ext state)\<lparr>kheap := kh\<rparr>)"
+definition etcb_of :: "tcb \<Rightarrow> etcb" where
+  "etcb_of t = \<lparr> etcb_priority = tcb_priority t, etcb_domain = tcb_domain t \<rparr>"
+
+definition
+  obj_at_kh :: "(kernel_object \<Rightarrow> bool) \<Rightarrow> obj_ref \<Rightarrow> (obj_ref \<Rightarrow> kernel_object option) \<Rightarrow> bool"
+where
+  "obj_at_kh P ref kh \<equiv> \<exists>ko. kh ref = Some ko \<and> P ko"
 
 lemma obj_at_kh_simp[simp]: "obj_at_kh P ref (kheap st) = obj_at P ref st"
   apply (simp add: obj_at_def obj_at_kh_def)
   done
 
-
 definition st_tcb_at_kh where
-"st_tcb_at_kh test \<equiv> obj_at_kh (\<lambda>ko. \<exists>tcb. ko = TCB tcb \<and> test (tcb_state tcb))"
+  "st_tcb_at_kh test \<equiv> obj_at_kh (\<lambda>ko. \<exists>tcb. ko = TCB tcb \<and> test (tcb_state tcb))"
 
 lemma st_tcb_at_kh_simp[simp]: "st_tcb_at_kh test t (kheap st) = st_tcb_at test t st"
   apply (simp add: pred_tcb_at_def st_tcb_at_kh_def)
   done
 
+definition etcbs_of':: "(obj_ref \<Rightarrow> kernel_object option) \<Rightarrow> obj_ref \<Rightarrow> etcb option" where
+  "etcbs_of' kh \<equiv> \<lambda>p. case kh p of Some (TCB t) \<Rightarrow> Some (etcb_of t) | _ \<Rightarrow> None"
 
-definition is_etcb_at' where
-"is_etcb_at' ref ekh \<equiv> ekh ref \<noteq> None"
-
-abbreviation is_etcb_at:: "obj_ref \<Rightarrow> det_ext state \<Rightarrow> bool" where
-"is_etcb_at ref s \<equiv> is_etcb_at' ref (ekheap s)"
-
-lemmas is_etcb_at_def = is_etcb_at'_def
+abbreviation
+  "etcbs_of \<equiv> \<lambda>s. etcbs_of' (kheap s)"
 
 definition etcb_at' :: "(etcb \<Rightarrow> bool) \<Rightarrow> obj_ref \<Rightarrow> (obj_ref \<Rightarrow> etcb option) \<Rightarrow> bool" where
-"etcb_at' P ref ekh \<equiv> case ekh ref of Some x \<Rightarrow> P x | _ \<Rightarrow> True"
+  "etcb_at' P ref ekh \<equiv> case ekh ref of Some x \<Rightarrow> P x | _ \<Rightarrow> True"
 
-abbreviation etcb_at :: "(etcb \<Rightarrow> bool) \<Rightarrow> obj_ref \<Rightarrow> det_ext state \<Rightarrow> bool" where
-"etcb_at P ref s \<equiv> etcb_at' P ref (ekheap s)"
+abbreviation etcb_at :: "(etcb \<Rightarrow> bool) \<Rightarrow> obj_ref \<Rightarrow> 'z state \<Rightarrow> bool" where
+  "etcb_at P ref s \<equiv> etcb_at' P ref (etcbs_of s)"
 
 lemmas etcb_at_def = etcb_at'_def
 
+definition
+  "is_etcb_at' t ekh \<equiv> ekh t \<noteq> None"
+
+lemmas is_etcb_at_def = is_etcb_at'_def
+
 lemma etcb_at_taut[simp]: "etcb_at' \<top> ref ekh"
   apply (simp add: etcb_at'_def split: option.split)
   done
@@ -57,23 +64,13 @@ lemma etcb_at_conj_is_etcb_at:
      = (case ekh t of None \<Rightarrow> False | Some x \<Rightarrow> P x)"
   by (simp add: is_etcb_at_def etcb_at_def split: option.splits)
 
-definition valid_etcbs_2 :: "(obj_ref \<Rightarrow> etcb option) \<Rightarrow> (obj_ref \<Rightarrow> kernel_object option) \<Rightarrow> bool"where
-"valid_etcbs_2 ekh kh \<equiv> \<forall>ptr. (st_tcb_at_kh \<top> ptr kh) = (is_etcb_at' ptr ekh)"
-
-
-abbreviation valid_etcbs :: "det_ext state \<Rightarrow> bool" where
-"valid_etcbs s \<equiv> valid_etcbs_2 (ekheap s) (kheap s)"
-
-lemmas valid_etcbs_def = valid_etcbs_2_def
-
-
 definition
   valid_idle_etcb_2 :: "(obj_ref \<Rightarrow> etcb option) \<Rightarrow> bool"
 where
-  "valid_idle_etcb_2 ekh \<equiv> etcb_at' (\<lambda>etcb. tcb_domain etcb = default_domain) idle_thread_ptr ekh"
+  "valid_idle_etcb_2 ekh \<equiv> etcb_at' (\<lambda>etcb. etcb_domain etcb = default_domain) idle_thread_ptr ekh"
 
-abbreviation valid_idle_etcb :: "det_ext state \<Rightarrow> bool" where
-  "valid_idle_etcb s \<equiv> valid_idle_etcb_2 (ekheap s)"
+abbreviation valid_idle_etcb :: "'z state \<Rightarrow> bool" where
+  "valid_idle_etcb s \<equiv> valid_idle_etcb_2 (etcbs_of s)"
 
 lemmas valid_idle_etcb_def = valid_idle_etcb_2_def
 
@@ -81,18 +78,18 @@ lemmas valid_idle_etcb_def = valid_idle_etcb_2_def
 definition not_queued_2 where
   "not_queued_2 qs t \<equiv> \<forall>d p. t \<notin> set (qs d p)"
 
-abbreviation not_queued :: "obj_ref \<Rightarrow> det_ext state \<Rightarrow> bool" where
+abbreviation not_queued :: "obj_ref \<Rightarrow> 'z state \<Rightarrow> bool" where
   "not_queued t s \<equiv> not_queued_2 (ready_queues s) t"
 
 definition valid_queues_2 where
   "valid_queues_2 queues ekh kh \<equiv> (\<forall>d p.
      (\<forall>t \<in> set (queues d p). is_etcb_at' t ekh
-                           \<and> etcb_at' (\<lambda>t. tcb_priority t = p \<and> tcb_domain t = d) t ekh
+                           \<and> etcb_at' (\<lambda>t. etcb_priority t = p \<and> etcb_domain t = d) t ekh
                            \<and> st_tcb_at_kh runnable t kh)
    \<and> distinct (queues d p))"
 
-abbreviation valid_queues :: "det_ext state \<Rightarrow> bool" where
-"valid_queues s \<equiv> valid_queues_2 (ready_queues s) (ekheap s) (kheap s)"
+abbreviation valid_queues :: "'z state \<Rightarrow> bool" where
+  "valid_queues s \<equiv> valid_queues_2 (ready_queues s) (etcbs_of s) (kheap s)"
 
 lemmas valid_queues_def = valid_queues_2_def
 
@@ -100,22 +97,18 @@ lemma valid_queues_def2:
   "valid_queues_2 queues ekh kh =
      (\<forall>d p. (\<forall>t \<in> set (queues d p).
               is_etcb_at' t ekh \<and>
-              (case ekh t of None \<Rightarrow> False | Some x \<Rightarrow> tcb_priority x = p \<and> tcb_domain x = d) \<and>
+              (case ekh t of None \<Rightarrow> False | Some x \<Rightarrow> etcb_priority x = p \<and> etcb_domain x = d) \<and>
               st_tcb_at_kh runnable t kh) \<and>
               distinct (queues d p))"
-  by (clarsimp simp: valid_queues_def
-                     conj_assoc[where P="is_etcb_at' t ekh \<and> (case ekh t of
-                                           None \<Rightarrow> False |
-                                           Some x \<Rightarrow> tcb_priority x = p \<and> tcb_domain x = d)"]
-                     etcb_at_conj_is_etcb_at[symmetric])
+  by (clarsimp simp: valid_queues_def etcb_at_conj_is_etcb_at[symmetric])
 
 definition valid_blocked_2 where
    "valid_blocked_2 queues kh sa ct \<equiv>
     (\<forall>t st. not_queued_2 queues t \<longrightarrow> st_tcb_at_kh ((=) st) t kh \<longrightarrow>
             t \<noteq> ct \<longrightarrow> sa \<noteq> switch_thread t \<longrightarrow> (\<not> active st))"
 
-abbreviation valid_blocked :: "det_ext state \<Rightarrow> bool" where
- "valid_blocked s \<equiv> valid_blocked_2 (ready_queues s) (kheap s) (scheduler_action s) (cur_thread s)"
+abbreviation valid_blocked :: "'z state \<Rightarrow> bool" where
+  "valid_blocked s \<equiv> valid_blocked_2 (ready_queues s) (kheap s) (scheduler_action s) (cur_thread s)"
 
 lemmas valid_blocked_def = valid_blocked_2_def
 
@@ -124,8 +117,8 @@ definition valid_blocked_except_2 where
     (\<forall>t st. t \<noteq> thread \<longrightarrow> not_queued_2 queues t \<longrightarrow> st_tcb_at_kh ((=) st) t kh \<longrightarrow>
             t \<noteq> ct \<longrightarrow> sa \<noteq> switch_thread t \<longrightarrow> (\<not> active st))"
 
-abbreviation valid_blocked_except :: "obj_ref \<Rightarrow> det_ext state \<Rightarrow> bool" where
- "valid_blocked_except t s \<equiv> valid_blocked_except_2 t (ready_queues s) (kheap s) (scheduler_action s) (cur_thread s)"
+abbreviation valid_blocked_except :: "obj_ref \<Rightarrow> 'z state \<Rightarrow> bool" where
+  "valid_blocked_except t s \<equiv> valid_blocked_except_2 t (ready_queues s) (kheap s) (scheduler_action s) (cur_thread s)"
 
 lemmas valid_blocked_except_def = valid_blocked_except_2_def
 
@@ -135,10 +128,10 @@ lemma valid_blocked_except_cur_thread[simp]:
   by (fastforce simp: valid_blocked_except_2_def valid_blocked_2_def)
 
 definition in_cur_domain_2 where
-  "in_cur_domain_2 thread cdom ekh \<equiv> etcb_at' (\<lambda>t. tcb_domain t = cdom) thread ekh"
+  "in_cur_domain_2 thread cdom ekh \<equiv> etcb_at' (\<lambda>t. etcb_domain t = cdom) thread ekh"
 
-abbreviation in_cur_domain :: "obj_ref \<Rightarrow> det_ext state \<Rightarrow> bool" where
-  "in_cur_domain thread s \<equiv> in_cur_domain_2 thread (cur_domain s) (ekheap s)"
+abbreviation in_cur_domain :: "obj_ref \<Rightarrow> 'z state \<Rightarrow> bool" where
+  "in_cur_domain thread s \<equiv> in_cur_domain_2 thread (cur_domain s) (etcbs_of s)"
 
 lemmas in_cur_domain_def = in_cur_domain_2_def
 
@@ -147,24 +140,24 @@ definition ct_in_cur_domain_2 where
      sa = resume_cur_thread \<longrightarrow> thread = thread' \<or> in_cur_domain_2 thread cdom ekh"
 
 abbreviation ct_in_cur_domain where
-  "ct_in_cur_domain s \<equiv> ct_in_cur_domain_2 (cur_thread s) (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)"
+  "ct_in_cur_domain s \<equiv> ct_in_cur_domain_2 (cur_thread s) (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)"
 
 lemmas ct_in_cur_domain_def = ct_in_cur_domain_2_def
 
 definition is_activatable_2 where
-"is_activatable_2 thread sa kh \<equiv> sa = resume_cur_thread \<longrightarrow> st_tcb_at_kh activatable thread kh"
+  "is_activatable_2 thread sa kh \<equiv> sa = resume_cur_thread \<longrightarrow> st_tcb_at_kh activatable thread kh"
 
-abbreviation is_activatable :: "obj_ref \<Rightarrow> det_ext state \<Rightarrow> bool"  where
-"is_activatable thread s \<equiv> is_activatable_2 thread (scheduler_action s) (kheap s)"
+abbreviation is_activatable :: "obj_ref \<Rightarrow> 'z state \<Rightarrow> bool"  where
+  "is_activatable thread s \<equiv> is_activatable_2 thread (scheduler_action s) (kheap s)"
 
 lemmas is_activatable_def = is_activatable_2_def
 
 definition weak_valid_sched_action_2 where
-  "weak_valid_sched_action_2 sa ekh kh \<equiv>
+  "weak_valid_sched_action_2 sa kh \<equiv>
     \<forall>t. sa = switch_thread t \<longrightarrow> st_tcb_at_kh runnable t kh"
 
-abbreviation weak_valid_sched_action:: "det_ext state \<Rightarrow> bool" where
-  "weak_valid_sched_action s \<equiv> weak_valid_sched_action_2 (scheduler_action s) (ekheap s) (kheap s)"
+abbreviation weak_valid_sched_action:: "'z state \<Rightarrow> bool" where
+  "weak_valid_sched_action s \<equiv> weak_valid_sched_action_2 (scheduler_action s) (kheap s)"
 
 lemmas weak_valid_sched_action_def = weak_valid_sched_action_2_def
 
@@ -172,17 +165,17 @@ definition switch_in_cur_domain_2 where
   "switch_in_cur_domain_2 sa ekh cdom \<equiv>
     \<forall>t. sa = switch_thread t \<longrightarrow> in_cur_domain_2 t cdom ekh"
 
-abbreviation switch_in_cur_domain:: "det_ext state \<Rightarrow> bool" where
-  "switch_in_cur_domain s \<equiv> switch_in_cur_domain_2 (scheduler_action s) (ekheap s) (cur_domain s)"
+abbreviation switch_in_cur_domain:: "'z state \<Rightarrow> bool" where
+  "switch_in_cur_domain s \<equiv> switch_in_cur_domain_2 (scheduler_action s) (etcbs_of s) (cur_domain s)"
 
 lemmas switch_in_cur_domain_def = switch_in_cur_domain_2_def
 
 definition valid_sched_action_2 where
   "valid_sched_action_2 sa ekh kh ct cdom \<equiv>
-     is_activatable_2 ct sa kh \<and> weak_valid_sched_action_2 sa ekh kh \<and> switch_in_cur_domain_2 sa ekh cdom"
+     is_activatable_2 ct sa kh \<and> weak_valid_sched_action_2 sa kh \<and> switch_in_cur_domain_2 sa ekh cdom"
 
-abbreviation valid_sched_action :: "det_ext state \<Rightarrow> bool" where
-  "valid_sched_action s \<equiv> valid_sched_action_2 (scheduler_action s) (ekheap s) (kheap s) (cur_thread s) (cur_domain s)"
+abbreviation valid_sched_action :: "'z state \<Rightarrow> bool" where
+  "valid_sched_action s \<equiv> valid_sched_action_2 (scheduler_action s) (etcbs_of s) (kheap s) (cur_thread s) (cur_domain s)"
 
 lemmas valid_sched_action_def = valid_sched_action_2_def
 
@@ -194,17 +187,19 @@ abbreviation ct_not_queued where
 definition
   "ct_not_in_q_2 queues sa ct \<equiv> sa = resume_cur_thread \<longrightarrow> not_queued_2 queues ct"
 
-abbreviation ct_not_in_q :: "det_ext state \<Rightarrow> bool" where
+abbreviation ct_not_in_q :: "'z state \<Rightarrow> bool" where
   "ct_not_in_q s \<equiv> ct_not_in_q_2 (ready_queues s) (scheduler_action s) (cur_thread s)"
 
 lemmas ct_not_in_q_def = ct_not_in_q_2_def
 
 definition valid_sched_2 where
   "valid_sched_2 queues ekh sa cdom kh ct it \<equiv>
-      valid_etcbs_2 ekh kh \<and> valid_queues_2 queues ekh kh \<and> ct_not_in_q_2 queues sa ct \<and> valid_sched_action_2 sa ekh kh ct cdom \<and> ct_in_cur_domain_2 ct it sa cdom ekh \<and> valid_blocked_2 queues kh sa ct \<and> valid_idle_etcb_2 ekh"
+     valid_queues_2 queues ekh kh \<and> ct_not_in_q_2 queues sa ct \<and>
+     valid_sched_action_2 sa ekh kh ct cdom \<and> ct_in_cur_domain_2 ct it sa cdom ekh \<and>
+     valid_blocked_2 queues kh sa ct \<and> valid_idle_etcb_2 ekh"
 
-abbreviation valid_sched :: "det_ext state \<Rightarrow> bool" where
-  "valid_sched s \<equiv> valid_sched_2 (ready_queues s) (ekheap s) (scheduler_action s) (cur_domain s) (kheap s) (cur_thread s) (idle_thread s)"
+abbreviation valid_sched :: "'z state \<Rightarrow> bool" where
+  "valid_sched s \<equiv> valid_sched_2 (ready_queues s) (etcbs_of s) (scheduler_action s) (cur_domain s) (kheap s) (cur_thread s) (idle_thread s)"
 
 lemmas valid_sched_def = valid_sched_2_def
 
@@ -216,7 +211,7 @@ abbreviation einvs :: "det_ext state \<Rightarrow> bool" where
 definition not_cur_thread_2 :: "obj_ref \<Rightarrow> scheduler_action \<Rightarrow> obj_ref \<Rightarrow> bool" where
   "not_cur_thread_2 thread sa ct \<equiv> sa = resume_cur_thread \<longrightarrow> thread \<noteq> ct"
 
-abbreviation not_cur_thread :: "obj_ref \<Rightarrow> det_ext state \<Rightarrow> bool" where
+abbreviation not_cur_thread :: "obj_ref \<Rightarrow> 'z state \<Rightarrow> bool" where
   "not_cur_thread thread s \<equiv> not_cur_thread_2 thread (scheduler_action s) (cur_thread s)"
 
 lemmas not_cur_thread_def = not_cur_thread_2_def
@@ -225,13 +220,13 @@ lemmas not_cur_thread_def = not_cur_thread_2_def
 definition simple_sched_action_2 :: "scheduler_action \<Rightarrow> bool" where
   "simple_sched_action_2 action \<equiv> (case action of switch_thread t \<Rightarrow> False | _ \<Rightarrow> True)"
 
-abbreviation simple_sched_action :: "det_state \<Rightarrow> bool" where
+abbreviation simple_sched_action :: "'z state \<Rightarrow> bool" where
   "simple_sched_action s \<equiv> simple_sched_action_2 (scheduler_action s)"
 
 lemmas simple_sched_action_def = simple_sched_action_2_def
 
 
-definition schact_is_rct :: "det_ext state \<Rightarrow> bool" where
+definition schact_is_rct :: "'z state \<Rightarrow> bool" where
   "schact_is_rct s \<equiv> scheduler_action s = resume_cur_thread"
 
 lemma schact_is_rct[elim!]: "schact_is_rct s \<Longrightarrow> scheduler_action s = resume_cur_thread"
@@ -246,10 +241,10 @@ definition scheduler_act_not_2 where
 "scheduler_act_not_2 sa t \<equiv> sa \<noteq> switch_thread t"
 
 
-abbreviation scheduler_act_not :: "obj_ref \<Rightarrow> det_ext state  \<Rightarrow> bool" where
+abbreviation scheduler_act_not :: "obj_ref \<Rightarrow> 'z state  \<Rightarrow> bool" where
 "scheduler_act_not t s \<equiv> scheduler_act_not_2 (scheduler_action s) t"
 
-abbreviation scheduler_act_sane :: "det_ext state \<Rightarrow> bool" where
+abbreviation scheduler_act_sane :: "'z state \<Rightarrow> bool" where
 "scheduler_act_sane s \<equiv> scheduler_act_not_2 (scheduler_action s) (cur_thread s)"
 
 
@@ -264,25 +259,14 @@ lemmas sch_act_sane_lift = hoare_lift_Pf2[where f="cur_thread" and P="scheduler_
 
 lemmas not_queued_def = not_queued_2_def
 
-
-lemma valid_etcbs_lift:
-  assumes a: "\<And>P T t. \<lbrace>\<lambda>s. P (typ_at T t s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at T t s)\<rbrace>"
-      and b: "\<And>P. \<lbrace>\<lambda>s. P (ekheap s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
-    shows "\<lbrace>valid_etcbs\<rbrace> f \<lbrace>\<lambda>rv. valid_etcbs\<rbrace>"
-  apply (rule hoare_lift_Pf[where f="\<lambda>s. ekheap s", OF _ b])
-  apply (simp add: valid_etcbs_def)
-  apply (simp add: tcb_at_st_tcb_at[symmetric] tcb_at_typ)
-  apply (wp hoare_vcg_all_lift a)
-  done
-
 lemma valid_queues_lift:
   assumes a: "\<And>Q t. \<lbrace>\<lambda>s. st_tcb_at Q t s\<rbrace> f \<lbrace>\<lambda>rv s. st_tcb_at Q t s\<rbrace>"
-      and c: "\<And>P. \<lbrace>\<lambda>s. P (ekheap s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
-      and d: "\<And>P. \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
+      and b: "\<And>P. \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace> f \<lbrace>\<lambda>rv s. P (etcbs_of s)\<rbrace>"
+      and c: "\<And>P. \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
     shows "\<lbrace>valid_queues\<rbrace> f \<lbrace>\<lambda>rv. valid_queues\<rbrace>"
-  apply (rule hoare_lift_Pf[where f="\<lambda>s. ekheap s", OF _ c])
-  apply (rule hoare_lift_Pf[where f="\<lambda>s. ready_queues s", OF _ d])
   apply (simp add: valid_queues_def)
+  apply (rule hoare_lift_Pf[where f="\<lambda>s. etcbs_of s", OF _ b])
+  apply (rule hoare_lift_Pf[where f="\<lambda>s. ready_queues s", OF _ c])
   apply (wp hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift a)
   done
 
@@ -345,13 +329,13 @@ lemma ct_not_in_q_lift:
   done
 
 lemma ct_in_cur_domain_lift:
-  assumes a: "\<And>P. \<lbrace>\<lambda>s. P (ekheap s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
+  assumes a: "\<And>P. \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace> f \<lbrace>\<lambda>rv s. P (etcbs_of s)\<rbrace>"
       and b: "\<And>P. \<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace> f \<lbrace>\<lambda>rv s. P (scheduler_action s)\<rbrace>"
       and c: "\<And>P. \<lbrace>\<lambda>s. P (cur_domain s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cur_domain s)\<rbrace>"
       and d: "\<And>P. \<lbrace>\<lambda>s. P (cur_thread s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cur_thread s)\<rbrace>"
       and e: "\<And>P. \<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> f \<lbrace>\<lambda>rv s. P (idle_thread s)\<rbrace>"
     shows "\<lbrace>ct_in_cur_domain\<rbrace> f \<lbrace>\<lambda>rv. ct_in_cur_domain\<rbrace>"
-  apply (rule hoare_lift_Pf[where f="\<lambda>s. ekheap s", OF _ a])
+  apply (rule hoare_lift_Pf[where f="\<lambda>s. etcbs_of s", OF _ a])
   apply (rule hoare_lift_Pf[where f="\<lambda>s. scheduler_action s", OF _ b])
   apply (rule hoare_lift_Pf[where f="\<lambda>s. cur_domain s", OF _ c])
   apply (rule hoare_lift_Pf[where f="\<lambda>s. cur_thread s", OF _ d])
@@ -384,7 +368,7 @@ lemma valid_sched_action_lift:
   assumes b: "\<And>Q t. \<lbrace>\<lambda>s. etcb_at Q t s\<rbrace> f \<lbrace>\<lambda>rv s. etcb_at Q t s\<rbrace>"
   assumes c: "\<And>P. \<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace> f \<lbrace>\<lambda>rv s. P (scheduler_action s)\<rbrace>"
   assumes d: "\<And>P. \<lbrace>\<lambda>s. P (cur_thread s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cur_thread s)\<rbrace>"
-  assumes e: "\<And>Q t. \<lbrace>\<lambda>s. Q (cur_domain s)\<rbrace> f \<lbrace>\<lambda>rv s. Q (cur_domain s)\<rbrace>"
+  assumes e: "\<And>Q. \<lbrace>\<lambda>s. Q (cur_domain s)\<rbrace> f \<lbrace>\<lambda>rv s. Q (cur_domain s)\<rbrace>"
     shows "\<lbrace>valid_sched_action\<rbrace> f \<lbrace>\<lambda>rv. valid_sched_action\<rbrace>"
   apply (rule hoare_lift_Pf[where f="\<lambda>s. cur_thread s", OF _ d])
   apply (simp add: valid_sched_action_def)
@@ -396,9 +380,8 @@ lemma valid_sched_action_lift:
 
 lemma valid_sched_lift:
   assumes a: "\<And>Q t. \<lbrace>\<lambda>s. st_tcb_at Q t s\<rbrace> f \<lbrace>\<lambda>rv s. st_tcb_at Q t s\<rbrace>"
-  assumes b: "\<And>Q t. \<lbrace>\<lambda>s. etcb_at Q t s\<rbrace> f \<lbrace>\<lambda>rv s. etcb_at Q t s\<rbrace>"
   assumes c: "\<And>P T t. \<lbrace>\<lambda>s. P (typ_at T t s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at T t s)\<rbrace>"
-  assumes d: "\<And>P. \<lbrace>\<lambda>s. P (ekheap s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
+  assumes d: "\<And>P. \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace> f \<lbrace>\<lambda>rv s. P (etcbs_of s)\<rbrace>"
   assumes e: "\<And>P. \<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace> f \<lbrace>\<lambda>rv s. P (scheduler_action s)\<rbrace>"
   assumes f: "\<And>P. \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
   assumes g: "\<And>P. \<lbrace>\<lambda>s. P (cur_domain s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cur_domain s)\<rbrace>"
@@ -406,48 +389,8 @@ lemma valid_sched_lift:
   assumes i: "\<And>P. \<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> f \<lbrace>\<lambda>rv s. P (idle_thread s)\<rbrace>"
     shows "\<lbrace>valid_sched\<rbrace> f \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
   apply (simp add: valid_sched_def)
-  apply (wp valid_etcbs_lift valid_queues_lift ct_not_in_q_lift ct_in_cur_domain_lift
-            valid_sched_action_lift valid_blocked_lift a b c d e f g h i hoare_vcg_conj_lift)
-  done
-
-lemma valid_sched_valid_etcbs[elim!]:
-  "valid_sched s \<Longrightarrow> valid_etcbs s"
-  by (clarsimp simp: valid_sched_def)
-
-lemma valid_etcbs_tcb_etcb:
-  "\<lbrakk> valid_etcbs s; kheap s ptr = Some (TCB tcb) \<rbrakk> \<Longrightarrow> \<exists>etcb. ekheap s ptr = Some etcb"
-  by (force simp: valid_etcbs_def is_etcb_at_def st_tcb_at_def obj_at_def)
-
-lemma valid_etcbs_get_tcb_get_etcb:
-  "\<lbrakk> valid_etcbs s; get_tcb ptr s = Some tcb \<rbrakk> \<Longrightarrow> \<exists>etcb. get_etcb ptr s = Some etcb"
-  apply (clarsimp simp: valid_etcbs_def st_tcb_at_def obj_at_def is_etcb_at_def get_etcb_def get_tcb_def
-                  split: option.splits if_split)
-  apply (erule_tac x=ptr in allE)
-  apply (clarsimp simp: get_etcb_def split: option.splits kernel_object.splits)+
-  done
-
-lemma valid_etcbs_ko_etcb:
-  "\<lbrakk> valid_etcbs s; kheap s ptr = Some ko \<rbrakk> \<Longrightarrow> \<exists>tcb. (ko = TCB tcb = (\<exists>etcb. ekheap s ptr = Some etcb))"
-  apply (clarsimp simp: valid_etcbs_def st_tcb_at_def obj_at_def is_etcb_at_def)
-  apply (erule_tac x="ptr" in allE)
-  apply auto
+  apply (wp valid_queues_lift ct_not_in_q_lift ct_in_cur_domain_lift
+            valid_sched_action_lift valid_blocked_lift a c d e f g h i hoare_vcg_conj_lift)
   done
 
-lemma ekheap_tcb_at:
-  "\<lbrakk>ekheap s x = Some y; valid_etcbs s\<rbrakk> \<Longrightarrow> tcb_at x s"
-  by (fastforce simp: valid_etcbs_def is_etcb_at_def st_tcb_at_def obj_at_def is_tcb_def)
-
-lemma tcb_at_is_etcb_at:
-  "\<lbrakk>tcb_at t s; valid_etcbs s\<rbrakk> \<Longrightarrow> is_etcb_at t s"
-  by (simp add: valid_etcbs_def tcb_at_st_tcb_at)
-
-lemma tcb_at_ekheap_dom:
-  "\<lbrakk>tcb_at x s; valid_etcbs s\<rbrakk> \<Longrightarrow> (\<exists>etcb. ekheap s x = Some etcb)"
-  by (auto simp: is_etcb_at_def dest: tcb_at_is_etcb_at)
-
-lemma ekheap_kheap_dom:
-  "\<lbrakk>ekheap s x = Some etcb; valid_etcbs s\<rbrakk>
-    \<Longrightarrow> \<exists>tcb. kheap s x = Some (TCB tcb)"
-  by (fastforce simp: valid_etcbs_def st_tcb_at_def obj_at_def is_etcb_at_def)
-
 end
diff --git a/proof/invariant-abstract/DetSchedSchedule_AI.thy b/proof/invariant-abstract/DetSchedSchedule_AI.thy
index 315dabcbb7..06ee42338e 100644
--- a/proof/invariant-abstract/DetSchedSchedule_AI.thy
+++ b/proof/invariant-abstract/DetSchedSchedule_AI.thy
@@ -21,9 +21,6 @@ lemma get_tcb_queue_wp[wp]: "\<lbrace>\<lambda>s. P (ready_queues s t p) s\<rbra
   apply wp
   done
 
-crunch tcb_sched_action
-  for valid_etcbs[wp]: "valid_etcbs"
-
 lemma enqueue_distinct[intro!]: "distinct queue \<Longrightarrow> distinct (tcb_sched_enqueue thread queue)"
   apply (simp add: tcb_sched_enqueue_def)
   done
@@ -34,8 +31,8 @@ lemma is_activatable_trivs[iff]:
   by (simp_all add: is_activatable_def)
 
 lemma weak_valid_sched_action_trivs[iff]:
-  "weak_valid_sched_action_2 resume_cur_thread ekh kh"
-  "weak_valid_sched_action_2 choose_new_thread ekh kh"
+  "weak_valid_sched_action_2 resume_cur_thread kh"
+  "weak_valid_sched_action_2 choose_new_thread kh"
   by (simp_all add: weak_valid_sched_action_def)
 
 lemma switch_in_cur_domain_trivs[iff]:
@@ -62,13 +59,33 @@ lemma scheduler_act_not_trivs[iff]:
   "scheduler_act_not_2 choose_new_thread t"
   by (simp_all add: scheduler_act_not_def)
 
+lemma ko_at_etcbD:
+  "ko_at (TCB tcb) t s \<Longrightarrow> etcbs_of s t = Some (etcb_of tcb)"
+  by (simp add: obj_at_def etcbs_of'_def)
+
+lemma etcb_priority_etcb_of[simp]:
+  "etcb_priority (etcb_of tcb) = tcb_priority tcb"
+  by (simp add: etcb_of_def)
+
+lemma etcb_domain_etcb_of[simp]:
+  "etcb_domain (etcb_of tcb) = tcb_domain tcb"
+  by (simp add: etcb_of_def)
+
+lemma etcb_of_eq[simp]:
+  "(etcb_of t = etcb_of t') = (tcb_priority t = tcb_priority t' \<and> tcb_domain t = tcb_domain t')"
+  by (simp add: etcb_of_def)
+
+lemmas thread_get_prio_wp[wp] = thread_get_wp' [where f=tcb_priority]
+lemmas thread_get_dom_wp[wp] = thread_get_wp' [where f=tcb_domain]
+
 lemma tcb_sched_action_enqueue_valid_queues[wp]:
   "\<lbrace>valid_queues and st_tcb_at runnable thread\<rbrace>
-     tcb_sched_action tcb_sched_enqueue thread \<lbrace>\<lambda>_. valid_queues\<rbrace>"
+   tcb_sched_action tcb_sched_enqueue thread
+   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
   apply (simp add: tcb_sched_action_def, wp)
-  apply simp
   apply (clarsimp simp: valid_queues_def2 etcb_at_def tcb_sched_enqueue_def is_etcb_at_def
-                 split: option.split)
+                 split: option.split
+                 dest!: ko_at_etcbD)
   done
 
 lemma tcb_sched_action_append_valid_queues[wp]:
@@ -76,7 +93,8 @@ lemma tcb_sched_action_append_valid_queues[wp]:
      tcb_sched_action tcb_sched_append thread \<lbrace>\<lambda>_. valid_queues\<rbrace>"
   apply (simp add: tcb_sched_action_def, wp)
   apply (clarsimp simp: valid_queues_def2 etcb_at_def tcb_sched_append_def is_etcb_at_def
-         split: option.split)
+                 split: option.split
+                 dest!: ko_at_etcbD)
   done
 
 lemma tcb_sched_action_dequeue_valid_queues[wp]:
@@ -197,10 +215,10 @@ lemma tcb_sched_action_dequeue_valid_blocked_except:
 
 abbreviation valid_sched_except_blocked_2 where
   "valid_sched_except_blocked_2 queues ekh sa cdom kh ct it \<equiv>
-      valid_etcbs_2 ekh kh \<and> valid_queues_2 queues ekh kh \<and> ct_not_in_q_2 queues sa ct \<and> valid_sched_action_2 sa ekh kh ct cdom \<and> ct_in_cur_domain_2 ct it sa cdom ekh \<and> valid_idle_etcb_2 ekh"
+      valid_queues_2 queues ekh kh \<and> ct_not_in_q_2 queues sa ct \<and> valid_sched_action_2 sa ekh kh ct cdom \<and> ct_in_cur_domain_2 ct it sa cdom ekh \<and> valid_idle_etcb_2 ekh"
 
-abbreviation valid_sched_except_blocked :: "det_ext state \<Rightarrow> bool" where
-  "valid_sched_except_blocked s \<equiv> valid_sched_except_blocked_2 (ready_queues s) (ekheap s) (scheduler_action s) (cur_domain s) (kheap s) (cur_thread s) (idle_thread s)"
+abbreviation valid_sched_except_blocked :: "'z state \<Rightarrow> bool" where
+  "valid_sched_except_blocked s \<equiv> valid_sched_except_blocked_2 (ready_queues s) (etcbs_of s) (scheduler_action s) (cur_domain s) (kheap s) (cur_thread s) (idle_thread s)"
 
 declare valid_idle_etcb_lift[wp]
 
@@ -228,9 +246,6 @@ lemma tcb_sched_action_dequeue_valid_sched_except_blocked:
    \<lbrace>\<lambda>_. valid_sched_except_blocked\<rbrace>"
   by (simp add: valid_sched_def | wp tcb_sched_action_dequeue_valid_blocked_except)+
 
-crunch set_scheduler_action
-  for valid_etcbs[wp]: "valid_etcbs"
-
 crunch set_scheduler_action
   for valid_queues[wp]: "valid_queues"
 
@@ -350,16 +365,12 @@ lemma set_scheduler_action_cnt_valid_blocked_except:
   apply (erule_tac x=t in allE)
   apply (erule impCE)
    apply force
-  apply (force simp: not_queued_def)
-  done
+  by (fastforce simp: not_queued_def)
 
 lemma set_scheduler_action_cnt_weak_valid_sched:
   "\<lbrace>valid_sched and simple_sched_action\<rbrace> set_scheduler_action choose_new_thread \<lbrace>\<lambda>_. valid_sched\<rbrace>"
   by (simp add: valid_sched_def simple_sched_action_def split: scheduler_action.splits | wp set_scheduler_action_cnt_valid_blocked)+
 
-crunch reschedule_required
-  for valid_etcbs[wp]: "valid_etcbs"
-
 lemma reschedule_required_valid_queues[wp]:
   "\<lbrace>valid_queues and weak_valid_sched_action\<rbrace>
       reschedule_required
@@ -442,13 +453,13 @@ crunch reschedule_required
   for etcb_at[wp]: "etcb_at P t"
 
 lemma reschedule_required_valid_sched:
-  "\<lbrace>valid_etcbs and valid_queues and weak_valid_sched_action and valid_blocked and valid_idle_etcb\<rbrace>
+  "\<lbrace>valid_queues and weak_valid_sched_action and valid_blocked and valid_idle_etcb\<rbrace>
     reschedule_required
    \<lbrace>\<lambda>_. valid_sched\<rbrace>"
   by (simp add: valid_sched_def | wp reschedule_required_valid_blocked)+
 
 lemma reschedule_required_valid_sched_cur_thread:
-  "\<lbrace>(\<lambda>s. target = cur_thread s) and valid_etcbs and valid_queues and weak_valid_sched_action and valid_blocked_except target and valid_idle_etcb\<rbrace>
+  "\<lbrace>(\<lambda>s. target = cur_thread s) and valid_queues and weak_valid_sched_action and valid_blocked_except target and valid_idle_etcb\<rbrace>
     reschedule_required
    \<lbrace>\<lambda>_. valid_sched\<rbrace>"
   apply (simp add: valid_sched_def | wp reschedule_required_valid_blocked)+
@@ -467,29 +478,31 @@ lemma st_tcb_at_kh_if_split:
         else st_tcb_at_kh P ptr kh)"
   by (fastforce simp: st_tcb_at_kh_def obj_at_kh_def obj_at_def)
 
-lemma set_thread_state_valid_etcbs[wp]:
-  "\<lbrace>valid_etcbs\<rbrace> set_thread_state ref ts \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (wp | wpc | simp add: set_thread_state_ext_def set_object_def get_object_def)+
-  apply (fastforce simp: valid_etcbs_def st_tcb_at_kh_if_split
-                   dest: get_tcb_st_tcb_at)
-  done
+crunch set_thread_state_act
+  for valid_queues[wp]: valid_queues
 
-lemma set_bound_notification_valid_etcbs[wp]:
-  "\<lbrace>valid_etcbs\<rbrace> set_bound_notification ref ntfn \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
-  apply (simp add: set_bound_notification_def)
-  apply (wp | wpc | simp add: set_object_def get_object_def)+
-  apply (fastforce simp: valid_etcbs_def st_tcb_at_kh_if_split
-                   dest: get_tcb_st_tcb_at)
-  done
+lemma etcbs_of_update_unrelated:
+  "\<lbrakk>kh ref = Some (TCB tcb); etcb_of tcb = etcb_of tcb'\<rbrakk> \<Longrightarrow>
+    etcbs_of' (\<lambda>r. if r = ref then Some (TCB tcb') else kh r) = etcbs_of' kh"
+  by (auto simp: etcbs_of'_def)
+
+lemma etcbs_of_update_state[simp]:
+  "get_tcb ref s = Some tcb \<Longrightarrow>
+   etcbs_of' (\<lambda>r. if r = ref then Some (TCB (tcb_state_update f tcb)) else kheap s r) = etcbs_of' (kheap s)"
+  by (auto simp: etcbs_of_update_unrelated dest!: get_tcb_SomeD)
 
 lemma set_thread_state_runnable_valid_queues:
   "\<lbrace>valid_queues and K (runnable ts)\<rbrace> set_thread_state ref ts \<lbrace>\<lambda>_. valid_queues\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (wp | wpc | simp add: set_thread_state_ext_def set_object_def get_object_def)+
+  apply (wpsimp simp: set_object_def get_object_def)
   apply (clarsimp simp: valid_queues_def st_tcb_at_kh_if_split)
   done
 
+lemma etcbs_of_update_bound_notification[simp]:
+  "get_tcb ref s = Some tcb \<Longrightarrow>
+   etcbs_of' (\<lambda>r. if r = ref then Some (TCB (tcb_bound_notification_update f tcb)) else kheap s r) = etcbs_of' (kheap s)"
+  by (auto simp: etcbs_of_update_unrelated dest!: get_tcb_SomeD)
+
 lemma set_bound_notification_valid_queues:
   "\<lbrace>valid_queues\<rbrace> set_bound_notification ref ntfn \<lbrace>\<lambda>_. valid_queues\<rbrace>"
   apply (simp add: set_bound_notification_def)
@@ -504,7 +517,7 @@ lemma set_bound_notification_valid_queues:
 lemma set_thread_state_ct_not_in_q[wp]:
   "\<lbrace>ct_not_in_q\<rbrace> set_thread_state ref ts \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def | wp gts_wp)+
+  apply (simp add: set_thread_state_act_def set_object_def get_object_def | wp gts_wp)+
   done
 
 lemma set_bound_notification_ct_not_in_q[wp]:
@@ -516,9 +529,9 @@ lemma set_bound_notification_ct_not_in_q[wp]:
 lemma set_thread_state_cur_is_activatable[wp]:
   "\<lbrace>\<lambda>s. is_activatable (cur_thread s) s\<rbrace>
      set_thread_state ref ts
-   \<lbrace>\<lambda>_ (s::det_state). is_activatable (cur_thread s) s\<rbrace>"
+   \<lbrace>\<lambda>_ s. is_activatable (cur_thread s) s\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def |
+  apply (simp add: set_thread_state_act_def set_object_def get_object_def |
          wp set_scheduler_action_wp gts_wp)+
   apply (clarsimp simp: is_activatable_def st_tcb_at_kh_if_split
                         pred_tcb_at_def obj_at_def)
@@ -527,7 +540,7 @@ lemma set_thread_state_cur_is_activatable[wp]:
 lemma set_bound_notification_cur_is_activatable[wp]:
   "\<lbrace>\<lambda>s. is_activatable (cur_thread s) s\<rbrace>
      set_bound_notification ref ntfn
-   \<lbrace>\<lambda>_ (s::det_state). is_activatable (cur_thread s) s\<rbrace>"
+   \<lbrace>\<lambda>_ s. is_activatable (cur_thread s) s\<rbrace>"
   apply (simp add: set_bound_notification_def)
   apply (simp add: set_object_def get_object_def | wp set_scheduler_action_wp)+
   apply (clarsimp simp: is_activatable_def st_tcb_at_kh_if_split pred_tcb_at_def
@@ -539,7 +552,7 @@ lemma set_thread_state_runnable_weak_valid_sched_action:
       set_thread_state ref ts
    \<lbrace>\<lambda>_. weak_valid_sched_action\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def | wp gts_wp)+
+  apply (simp add: set_thread_state_act_def set_object_def get_object_def | wp gts_wp)+
   apply (clarsimp simp: weak_valid_sched_action_def st_tcb_at_kh_if_split)
   done
 
@@ -547,7 +560,7 @@ lemma set_thread_state_switch_in_cur_domain[wp]:
   "\<lbrace>switch_in_cur_domain\<rbrace>
       set_thread_state ref ts \<lbrace>\<lambda>_. switch_in_cur_domain\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def
+  apply (simp add: set_thread_state_act_def set_object_def get_object_def
                    | wp set_scheduler_action_wp gts_wp)+
   done
 
@@ -580,7 +593,7 @@ lemma set_thread_state_cur_ct_in_cur_domain[wp]:
   "\<lbrace>ct_in_cur_domain\<rbrace>
      set_thread_state ref ts \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def |
+  apply (simp add: set_thread_state_act_def set_object_def get_object_def |
         wp set_scheduler_action_wp gts_wp)+
   done
 
@@ -588,8 +601,8 @@ lemma set_thread_state_schact_is_rct:
   "\<lbrace>schact_is_rct and (\<lambda>s. ref = cur_thread s \<longrightarrow> runnable ts )\<rbrace>
    set_thread_state ref ts
    \<lbrace>\<lambda>_. schact_is_rct\<rbrace>"
-  unfolding set_thread_state_def set_thread_state_ext_extended.dxo_eq
-  apply (clarsimp simp: set_thread_state_ext_def)
+  unfolding set_thread_state_def
+  apply (clarsimp simp: set_thread_state_act_def)
   apply (wpsimp wp: set_object_wp gts_wp simp: set_scheduler_action_def)
   apply (clarsimp simp: schact_is_rct_def st_tcb_at_def obj_at_def)
   done
@@ -602,8 +615,9 @@ lemma set_bound_notification_cur_ct_in_cur_domain[wp]:
         wp set_scheduler_action_wp gbn_wp)+
   done
 
-crunch set_thread_state, set_bound_notification, get_bound_notification
-  for etcb_at[wp]: "etcb_at P t"
+crunch set_thread_state, set_bound_notification
+  for etcbs_of[wp]: "\<lambda>s. P (etcbs_of s)"
+  (wp: set_object_wp)
 
 lemma set_thread_state_runnable_valid_sched_except_blocked:
   "\<lbrace>valid_sched and (\<lambda>s. runnable ts)\<rbrace> set_thread_state ref ts \<lbrace>\<lambda>_. valid_sched_except_blocked\<rbrace>"
@@ -641,7 +655,7 @@ lemma valid_blocked_valid_blocked_except[simp]:
 lemma set_thread_state_valid_blocked_except:
   "\<lbrace>valid_blocked\<rbrace> set_thread_state ref ts \<lbrace>\<lambda>_. valid_blocked_except ref\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def | wp)+
+  apply (simp add: set_thread_state_act_def set_object_def get_object_def | wp)+
        apply (rule hoare_strengthen_post)
        apply (rule set_scheduler_action_cnt_valid_blocked_weak)
       apply simp
@@ -651,11 +665,8 @@ lemma set_thread_state_valid_blocked_except:
 
 (* as user schedule invariants *)
 
-lemma as_user_valid_etcbs[wp]: "\<lbrace>valid_etcbs\<rbrace> as_user ptr s \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
-  apply (simp add: as_user_def set_object_def get_object_def | wpc | wp)+
-  by (fastforce simp: valid_etcbs_def st_tcb_at_kh_if_split dest: get_tcb_st_tcb_at)
-
 lemma as_user_valid_queues[wp]: "\<lbrace>valid_queues\<rbrace> as_user ptr s \<lbrace>\<lambda>_. valid_queues\<rbrace>"
+  supply etcbs_of_update_unrelated[simp]
   apply (simp add: as_user_def set_object_def get_object_def | wpc | wp)+
   apply (clarsimp simp: valid_queues_def st_tcb_at_kh_if_split st_tcb_at_def obj_at_def)
   apply (drule_tac x=d in spec)
@@ -676,6 +687,7 @@ lemma as_user_is_activatable[wp]: "\<lbrace>is_activatable t\<rbrace> as_user pt
   by (drule get_tcb_SomeD, auto)
 
 lemma as_user_valid_sched_action[wp]: "\<lbrace>valid_sched_action\<rbrace> as_user ptr s \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
+  supply etcbs_of_update_unrelated[simp]
   apply (simp add: as_user_def set_object_def get_object_def | wpc | wp)+
   apply (clarsimp simp: valid_sched_action_def st_tcb_at_def obj_at_def)
   apply (rule conjI)
@@ -685,12 +697,17 @@ lemma as_user_valid_sched_action[wp]: "\<lbrace>valid_sched_action\<rbrace> as_u
   apply (drule get_tcb_SomeD, clarsimp)
   done
 
-crunch as_user
-  for ct_in_cur_domain[wp]: ct_in_cur_domain
-  (wp: ct_in_cur_domain_lift)
+lemma as_user_etcbs_of[wp]:
+  "as_user ptr s \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
+  apply (wpsimp simp: as_user_def set_object_def wp: get_object_wp)
+  apply (clarsimp dest!: get_tcb_SomeD simp: etcbs_of_update_unrelated)
+  done
 
-lemma as_user_valid_idle_etcb[wp]: "\<lbrace>valid_idle_etcb\<rbrace> as_user ptr s \<lbrace>\<lambda>_. valid_idle_etcb\<rbrace>"
-  by (simp add: as_user_def set_object_def get_object_def | wpc | wp)+
+lemma as_user_ct_in_cur_domain[wp]:
+  "as_user ptr s \<lbrace>ct_in_cur_domain\<rbrace>"
+  apply (wpsimp simp: as_user_def set_object_def wp: get_object_wp)
+  apply (clarsimp dest!: get_tcb_SomeD simp: etcbs_of_update_unrelated)
+  done
 
 lemma as_user_valid_blocked[wp]: "\<lbrace>valid_blocked\<rbrace> as_user ptr s \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
   apply (simp add: as_user_def set_object_def get_object_def | wpc | wp)+
@@ -702,97 +719,86 @@ definition ct_in_q where
   "ct_in_q s \<equiv> st_tcb_at runnable (cur_thread s) s \<longrightarrow> (\<exists>d p. cur_thread s \<in> set (ready_queues s d p))"
 
 locale DetSchedSchedule_AI =
-  assumes arch_switch_to_idle_thread_valid_etcbs'[wp]:
-    "\<lbrace>valid_etcbs\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
-  assumes arch_switch_to_thread_valid_etcbs'[wp]:
-    "\<And>t. \<lbrace>valid_etcbs\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
   assumes arch_switch_to_idle_thread_valid_queues'[wp]:
-    "\<lbrace>valid_queues\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_. valid_queues\<rbrace>"
+    "\<lbrace>valid_queues\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_. valid_queues :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_thread_valid_queues'[wp]:
-    "\<And>t. \<lbrace>valid_queues\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_queues\<rbrace>"
+    "\<And>t. \<lbrace>valid_queues\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_queues :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_idle_thread_weak_valid_sched_action'[wp]:
-    "\<lbrace>weak_valid_sched_action\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_. weak_valid_sched_action\<rbrace>"
+    "\<lbrace>weak_valid_sched_action\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_. weak_valid_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_thread_weak_valid_sched_action'[wp]:
-    "\<And>t. \<lbrace>weak_valid_sched_action\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. weak_valid_sched_action\<rbrace>"
+    "\<And>t. \<lbrace>weak_valid_sched_action\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. weak_valid_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   assumes switch_to_idle_thread_ct_not_in_q[wp]:
-    "\<lbrace>valid_queues and valid_idle\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
+    "\<lbrace>valid_queues and valid_idle\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_not_in_q :: det_state \<Rightarrow> _\<rbrace>"
   assumes switch_to_idle_thread_valid_sched_action[wp]:
-    "\<lbrace>valid_sched_action and valid_idle\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
+    "\<lbrace>valid_sched_action and valid_idle\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. valid_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   assumes switch_to_idle_thread_ct_in_cur_domain[wp]:
-    "\<lbrace>\<top>\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
+    "\<lbrace>\<top>\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_in_cur_domain :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_thread_ct_not_in_q'[wp]:
-    "\<And>t. \<lbrace>ct_not_in_q\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
+    "\<And>t. \<lbrace>ct_not_in_q\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. ct_not_in_q :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_thread_is_activatable'[wp]:
-    "\<And>t t'. \<lbrace>is_activatable t'\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. is_activatable t'\<rbrace>"
+    "\<And>t t'. \<lbrace>is_activatable t'\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. is_activatable t' :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_thread_valid_sched_action'[wp]:
-    "\<And>t. \<lbrace>valid_sched_action\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
+    "\<And>t. \<lbrace>valid_sched_action\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_thread_valid_sched'[wp]:
-    "\<And>t. \<lbrace>valid_sched\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+    "\<And>t. \<lbrace>valid_sched\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_thread_ct_in_cur_domain_2[wp]:
     "\<And>t' t.
-      \<lbrace>\<lambda>s. ct_in_cur_domain_2 t' (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)\<rbrace>
+      \<lbrace>\<lambda>s. ct_in_cur_domain_2 t' (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)\<rbrace>
         arch_switch_to_thread t
-      \<lbrace>\<lambda>_ s. ct_in_cur_domain_2 t' (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)\<rbrace>"
+      \<lbrace>\<lambda>_ s::det_state. ct_in_cur_domain_2 t' (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)\<rbrace>"
   assumes arch_switch_to_thread_valid_blocked[wp]:
-    "\<And>t. \<lbrace>valid_blocked and ct_in_q\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_blocked and ct_in_q\<rbrace>"
-  assumes arch_switch_to_thread_etcb_at'[wp]:
-    "\<And>P t' t. \<lbrace>etcb_at P t'\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. etcb_at P t'\<rbrace>"
+    "\<And>t. \<lbrace>valid_blocked and ct_in_q\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>_. valid_blocked and ct_in_q :: det_state \<Rightarrow> _\<rbrace>"
+  assumes arch_switch_to_thread_etcbs_of[wp]:
+    "\<And>P t. arch_switch_to_thread t \<lbrace>\<lambda>s::det_state. P (etcbs_of s)\<rbrace>"
+assumes arch_switch_to_thread_cur_domain[wp]:
+    "\<And>P t. arch_switch_to_thread t \<lbrace>\<lambda>s::det_state. P (cur_domain s)\<rbrace>"
   assumes arch_switch_to_idle_thread_valid_idle[wp]:
     "\<lbrace>valid_idle :: det_ext state \<Rightarrow> bool\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_. valid_idle\<rbrace>"
   assumes switch_to_idle_thread_ct_not_queued[wp]:
-    "\<lbrace>valid_queues and valid_etcbs and valid_idle\<rbrace>
+    "\<lbrace>valid_queues  and valid_idle\<rbrace>
       switch_to_idle_thread
-     \<lbrace>\<lambda>rv s. not_queued (cur_thread s) s\<rbrace>"
+     \<lbrace>\<lambda>rv s::det_state. not_queued (cur_thread s) s\<rbrace>"
   assumes switch_to_idle_thread_valid_blocked[wp]:
-    "\<lbrace>valid_blocked and ct_in_q\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>rv. valid_blocked\<rbrace>"
+    "\<lbrace>valid_blocked and ct_in_q\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>rv. valid_blocked :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_switch_to_thread_exst'[wp]:
     "\<And>P t. \<lbrace>\<lambda>s. P (exst s :: det_ext)\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>rv s. P (exst s)\<rbrace>"
-  assumes arch_switch_to_thread_scheduler_action'[wp]:
-    "\<And>P t.
-      \<lbrace>\<lambda>s. P (scheduler_action (s :: det_ext state))\<rbrace>
-        arch_switch_to_thread t
-      \<lbrace>\<lambda>rv s. P (scheduler_action (s :: det_ext state))\<rbrace>"
   assumes stit_activatable':
     "\<lbrace>valid_idle :: det_ext state \<Rightarrow> bool\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>rv . ct_in_state activatable\<rbrace>"
   assumes arch_switch_to_idle_thread_etcb_at'[wp]:
-    "\<And>P t. \<lbrace>etcb_at P t\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_. etcb_at P t\<rbrace>"
+    "\<And>P t. \<lbrace>etcb_at P t\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_. etcb_at P t :: det_state \<Rightarrow> _\<rbrace>"
   assumes switch_to_idle_thread_cur_thread_idle_thread [wp]:
     "\<lbrace>\<top> :: det_ext state \<Rightarrow> bool\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_ s. cur_thread s = idle_thread s\<rbrace>"
-  assumes arch_switch_to_idle_thread_scheduler_action'[wp]:
-    "\<And>P. \<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace> arch_switch_to_idle_thread \<lbrace>\<lambda>_ s. P (scheduler_action s)\<rbrace>"
   assumes arch_finalise_cap_ct_not_in_q'[wp]:
-    "\<And>acap final. \<lbrace>ct_not_in_q\<rbrace> arch_finalise_cap acap final \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
-  assumes arch_finalise_cap_valid_etcbs'[wp]:
-    "\<And>acap final. \<lbrace>valid_etcbs\<rbrace> arch_finalise_cap acap final \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
+    "\<And>acap final. \<lbrace>ct_not_in_q\<rbrace> arch_finalise_cap acap final \<lbrace>\<lambda>_. ct_not_in_q :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_finalise_cap_simple_sched_action'[wp]:
-    "\<And>acap final. \<lbrace>simple_sched_action\<rbrace> arch_finalise_cap acap final \<lbrace>\<lambda>_. simple_sched_action\<rbrace>"
+    "\<And>acap final. \<lbrace>simple_sched_action\<rbrace> arch_finalise_cap acap final \<lbrace>\<lambda>_. simple_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_finalise_cap_valid_sched'[wp]:
-    "\<And>acap final. \<lbrace>valid_sched\<rbrace> arch_finalise_cap acap final \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+    "\<And>acap final. \<lbrace>valid_sched\<rbrace> arch_finalise_cap acap final \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_cap_deletion_valid_idle[wp]:
     "\<And>target. \<lbrace>valid_idle :: det_ext state \<Rightarrow> bool\<rbrace>
                    arch_post_cap_deletion target
                   \<lbrace>\<lambda>_. valid_idle\<rbrace>"
   assumes handle_arch_fault_reply_valid_sched'[wp]:
-    "\<And>f t x y. \<lbrace>valid_sched\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+    "\<And>f t x y. \<lbrace>valid_sched\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes activate_thread_valid_sched:
-    "\<lbrace>valid_sched\<rbrace> activate_thread \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+    "\<lbrace>valid_sched\<rbrace> activate_thread \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_perform_invocation_valid_sched[wp]:
     "\<And>i.
       \<lbrace>invs and valid_sched and ct_active and valid_arch_inv i\<rbrace>
         arch_perform_invocation i
-      \<lbrace>\<lambda>_.valid_sched\<rbrace>"
+      \<lbrace>\<lambda>_.valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_invoke_irq_control_valid_sched'[wp]:
-    "\<And>i. \<lbrace>valid_sched\<rbrace> arch_invoke_irq_control i \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+    "\<And>i. \<lbrace>valid_sched\<rbrace> arch_invoke_irq_control i \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes handle_vm_fault_valid_sched'[wp]:
-    "\<And>t f. \<lbrace>valid_sched\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+    "\<And>t f. \<lbrace>valid_sched\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes handle_vm_fault_not_queued'[wp]:
-    "\<And>t' t f. \<lbrace>not_queued t'\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_. not_queued t'\<rbrace>"
+    "\<And>t' t f. \<lbrace>not_queued t'\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_. not_queued t' :: det_state \<Rightarrow> _\<rbrace>"
   assumes handle_vm_fault_scheduler_act_not'[wp]:
-    "\<And>t' t f. \<lbrace>scheduler_act_not t'\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_. scheduler_act_not t'\<rbrace>"
+    "\<And>t' t f. \<lbrace>scheduler_act_not t'\<rbrace> handle_vm_fault t f \<lbrace>\<lambda>_. scheduler_act_not t' :: det_state \<Rightarrow> _\<rbrace>"
   assumes handle_arch_fault_reply_not_queued'[wp]:
-    "\<And>t' f t x y. \<lbrace>not_queued t'\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_. not_queued t'\<rbrace>"
+    "\<And>t' f t x y. \<lbrace>not_queued t'\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_. not_queued t' :: det_state \<Rightarrow> _\<rbrace>"
   assumes handle_arch_fault_reply_scheduler_act_not'[wp]:
-    "\<And>t' f t x y. \<lbrace>scheduler_act_not t'\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_. scheduler_act_not t'\<rbrace>"
+    "\<And>t' f t x y. \<lbrace>scheduler_act_not t'\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_. scheduler_act_not t' :: det_state \<Rightarrow> _\<rbrace>"
   assumes handle_arch_fault_reply_cur'[wp]:
     "\<And>f t x y. \<lbrace>cur_tcb :: det_ext state \<Rightarrow> bool\<rbrace> handle_arch_fault_reply f t x y \<lbrace>\<lambda>_. cur_tcb\<rbrace>"
   assumes hvmf_st_tcb_at[wp]:
@@ -814,87 +820,71 @@ locale DetSchedSchedule_AI =
   assumes prepare_thread_delete_idel_thread[wp] :
     "\<And>t. prepare_thread_delete t \<lbrace>\<lambda>(s:: det_ext state). P (idle_thread s)\<rbrace>"
   assumes prepare_thread_delete_ct_not_in_q'[wp]:
-    "\<And>t. \<lbrace>ct_not_in_q\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
-  assumes prepare_thread_delete_valid_etcbs'[wp]:
-    "\<And>t. \<lbrace>valid_etcbs\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
+    "\<And>t. \<lbrace>ct_not_in_q\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_. ct_not_in_q :: det_state \<Rightarrow> _\<rbrace>"
   assumes prepare_thread_delete_simple_sched_action'[wp]:
-    "\<And>t. \<lbrace>simple_sched_action\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_. simple_sched_action\<rbrace>"
+    "\<And>t. \<lbrace>simple_sched_action\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_. simple_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   assumes prepare_thread_delete_valid_sched'[wp]:
-    "\<And>t. \<lbrace>valid_sched\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+    "\<And>t. \<lbrace>valid_sched\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes make_fault_arch_msg_not_cur_thread[wp] :
-    "\<And>ft t t'. make_arch_fault_msg ft t \<lbrace>not_cur_thread t'\<rbrace>"
+    "\<And>ft t t'. make_arch_fault_msg ft t \<lbrace>not_cur_thread t' :: det_state \<Rightarrow> _\<rbrace>"
   assumes make_fault_arch_msg_valid_sched[wp] :
-    "\<And>ft t. make_arch_fault_msg ft t \<lbrace>valid_sched\<rbrace>"
+    "\<And>ft t. make_arch_fault_msg ft t \<lbrace>valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes make_fault_arch_msg_scheduler_action[wp] :
-    "\<And>P ft t. make_arch_fault_msg ft t \<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace>"
+    "\<And>P ft t. make_arch_fault_msg ft t \<lbrace>\<lambda>s::det_state. P (scheduler_action s)\<rbrace>"
   assumes make_fault_arch_msg_ready_queues[wp] :
-    "\<And>P ft t. make_arch_fault_msg ft t \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace>"
-  assumes make_fault_arch_msg_valid_etcbs[wp] :
-    "\<And>ft t. make_arch_fault_msg ft t \<lbrace>valid_etcbs\<rbrace>"
+    "\<And>P ft t. make_arch_fault_msg ft t \<lbrace>\<lambda>s::det_state. P (ready_queues s)\<rbrace>"
   assumes arch_get_sanitise_register_info_not_cur_thread[wp] :
-    "\<And>ft t'. arch_get_sanitise_register_info ft \<lbrace>not_cur_thread t'\<rbrace>"
+    "\<And>ft t'. arch_get_sanitise_register_info ft \<lbrace>not_cur_thread t' :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_get_sanitise_register_info_valid_sched[wp] :
-    "\<And>ft. arch_get_sanitise_register_info ft \<lbrace>valid_sched\<rbrace>"
+    "\<And>ft. arch_get_sanitise_register_info ft \<lbrace>valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_get_sanitise_register_info_scheduler_action[wp] :
-    "\<And>P ft. arch_get_sanitise_register_info ft \<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace>"
+    "\<And>P ft. arch_get_sanitise_register_info ft \<lbrace>\<lambda>s::det_state. P (scheduler_action s)\<rbrace>"
   assumes arch_get_sanitise_register_info_ready_queues[wp] :
-    "\<And>P ft. arch_get_sanitise_register_info ft \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace>"
-  assumes arch_get_sanitise_register_info_valid_etcbs[wp] :
-    "\<And>ft. arch_get_sanitise_register_info ft \<lbrace>valid_etcbs\<rbrace>"
+    "\<And>P ft. arch_get_sanitise_register_info ft \<lbrace>\<lambda>s::det_state. P (ready_queues s)\<rbrace>"
   assumes arch_get_sanitise_register_info_cur'[wp]:
     "\<And>f. \<lbrace>cur_tcb :: det_ext state \<Rightarrow> bool\<rbrace> arch_get_sanitise_register_info f \<lbrace>\<lambda>_. cur_tcb\<rbrace>"
   assumes arch_post_modify_registers_not_cur_thread[wp] :
-    "\<And>c ft t'. arch_post_modify_registers c ft \<lbrace>not_cur_thread t'\<rbrace>"
+    "\<And>c ft t'. arch_post_modify_registers c ft \<lbrace>not_cur_thread t' :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_modify_registers_valid_sched[wp] :
-    "\<And>c ft. arch_post_modify_registers c ft \<lbrace>valid_sched\<rbrace>"
+    "\<And>c ft. arch_post_modify_registers c ft \<lbrace>valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_modify_registers_scheduler_action[wp] :
-    "\<And>P c ft. arch_post_modify_registers c ft \<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace>"
+    "\<And>P c ft. arch_post_modify_registers c ft \<lbrace>\<lambda>s::det_state. P (scheduler_action s)\<rbrace>"
   assumes arch_post_modify_registers_ready_queues[wp] :
-    "\<And>P c ft. arch_post_modify_registers c ft \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace>"
-  assumes arch_post_modify_registers_valid_etcbs[wp] :
-    "\<And>c ft. arch_post_modify_registers c ft \<lbrace>valid_etcbs\<rbrace>"
+    "\<And>P c ft. arch_post_modify_registers c ft \<lbrace>\<lambda>s::det_state. P (ready_queues s)\<rbrace>"
   assumes arch_post_modify_registers_cur'[wp]:
     "\<And>c f. \<lbrace>cur_tcb :: det_ext state \<Rightarrow> bool\<rbrace> arch_post_modify_registers c f \<lbrace>\<lambda>_. cur_tcb\<rbrace>"
   assumes arch_post_modify_registers_not_idle_thread[wp]:
     "\<And>c t. \<lbrace>\<lambda>s::det_ext state. t \<noteq> idle_thread s\<rbrace> arch_post_modify_registers c t \<lbrace>\<lambda>_ s. t \<noteq> idle_thread s\<rbrace>"
-  assumes arch_post_cap_deletion_valid_etcbs[wp] :
-    "\<And>c. arch_post_cap_deletion c \<lbrace>valid_etcbs\<rbrace>"
   assumes arch_post_cap_deletion_valid_sched[wp] :
-    "\<And>c. arch_post_cap_deletion c \<lbrace>valid_sched\<rbrace>"
+    "\<And>c. arch_post_cap_deletion c \<lbrace>valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_cap_deletion_ct_not_in_q[wp] :
-    "\<And>c. arch_post_cap_deletion c \<lbrace>ct_not_in_q\<rbrace>"
+    "\<And>c. arch_post_cap_deletion c \<lbrace>ct_not_in_q :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_cap_deletion_simple_sched_action[wp] :
-    "\<And>c. arch_post_cap_deletion c \<lbrace>simple_sched_action\<rbrace>"
+    "\<And>c. arch_post_cap_deletion c \<lbrace>simple_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_cap_deletion_not_cur_thread[wp] :
-    "\<And>c t. arch_post_cap_deletion c \<lbrace>not_cur_thread t\<rbrace>"
+    "\<And>c t. arch_post_cap_deletion c \<lbrace>not_cur_thread t :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_cap_deletion_sched_act_not[wp] :
-    "\<And>c t. arch_post_cap_deletion c \<lbrace>scheduler_act_not t\<rbrace>"
+    "\<And>c t. arch_post_cap_deletion c \<lbrace>scheduler_act_not t :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_cap_deletion_not_queued[wp] :
-    "\<And>c t. arch_post_cap_deletion c \<lbrace>not_queued t\<rbrace>"
-  assumes arch_post_cap_deletion_is_etcb_at[wp] :
-    "\<And>c t. arch_post_cap_deletion c \<lbrace>is_etcb_at t\<rbrace>"
+    "\<And>c t. arch_post_cap_deletion c \<lbrace>not_queued t :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_post_cap_deletion_weak_valid_sched_action[wp] :
-    "\<And>c. arch_post_cap_deletion c \<lbrace>weak_valid_sched_action\<rbrace>"
+    "\<And>c. arch_post_cap_deletion c \<lbrace>weak_valid_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_finalise_cap_idle_thread[wp] :
     "\<And>P b t. arch_finalise_cap t b \<lbrace>\<lambda> (s:: det_ext state). P (idle_thread s)\<rbrace>"
   assumes arch_invoke_irq_handler_valid_sched[wp]:
-    "\<And>i. arch_invoke_irq_handler i \<lbrace>valid_sched\<rbrace>"
+    "\<And>i. arch_invoke_irq_handler i \<lbrace>valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes arch_mask_irq_signal_valid_sched[wp]:
-    "\<And>irq. arch_mask_irq_signal irq \<lbrace>valid_sched\<rbrace>"
+    "\<And>irq. arch_mask_irq_signal irq \<lbrace>valid_sched :: det_state \<Rightarrow> _\<rbrace>"
 
 context DetSchedSchedule_AI begin
 
 crunch switch_to_idle_thread, switch_to_thread
-  for valid_etcbs[wp]: valid_etcbs
-  (simp: whenE_def)
-
-crunch switch_to_idle_thread, switch_to_thread
-  for valid_queues[wp]: valid_queues
+  for valid_queues[wp]: "valid_queues :: det_state \<Rightarrow> _"
   (simp: whenE_def ignore: set_tcb_queue tcb_sched_action)
 
 crunch
   switch_to_idle_thread, switch_to_thread
-  for weak_valid_sched_action[wp]: "weak_valid_sched_action"
+  for weak_valid_sched_action[wp]: "weak_valid_sched_action :: det_state \<Rightarrow> _"
   (simp: whenE_def)
 
 end
@@ -905,16 +895,17 @@ lemma tcb_sched_action_dequeue_ct_not_in_q_2_ct_upd:
    \<lbrace>\<lambda>r s. ct_not_in_q_2 (ready_queues s) (scheduler_action s) thread\<rbrace>"
   apply (simp add: tcb_sched_action_def unless_def set_tcb_queue_def)
   apply wp
-  apply (fastforce simp: etcb_at_def ct_not_in_q_def valid_queues_def
-                         tcb_sched_dequeue_def not_queued_def
-                   split: option.split)
+  apply (fastforce simp: etcb_at_def ct_not_in_q_def valid_queues_def tcb_sched_dequeue_def
+                         not_queued_def
+                   dest: ko_at_etcbD
+                  split: option.split)
   done
 
 lemma tcb_sched_action_dequeue_valid_sched_action_2_ct_upd:
   "\<lbrace>valid_sched_action and
        (\<lambda>s. is_activatable_2 thread (scheduler_action s) (kheap s))\<rbrace>
      tcb_sched_action tcb_sched_dequeue thread
-   \<lbrace>\<lambda>r s. valid_sched_action_2 (scheduler_action s) (ekheap s) (kheap s) thread (cur_domain s)\<rbrace>"
+   \<lbrace>\<lambda>r s. valid_sched_action_2 (scheduler_action s) (etcbs_of s) (kheap s) thread (cur_domain s)\<rbrace>"
   apply (simp add: tcb_sched_action_def unless_def set_tcb_queue_def)
   apply wp
   apply (clarsimp simp: etcb_at_def valid_sched_action_def split: option.split)
@@ -922,27 +913,31 @@ lemma tcb_sched_action_dequeue_valid_sched_action_2_ct_upd:
 
 context DetSchedSchedule_AI begin
 
+lemma etcbs_of_arch_state[simp]:
+  "get_tcb ref s = Some tcb \<Longrightarrow>
+  etcbs_of' (\<lambda>r. if r = ref then Some (TCB (tcb_arch_update f tcb)) else kheap s r) = etcbs_of' (kheap s)"
+  by (auto simp: etcbs_of_update_unrelated dest!: get_tcb_SomeD)
+
 lemma as_user_valid_sched[wp]:
   "\<lbrace>valid_sched\<rbrace> as_user tptr f \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
   apply (simp add: as_user_def set_object_def get_object_def)
   apply (wp | wpc)+
   apply clarsimp
-  apply (fastforce simp: valid_sched_def valid_etcbs_def valid_queues_def
-                         valid_sched_action_def is_activatable_def
-                         weak_valid_sched_action_def st_tcb_at_kh_if_split
-                         st_tcb_def2 valid_blocked_def)
-  done
+  by (fastforce simp: valid_sched_def valid_queues_def
+                      valid_sched_action_def is_activatable_def
+                      weak_valid_sched_action_def st_tcb_at_kh_if_split
+                      st_tcb_def2 valid_blocked_def)
 
 lemma tcb_sched_action_dequeue_not_queued[wp]:
   "\<lbrace>valid_queues\<rbrace> tcb_sched_action tcb_sched_dequeue t \<lbrace>\<lambda>_. not_queued t\<rbrace>"
   unfolding tcb_sched_action_def tcb_sched_dequeue_def
   apply wpsimp
-  apply (clarsimp simp add: valid_queues_def etcb_at_def not_queued_def
-                       split: option.splits)
+  apply (fastforce simp: valid_queues_def etcb_at_def not_queued_def
+                  dest!: ko_at_etcbD)
   done
 
 lemma switch_to_thread_ct_not_queued[wp]:
-  "\<lbrace>valid_queues\<rbrace> switch_to_thread t \<lbrace>\<lambda>rv s. not_queued (cur_thread s) s\<rbrace>"
+  "\<lbrace>valid_queues\<rbrace> switch_to_thread t \<lbrace>\<lambda>rv s::det_state. not_queued (cur_thread s) s\<rbrace>"
   unfolding switch_to_thread_def
   by wpsimp
 
@@ -955,7 +950,7 @@ lemma ct_not_in_q_def2:
 context DetSchedSchedule_AI begin
 
 lemma switch_to_thread_ct_not_in_q[wp]:
-  "\<lbrace>valid_queues\<rbrace> switch_to_thread t \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
+  "\<lbrace>valid_queues\<rbrace> switch_to_thread t \<lbrace>\<lambda>_. ct_not_in_q :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: ct_not_in_q_def2 not_queued_def[symmetric])
   apply (wp hoare_drop_imps | simp)+
   done
@@ -963,13 +958,13 @@ lemma switch_to_thread_ct_not_in_q[wp]:
 lemma switch_to_thread_valid_sched_action[wp]:
   "\<lbrace>valid_sched_action and is_activatable t\<rbrace>
      switch_to_thread t
-   \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
+   \<lbrace>\<lambda>_. valid_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   by (wpsimp wp: tcb_sched_action_dequeue_valid_sched_action_2_ct_upd simp: switch_to_thread_def)
 
 end
 
 lemma tcb_sched_action_dequeue_ct_in_cur_domain':
-  "\<lbrace>\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)\<rbrace>
+  "\<lbrace>\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)\<rbrace>
     tcb_sched_action tcb_sched_dequeue thread
   \<lbrace>\<lambda>_ s. ct_in_cur_domain (s\<lparr>cur_thread := thread\<rparr>)\<rbrace>"
   apply (simp add: tcb_sched_action_def)
@@ -980,12 +975,13 @@ lemma tcb_sched_action_dequeue_ct_in_cur_domain':
 context DetSchedSchedule_AI begin
 
 crunch as_user
-  for ct_in_cur_domain_2[wp]: "\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)"
-  (simp: whenE_def get_object_def)
+  for ct_in_cur_domain_2[wp]: "\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)"
+  (wp: set_object_wp)
 
 lemma switch_to_thread_ct_in_cur_domain[wp]:
-  "\<lbrace>\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)\<rbrace>
-  switch_to_thread thread \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
+  "\<lbrace>\<lambda>s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)\<rbrace>
+   switch_to_thread thread
+   \<lbrace>\<lambda>_. ct_in_cur_domain :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: switch_to_thread_def)
   apply (wpsimp wp: tcb_sched_action_dequeue_ct_in_cur_domain')
   done
@@ -1050,7 +1046,7 @@ lemma do_machine_op_valid_blocked[wp]:
 context DetSchedSchedule_AI begin
 
 lemma switch_to_thread_valid_blocked[wp]:
-  "\<lbrace>valid_blocked and ct_in_q\<rbrace> switch_to_thread thread \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
+  "\<lbrace>valid_blocked and ct_in_q\<rbrace> switch_to_thread thread \<lbrace>\<lambda>_. valid_blocked :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: switch_to_thread_def)
   apply (wp|wpc)+
      prefer 4
@@ -1062,12 +1058,12 @@ lemma switch_to_thread_valid_blocked[wp]:
   by (wp tcb_sched_action_dequeue_ct_in_cur_domain' tcb_sched_action_dequeue_valid_blocked')
 
 crunch switch_to_thread
-  for etcb_at[wp]: "etcb_at P t"
+  for etcb_at[wp]: "etcb_at P t :: det_state \<Rightarrow> _"
 
 lemma switch_to_thread_valid_sched:
-  "\<lbrace>is_activatable t and in_cur_domain t and valid_sched_action and valid_etcbs and valid_queues and valid_blocked and ct_in_q and valid_idle_etcb\<rbrace>
+  "\<lbrace>is_activatable t and in_cur_domain t and valid_sched_action and valid_queues and valid_blocked and ct_in_q and valid_idle_etcb\<rbrace>
     switch_to_thread t
-   \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: valid_sched_def | wp | simp add: ct_in_cur_domain_2_def)+
   done
 
@@ -1079,8 +1075,6 @@ crunch switch_to_thread
 
 end
 
-crunch update_cdt_list
-  for valid_etcbs[wp]: "valid_etcbs"
 crunch update_cdt_list
   for valid_queues[wp]: "valid_queues"
 crunch update_cdt_list
@@ -1094,9 +1088,6 @@ crunch update_cdt_list
 crunch update_cdt_list
   for valid_sched[wp]: "valid_sched"
 
-crunch set_cdt, set_cap
-  for valid_etcbs[wp]: valid_etcbs
-  (wp: valid_etcbs_lift set_cap_typ_at)
 crunch set_cdt, set_cap
   for valid_queues[wp]: valid_queues
   (wp: valid_queues_lift)
@@ -1117,12 +1108,12 @@ crunch set_cdt, set_cap
   (wp: valid_sched_lift set_cap_typ_at)
 
 crunch cap_insert
-  for ct_not_in_q[wp]: ct_not_in_q
-  (wp: hoare_drop_imps)
+  for ct_not_in_q[wp]: "ct_not_in_q"
+  (wp: hoare_drop_imps dxo_wp_weak)
 
 crunch cap_insert
-  for weak_valid_sched_action[wp]: weak_valid_sched_action
-  (wp: hoare_drop_imps)
+  for weak_valid_sched_action[wp]: "weak_valid_sched_action"
+  (wp: hoare_drop_imps dxo_wp_weak)
 
 lemma valid_queues_trivial[simp]: "valid_queues_2 (\<lambda>_ _. []) kh ekh"
 by (simp add: valid_queues_def)
@@ -1199,22 +1190,22 @@ lemma next_thread_queued: "queues p \<noteq> [] \<Longrightarrow> \<exists>p. ne
 context DetSchedSchedule_AI begin
 
 crunch switch_to_idle_thread
-  for etcb_at[wp]: "etcb_at P t"
+  for etcb_at[wp]: "etcb_at P t :: det_state \<Rightarrow> _"
 
 lemma switch_to_idle_thread_valid_sched:
-  "\<lbrace>valid_sched_action and valid_idle and valid_queues and valid_etcbs and valid_blocked and ct_in_q and valid_idle_etcb\<rbrace>
+  "\<lbrace>valid_sched_action and valid_idle and valid_queues and valid_blocked and ct_in_q and valid_idle_etcb\<rbrace>
      switch_to_idle_thread
-   \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   by (simp add: valid_sched_def | wp)+
 
 crunch choose_thread
-  for etcb_at[wp]: "etcb_at P t"
+  for etcb_at[wp]: "etcb_at P t :: det_state \<Rightarrow> _"
   (wp: crunch_wps)
 
 lemma choose_thread_valid_sched[wp]:
-  "\<lbrace>valid_sched_action and valid_idle and valid_etcbs and valid_queues and valid_blocked and ct_in_q and valid_idle_etcb\<rbrace>
+  "\<lbrace>valid_sched_action and valid_idle and valid_queues and valid_blocked and ct_in_q and valid_idle_etcb\<rbrace>
      choose_thread
-   \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: choose_thread_def)
   apply (wp guarded_switch_to_lift switch_to_idle_thread_valid_sched switch_to_thread_valid_sched)
   apply (clarsimp simp: valid_queues_def next_thread_def is_activatable_2_def
@@ -1230,25 +1221,20 @@ lemma tcb_sched_enqueue_in_cur_domain:
   done
 
 crunch next_domain
-  for valid_etcbs: valid_etcbs (simp: Let_def)
-crunch next_domain
-  for valid_queues: valid_queues (simp: Let_def)
-crunch next_domain
-  for valid_blocked: valid_blocked (simp: Let_def)
-crunch next_domain
-  for ct_in_q: ct_in_q (simp: Let_def ct_in_q_def)
-crunch next_domain
-  for ct_not_in_q: ct_not_in_q (simp: Let_def)
+  for valid_queues: valid_queues
+  and valid_blocked: valid_blocked
+  and ct_in_q: ct_in_q
+  and ct_not_in_q: ct_not_in_q
+  (simp: Let_def ct_in_q_def wp: dxo_wp_weak)
 
 lemma next_domain_valid_sched_action:
   "\<lbrace>\<lambda>s. scheduler_action s = choose_new_thread\<rbrace> next_domain \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
-  apply (simp add: next_domain_def thread_set_domain_def ethread_set_def set_eobject_def)
-  apply wp
-  apply (clarsimp simp: Let_def valid_sched_action_def weak_valid_sched_action_def
-                        get_etcb_def etcb_at_def)
+  apply (simp add: next_domain_def thread_set_domain_def)
+  apply (wpsimp wp: dxo_wp_weak)
+  apply (clarsimp simp: Let_def valid_sched_action_def weak_valid_sched_action_def)
   done
 
-lemma tcb_sched_action_dequeue_in_cur_domain:
+lemma tcb_sched_action_dequeue_in_cur_domain[wp]:
   "\<lbrace>in_cur_domain thread\<rbrace>
     tcb_sched_action tcb_sched_dequeue thread
   \<lbrace>\<lambda>_. in_cur_domain thread\<rbrace>"
@@ -1261,8 +1247,8 @@ context DetSchedSchedule_AI begin
 lemma switch_to_thread_cur_in_cur_domain[wp]:
   "\<lbrace>in_cur_domain t\<rbrace>
     switch_to_thread t
-   \<lbrace>\<lambda>_ s. in_cur_domain (cur_thread s) s\<rbrace>"
-  apply (simp add: switch_to_thread_def | wp tcb_sched_action_dequeue_in_cur_domain)+
+   \<lbrace>\<lambda>_ s::det_state. in_cur_domain (cur_thread s) s\<rbrace>"
+  apply (simp add: switch_to_thread_def | wp | wps)+
   done
 end
 
@@ -1314,16 +1300,16 @@ end
 
 crunch next_domain
   for valid_idle_etcb[wp]: "valid_idle_etcb"
-  (simp: Let_def)
+  (simp: Let_def wp: dxo_wp_weak)
 
 context DetSchedSchedule_AI begin
 
 lemma choose_thread_ct_not_queued:
-  "\<lbrace> valid_queues and valid_idle and valid_etcbs \<rbrace> choose_thread \<lbrace>\<lambda>_. ct_not_queued \<rbrace>"
+  "\<lbrace> valid_queues and valid_idle \<rbrace> choose_thread \<lbrace>\<lambda>_. ct_not_queued :: det_state \<Rightarrow> _\<rbrace>"
   by (wpsimp simp: choose_thread_def wp: guarded_switch_to_lift)
 
 lemma choose_thread_ct_activatable:
-  "\<lbrace> valid_queues and valid_idle \<rbrace> choose_thread \<lbrace>\<lambda>_ s.  st_tcb_at activatable (cur_thread s) s \<rbrace>"
+  "\<lbrace> valid_queues and valid_idle \<rbrace> choose_thread \<lbrace>\<lambda>_ s::det_state.  st_tcb_at activatable (cur_thread s) s \<rbrace>"
   apply (wpsimp simp: choose_thread_def
                 wp: guarded_switch_to_lift stit_activatable'[simplified ct_in_state_def]
                     stt_activatable[simplified ct_in_state_def])
@@ -1334,7 +1320,7 @@ lemma choose_thread_ct_activatable:
 lemma choose_thread_cur_dom_or_idle:
   "\<lbrace> valid_queues \<rbrace>
    choose_thread
-   \<lbrace>\<lambda>_ s. (in_cur_domain (cur_thread s) s \<or> cur_thread s = idle_thread s) \<rbrace>"
+   \<lbrace>\<lambda>_ s::det_state. (in_cur_domain (cur_thread s) s \<or> cur_thread s = idle_thread s) \<rbrace>"
   apply (wpsimp simp: choose_thread_def
                 wp: guarded_switch_to_lift)
       apply (rule hoare_disjI2) (* idle thread *)
@@ -1347,7 +1333,7 @@ lemma choose_thread_cur_dom_or_idle:
   done
 
 crunch choose_thread
-  for sched_act[wp]: "\<lambda>s. P (scheduler_action s)"
+  for sched_act[wp]: "\<lambda>s::det_state. P (scheduler_action s)"
   (wp: guarded_switch_to_lift)
 
 lemma valid_sched_action_from_choose_thread:
@@ -1404,27 +1390,26 @@ lemma append_thread_queued:
 
 (* having is_highest_prio match gets_wp makes it very hard to stop and drop imps etc. *)
 definition
-  "wrap_is_highest_prio cur_dom target_prio \<equiv> Nondet_Monad.gets (is_highest_prio cur_dom target_prio)"
+  "wrap_is_highest_prio cur_dom target_prio \<equiv> gets (is_highest_prio cur_dom target_prio)"
 
 lemma schedule_choose_new_thread_valid_sched:
-  "\<lbrace> valid_idle and valid_etcbs and valid_idle_etcb and valid_queues and valid_blocked
+  "\<lbrace> valid_idle and valid_idle_etcb and valid_queues and valid_blocked
      and (\<lambda>s. scheduler_action s = choose_new_thread)
      and ct_in_q \<rbrace>
    schedule_choose_new_thread
-   \<lbrace>\<lambda>_. valid_sched \<rbrace>"
+   \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   unfolding schedule_choose_new_thread_def
   apply (wpsimp wp_del: when_wp
                  wp: set_scheduler_action_rct_valid_sched choose_thread_ct_not_queued
                      choose_thread_ct_activatable choose_thread_cur_dom_or_idle
                      hoare_vcg_disj_lift)+
-    apply (wpsimp wp: next_domain_valid_sched_action next_domain_valid_etcbs
+    apply (wpsimp wp: next_domain_valid_sched_action
                       next_domain_valid_queues next_domain_valid_blocked next_domain_ct_in_q)+
   done
 
 lemma schedule_valid_sched:
-  "\<lbrace>valid_sched and valid_idle\<rbrace> schedule \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+  "\<lbrace>valid_sched and valid_idle\<rbrace> schedule \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   unfolding schedule_def
-  supply ethread_get_wp[wp del]
   apply (wp, wpc)
          (* resume_cur_thread *)
          apply wp
@@ -1449,9 +1434,9 @@ lemma schedule_valid_sched:
                          hoare_disjI1[OF switch_to_thread_cur_in_cur_domain]
                          switch_to_thread_sched_act_is_cur)+
            (* discard result of fastfail calculation *)
-           apply (wpsimp wp: hoare_drop_imp)+
+           apply (wpsimp wp: thread_get_inv hoare_drop_imp)+ \<comment> \<open>FIXME: remove @{thm thread_get_prio_wp} from wp?\<close>
        apply (strengthen valid_blocked_valid_blocked_except)
-       apply (wp tcb_sched_action_enqueue_valid_blocked tcb_sched_enqueue_cur_ct_in_q gts_wp)+
+       apply (wp tcb_sched_action_enqueue_valid_blocked tcb_sched_enqueue_cur_ct_in_q gts_wp )+
 
   apply (clarsimp simp: valid_sched_def valid_sched_action_def weak_valid_sched_action_def
                         switch_in_cur_domain_def)
@@ -1470,16 +1455,23 @@ crunch update_restart_pc
   for ct_not_in_q[wp]: "\<lambda>s. ct_not_in_q s"
 
 
-crunch finalise_cap
+crunch
+  thread_set, cancel_all_ipc, unbind_maybe_notification, cancel_all_signals, unbind_notification,
+  blocked_cancel_ipc, fast_finalise, deleted_irq_handler
   for ct_not_in_q[wp]: ct_not_in_q
-  (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp
-       subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action)
+  (wp: crunch_wps ignore: tcb_sched_action)
+
+crunch finalise_cap
+  for ct_not_in_q[wp]: "ct_not_in_q :: det_state \<Rightarrow> _"
+  (wp: crunch_wps simp: crunch_simps ignore: tcb_sched_action)
 
 end
 
-lemma set_simple_ko_valid_etcbs[wp]:
-  "\<lbrace>valid_etcbs\<rbrace> set_simple_ko f ptr ep \<lbrace>\<lambda>rv. valid_etcbs\<rbrace>"
-  by (wp hoare_drop_imps valid_etcbs_lift | simp add: set_simple_ko_def)+
+lemma set_simple_ko_etcbs_of[wp]:
+  "set_simple_ko f ptr ep \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
+  unfolding set_simple_ko_def
+  apply (wpsimp wp: set_object_wp_strong get_object_wp)
+  by (auto elim!: rsubst[where P=P] simp: etcbs_of'_def obj_at_def)
 
 lemma set_simple_ko_valid_queues[wp]:
   "\<lbrace>valid_queues\<rbrace> set_simple_ko f ptr ep \<lbrace>\<lambda>rv. valid_queues\<rbrace>"
@@ -1505,10 +1497,6 @@ lemma set_simple_ko_valid_blocked[wp]:
   "\<lbrace>valid_blocked\<rbrace> set_simple_ko f ptr ep \<lbrace>\<lambda>rv. valid_blocked\<rbrace>"
   by (wp hoare_drop_imps valid_blocked_lift | simp add: set_simple_ko_def)+
 
-crunch set_simple_ko
-  for etcb_at[wp]: "etcb_at P t"
-  (wp: crunch_wps simp: crunch_simps)
-
 lemma cancel_all_ipc_valid_sched[wp]:
   "\<lbrace>valid_sched\<rbrace> cancel_all_ipc epptr \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
   apply (simp add: cancel_all_ipc_def)
@@ -1535,15 +1523,22 @@ lemma cancel_all_signals_valid_sched[wp]:
   apply (simp_all add: valid_sched_def valid_sched_action_def)
   done
 
-lemma thread_set_valid_etcbs[wp]:
-  "\<lbrace>valid_etcbs\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. valid_etcbs\<rbrace>"
-  by (wp hoare_drop_imps valid_etcbs_lift | simp add: thread_set_def)+
+lemma thread_set_etcbs:
+  "\<lbrakk>\<And>x. tcb_priority (f x) = tcb_priority x; \<And>x. tcb_domain (f x) = tcb_domain x\<rbrakk> \<Longrightarrow>
+  thread_set f tptr \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
+  unfolding thread_set_def
+  apply (wpsimp wp: set_object_wp get_object_wp)
+  by (auto elim!: rsubst[where P=P] dest!: get_tcb_SomeD simp: etcbs_of'_def)
+
+crunch thread_set
+  for ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
+  and cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
 
 lemma thread_set_valid_queues:
-  "(\<And>x. tcb_state (f x) = tcb_state x) \<Longrightarrow>
-    \<lbrace>valid_queues\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. valid_queues\<rbrace>"
-  by (wp hoare_drop_imps valid_queues_lift thread_set_no_change_tcb_state |
-      simp add: thread_set_def)+
+  "\<lbrakk>\<And>x. tcb_state (f x) = tcb_state x; \<And>x. tcb_priority (f x) = tcb_priority x;
+    \<And>x. tcb_domain (f x) = tcb_domain x\<rbrakk> \<Longrightarrow>
+   \<lbrace>valid_queues\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. valid_queues\<rbrace>"
+  by (rule valid_queues_lift; wpsimp wp: thread_set_no_change_tcb_state thread_set_etcbs)
 
 lemma thread_set_weak_valid_sched_action:
   "(\<And>x. tcb_state (f x) = tcb_state x) \<Longrightarrow>
@@ -1552,10 +1547,10 @@ lemma thread_set_weak_valid_sched_action:
         | simp add: thread_set_def)+
 
 lemma thread_set_not_state_valid_sched:
-  "(\<And>x. tcb_state (f x) = tcb_state x) \<Longrightarrow>
+  "\<lbrakk>\<And>x. tcb_state (f x) = tcb_state x; \<And>x. tcb_priority (f x) = tcb_priority x;
+    \<And>x. tcb_domain (f x) = tcb_domain x\<rbrakk> \<Longrightarrow>
    \<lbrace>valid_sched\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
-  by (wp hoare_drop_imps valid_sched_lift thread_set_no_change_tcb_state |
-      simp add: thread_set_def)+
+  by (rule valid_sched_lift; (wpsimp wp: thread_set_no_change_tcb_state thread_set_etcbs)?)
 
 lemma unbind_notification_valid_sched[wp]:
   "\<lbrace>valid_sched\<rbrace> unbind_notification ntfnptr \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
@@ -1567,22 +1562,14 @@ lemma unbind_notification_valid_sched[wp]:
   apply (wp set_bound_notification_valid_sched, clarsimp)
   done
 
-crunch update_restart_pc
-  for valid_etcbs[wp]: "valid_etcbs"
-
 context DetSchedSchedule_AI begin
 
-crunch finalise_cap
-  for valid_etcbs[wp]: valid_etcbs
-  (wp: hoare_drop_imps unless_wp select_inv mapM_x_wp mapM_wp subset_refl
-       if_fun_split simp: crunch_simps ignore: set_object)
-
 crunch cap_swap_for_delete, empty_slot, cap_delete_one
-  for valid_sched[wp]: valid_sched
+  for valid_sched[wp]: "valid_sched :: det_state \<Rightarrow> _"
   (simp: unless_def)
 
 lemma reply_cancel_ipc_valid_sched[wp]:
-  "\<lbrace>valid_sched\<rbrace> reply_cancel_ipc tptr \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  "\<lbrace>valid_sched\<rbrace> reply_cancel_ipc tptr \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: reply_cancel_ipc_def)
   apply (wp hoare_drop_imps thread_set_not_state_valid_sched | simp)+
   done
@@ -1599,8 +1586,8 @@ lemma set_thread_state_not_runnable_valid_queues:
   "\<lbrace>valid_queues and ct_not_in_q and (\<lambda>s. st_tcb_at (\<lambda>ts. \<not> runnable ts) ref s)\<rbrace>
      set_thread_state ref ts
    \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def | wp)+
+  apply (simp add: set_thread_state_def set_thread_state_act_def)
+  apply (simp add: set_object_def get_object_def | wp)+
   apply (fastforce simp: valid_queues_def st_tcb_at_kh_if_split ct_not_in_q_def
                          st_tcb_at_not)
   done
@@ -1608,8 +1595,8 @@ lemma set_thread_state_not_runnable_valid_queues:
 lemma set_thread_state_not_runnable_weak_valid_sched_action:
   "\<lbrace>weak_valid_sched_action and (\<lambda>s. st_tcb_at (\<lambda>ts. \<not> runnable ts) ref s)\<rbrace>
       set_thread_state ref ts \<lbrace>\<lambda>_. weak_valid_sched_action\<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def | wp gts_wp)+
+  apply (simp add: set_thread_state_def set_thread_state_act_def)
+  apply (simp add: set_object_def get_object_def | wp gts_wp)+
   apply (clarsimp simp: weak_valid_sched_action_def st_tcb_at_kh_if_split
                         st_tcb_at_not)
   done
@@ -1625,8 +1612,8 @@ lemma set_thread_state_not_runnable_valid_sched_action:
 lemma set_thread_state_not_runnable_valid_blocked:
   "\<lbrace>valid_blocked and K (\<not> runnable ts)\<rbrace>
       set_thread_state ref ts \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def set_object_def get_object_def | wp)+
+  apply (simp add: set_thread_state_def set_thread_state_act_def)
+  apply (simp add: set_object_def get_object_def | wp)+
        apply (rule hoare_strengthen_post)
        apply (rule set_scheduler_action_cnt_valid_blocked_weak)
       apply simp
@@ -1663,7 +1650,7 @@ lemma cancel_signal_valid_sched[wp]:
   done
 
 lemma (in DetSchedSchedule_AI) cancel_ipc_valid_sched[wp]:
-  "\<lbrace>valid_sched\<rbrace> cancel_ipc tptr \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  "\<lbrace>valid_sched\<rbrace> cancel_ipc tptr \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: cancel_ipc_def get_thread_state_def thread_get_def)
   apply (wp | wpc)+
   apply (fastforce intro: st_tcb_at_get_lift)
@@ -1671,10 +1658,10 @@ lemma (in DetSchedSchedule_AI) cancel_ipc_valid_sched[wp]:
 
 (* valid_queues with thread not runnable *)
 lemma tcb_sched_action_dequeue_strong_valid_sched:
-  "\<lbrace>valid_etcbs and ct_not_in_q and valid_sched_action and ct_in_cur_domain and
+  "\<lbrace>ct_not_in_q and valid_sched_action and ct_in_cur_domain and
     valid_blocked and st_tcb_at (\<lambda>st. \<not> runnable st) thread and
-    (\<lambda>es. \<forall>d p. (\<forall>t\<in>set (ready_queues es d p). is_etcb_at t es \<and>
-        etcb_at (\<lambda>t. tcb_priority t = p \<and> tcb_domain t = d) t es \<and>
+    (\<lambda>es. \<forall>d p. (\<forall>t\<in>set (ready_queues es d p). is_etcb_at' t (etcbs_of es) \<and>
+        etcb_at (\<lambda>t. etcb_priority t = p \<and> etcb_domain t = d) t es \<and>
         (t \<noteq> thread \<longrightarrow> st_tcb_at runnable t es)) \<and> distinct (ready_queues es d p)) and
     valid_idle_etcb\<rbrace>
     tcb_sched_action tcb_sched_dequeue thread
@@ -1683,7 +1670,8 @@ lemma tcb_sched_action_dequeue_strong_valid_sched:
   apply wp
   apply (clarsimp simp: etcb_at_def valid_sched_def split: option.split)
   apply (rule conjI)
-   apply (fastforce simp: etcb_at_def is_etcb_at_def valid_queues_def2 tcb_sched_dequeue_def)
+   apply (fastforce simp: etcb_at_def etcbs_of'_def is_etcb_at_def valid_queues_def2
+                          tcb_sched_dequeue_def obj_at_def)
   apply (rule conjI)
    apply (fastforce simp: ct_not_in_q_def not_queued_def tcb_sched_dequeue_def)
   apply (clarsimp simp: valid_blocked_def tcb_sched_dequeue_def)
@@ -1708,9 +1696,6 @@ lemma reschedule_required_simple_sched_action[wp]:
   "\<lbrace>simple_sched_action\<rbrace> reschedule_required  \<lbrace>\<lambda>rv. simple_sched_action\<rbrace>"
   by (simp add: reschedule_required_def | wp)+
 
-crunch tcb_sched_action, update_cdt_list
-  for simple_sched_action[wp]: simple_sched_action
-
 context DetSchedSchedule_AI begin
 
 crunch update_restart_pc
@@ -1719,13 +1704,13 @@ crunch update_restart_pc
   (simp: crunch_simps ignore: set_object)
 
 crunch finalise_cap
-  for simple_sched_action[wp]: simple_sched_action
+  for simple_sched_action[wp]: "simple_sched_action :: det_state \<Rightarrow> _"
   (wp: hoare_drop_imps mapM_x_wp mapM_wp subset_refl
    simp: unless_def if_fun_split)
 
 lemma suspend_valid_sched[wp]:
   notes bind_wp_fwd_inv = bind_wp_fwd[where P=I and Q'="\<lambda>_. I" for I]
-  shows "\<lbrace>valid_sched and simple_sched_action\<rbrace> suspend t \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  shows "\<lbrace>valid_sched and simple_sched_action\<rbrace> suspend t \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: suspend_def)
   apply (rule bind_wp_fwd_inv)
    apply wpsimp
@@ -1737,7 +1722,7 @@ lemma suspend_valid_sched[wp]:
        | simp)+
    apply (simp add: set_thread_state_def)
    apply (wp gts_wp | wpc |
-          simp add: set_thread_state_def set_thread_state_ext_def
+          simp add: set_thread_state_def set_thread_state_act_def
                     reschedule_required_def set_scheduler_action_def
                     tcb_sched_action_def set_object_def get_object_def)+
   apply (simp only: st_tcb_at_kh_simp[symmetric])
@@ -1748,143 +1733,49 @@ lemma suspend_valid_sched[wp]:
   done
 
 crunch finalise_cap
-  for valid_sched[wp]: valid_sched
+  for valid_sched[wp]: "valid_sched :: det_state \<Rightarrow> _"
   (wp: crunch_wps simp: crunch_simps)
 
 end
 
 crunch cap_swap_for_delete, cap_insert
-  for simple_sched_action[wp]: simple_sched_action
-  (wp: mapM_wp subset_refl hoare_drop_imps)
+  for simple_sched_action[wp]: "simple_sched_action"
+  (wp: dxo_wp_weak)
 
 context DetSchedSchedule_AI begin
 
 lemma rec_del_valid_sched'[wp]:
   "\<lbrace>valid_sched and simple_sched_action\<rbrace>
     rec_del call
-   \<lbrace>\<lambda>rv. valid_sched and simple_sched_action\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched and simple_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   apply (rule rec_del_preservation)
   apply (wp preemption_point_inv' | simp)+
   done
 
 lemma rec_del_valid_sched[wp]:
-  "\<lbrace>valid_sched and simple_sched_action\<rbrace> rec_del call \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  "\<lbrace>valid_sched and simple_sched_action\<rbrace> rec_del call \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (rule hoare_strengthen_post)
   apply (rule rec_del_valid_sched')
   apply simp
   done
 
 lemma rec_del_simple_sched_action[wp]:
-  "\<lbrace>simple_sched_action\<rbrace> rec_del call \<lbrace>\<lambda>rv. simple_sched_action\<rbrace>"
+  "\<lbrace>simple_sched_action\<rbrace> rec_del call \<lbrace>\<lambda>rv. simple_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   by (wp rec_del_preservation preemption_point_inv' | simp)+
 
 end
 
-lemma ethread_set_valid_etcbs[wp]:
-  "\<lbrace>valid_etcbs\<rbrace> ethread_set f tptr \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def | wp)+
-  apply (clarsimp simp: valid_etcbs_def is_etcb_at_def get_etcb_def)
-  done
-
-crunch ethread_set
-  for ct_not_in_q[wp]: "ct_not_in_q"
-
-crunch ethread_set, tcb_sched_action
-  for not_cur_thread[wp]: "not_cur_thread t"
-
-crunch ethread_set
-  for cur_is_activatable[wp]: "\<lambda>s. is_activatable (cur_thread s) s"
-
-lemma ethread_set_not_queued_valid_queues:
-  "\<lbrace>valid_queues and not_queued tptr\<rbrace>
-     ethread_set f tptr
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def not_queued_def | wp)+
-  apply (clarsimp simp: valid_queues_def is_etcb_at_def etcb_at_def)
-  done
-
-lemma ethread_set_weak_valid_sched_action[wp]:
-  "\<lbrace>weak_valid_sched_action\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. weak_valid_sched_action\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def | wp)+
-  apply (clarsimp simp: weak_valid_sched_action_def is_etcb_at_def etcb_at_def get_etcb_def)
-  done
-
-lemma ethread_set_not_domain_switch_in_cur_domain:
-  "(\<And>x. tcb_domain (f x) = tcb_domain x)
-  \<Longrightarrow> \<lbrace>switch_in_cur_domain\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. switch_in_cur_domain\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def | wp)+
-  apply (clarsimp simp: switch_in_cur_domain_def in_cur_domain_def etcb_at_def get_etcb_def)
-  done
-
-lemma ethread_set_not_domain_ct_in_cur_domain:
-  "(\<And>x. tcb_domain (f x) = tcb_domain x)
-  \<Longrightarrow> \<lbrace>ct_in_cur_domain\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def | wp)+
-  apply (clarsimp simp: ct_in_cur_domain_def in_cur_domain_def etcb_at_def get_etcb_def)
-  done
-
-lemma ethread_set_not_domain_valid_blocked:
-  "(\<And>x. tcb_domain (f x) = tcb_domain x)
-  \<Longrightarrow> \<lbrace>valid_blocked\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def | wp)+
-  done
-
-lemma ethread_set_not_domain_valid_blocked_except:
-  "(\<And>x. tcb_domain (f x) = tcb_domain x)
-  \<Longrightarrow> \<lbrace>valid_blocked_except ref\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_blocked_except ref\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def | wp)+
-  done
-
-lemma ethread_set_not_domain_valid_sched_action:
-  "(\<And>x. tcb_domain (f x) = tcb_domain x)
-  \<Longrightarrow> \<lbrace>valid_sched_action\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
-  apply (simp add: valid_sched_action_def | wp ethread_set_not_domain_switch_in_cur_domain)+
-  done
-
-lemma ethread_set_valid_idle_etcb:
-  "(\<And>x. tcb_domain (f x) = tcb_domain x)
-  \<Longrightarrow> \<lbrace>valid_idle_etcb\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_idle_etcb\<rbrace>"
-  apply(simp add: ethread_set_def valid_idle_etcb_def set_eobject_def)
-  apply wp
-  apply(simp add: etcb_at_def get_etcb_def split: option.splits)
-  done
-
-lemma ethread_set_not_queued_valid_sched:
-  "(\<And>x. tcb_domain (f x) = tcb_domain x)
-  \<Longrightarrow> \<lbrace>valid_sched and not_queued tptr\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_sched\<rbrace>"
-  apply (simp add: valid_sched_def valid_sched_action_def | wp ethread_set_not_queued_valid_queues ethread_set_not_domain_switch_in_cur_domain ethread_set_not_domain_ct_in_cur_domain ethread_set_not_domain_valid_blocked ethread_set_valid_idle_etcb)+
-  done
-
 lemma tcb_dequeue_not_queued:
   "\<lbrace>valid_queues\<rbrace> tcb_sched_action tcb_sched_dequeue tptr \<lbrace>\<lambda>_. not_queued tptr\<rbrace>"
   apply (simp add: tcb_sched_action_def | wp)+
-  apply (clarsimp simp: etcb_at_def tcb_sched_dequeue_def not_queued_def
-                        valid_queues_def
-                  split: option.splits)
-  done
-
-crunch set_eobject, set_tcb_queue
-  for ct_in_state[wp]: "ct_in_state P"
-  (simp: ct_in_state_def pred_tcb_at_def obj_at_def)
+  by (fastforce simp: etcb_at_def tcb_sched_dequeue_def not_queued_def valid_queues_def
+               dest!: ko_at_etcbD
+               split: option.splits)
 
-crunch tcb_sched_action, ethread_set
+crunch tcb_sched_action
   for ct_in_state[wp]: "ct_in_state P"
-
-crunch set_eobject, set_tcb_queue
-  for not_pred_tcb[wp]: "\<lambda>s. \<not> pred_tcb_at proj P t s"
   (simp: ct_in_state_def pred_tcb_at_def obj_at_def)
 
-crunch tcb_sched_action, ethread_set
-  for not_pred_tcb[wp]: "\<lambda>s. \<not> pred_tcb_at proj P t s"
-
 lemma ct_in_state_def2: "ct_in_state test s = st_tcb_at test (cur_thread s) s"
    by (simp add: ct_in_state_def)
 
@@ -1895,7 +1786,7 @@ lemma set_mcpriority_valid_sched[wp]:
 lemma set_nonmember_if_cong: "(a \<notin> set (if P then x else y)) = (if P then a \<notin> set x else a \<notin> set y)"
   by auto
 
-lemma reschedule_preserves_valid_sched: "\<lbrace> valid_sched \<rbrace> reschedule_required \<lbrace> \<lambda>rv. valid_sched \<rbrace>"
+lemma reschedule_preserves_valid_sched: "\<lbrace> valid_sched \<rbrace> reschedule_required \<lbrace> \<lambda>rv. valid_sched\<rbrace>"
   unfolding reschedule_required_def set_scheduler_action_def tcb_sched_action_def
   apply (rule hoare_pre)
   apply (wp|wpc)+
@@ -1905,12 +1796,11 @@ lemma reschedule_preserves_valid_sched: "\<lbrace> valid_sched \<rbrace> resched
   apply (rule conjI)
    defer
    apply (clarsimp simp: valid_sched_2_def ct_not_in_q_2_def valid_blocked_2_def)
-  apply (clarsimp simp only: etcb_at_def)
-  apply (case_tac "ekheap s x"; simp)
   apply (clarsimp simp: valid_sched_2_def)
   apply (rule conjI)
    apply (clarsimp simp: valid_queues_2_def valid_sched_action_2_def tcb_sched_enqueue_def
-     weak_valid_sched_action_2_def etcb_at_conj_is_etcb_at)
+                         weak_valid_sched_action_2_def etcb_at_conj_is_etcb_at
+                   dest!: ko_at_etcbD)
   apply (rule conjI)
    apply (clarsimp simp: ct_not_in_q_2_def)
   apply (clarsimp simp:  valid_blocked_2_def)
@@ -1957,40 +1847,136 @@ lemma reschedule_required_not_cur_thread[wp]:
 lemma possible_switch_to_valid_sched_except:
   "\<lbrace>valid_sched_except_blocked and valid_blocked_except target and
     st_tcb_at runnable target and not_cur_thread target and (\<lambda>s. target \<noteq> idle_thread s)\<rbrace>
-     possible_switch_to target \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   possible_switch_to target
+   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
   unfolding possible_switch_to_def
   apply (wpsimp wp: reschedule_required_valid_blocked_except
                     set_scheduler_action_swt_weak_valid_sched_except)+
   apply (clarsimp simp: etcb_at'_def not_cur_thread_2_def valid_sched_def valid_sched_action_def
                         in_cur_domain_def ct_in_cur_domain_2_def valid_blocked_def
-                        valid_blocked_except_def
-                  split: option.splits)
+                 dest!: ko_at_etcbD
+                 split: option.splits)
+  done
+
+lemma thread_set_priority_neq_st_tcb_at[wp]:
+  "\<lbrace>\<lambda>s. \<not> st_tcb_at P t s\<rbrace> thread_set_priority p t' \<lbrace>\<lambda>rv s. \<not> st_tcb_at P t s\<rbrace>"
+  unfolding thread_set_priority_def
+  by (wpsimp wp: thread_set_no_change_tcb_state_converse)
+
+lemma thread_set_priority_valid_queues_not_q:
+  "\<lbrace>valid_queues and not_queued t\<rbrace> thread_set_priority t p \<lbrace>\<lambda>_. valid_queues\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: valid_queues_def is_etcb_at'_def etcb_at'_def etcbs_of'_def
+                        not_queued_def
+                 dest!: get_tcb_SomeD)
+  by (fastforce simp: st_tcb_at_kh_def obj_at_kh_def st_tcb_at_def obj_at_def)
+
+lemma thread_set_priority_ct_not_in_q[wp]:
+  "thread_set_priority p t \<lbrace>ct_not_in_q\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  by (wpsimp wp: set_object_wp)
+
+lemma thread_set_priority_valid_sched_action[wp]:
+  "thread_set_priority p t \<lbrace>valid_sched_action\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (fastforce simp: valid_sched_action_def weak_valid_sched_action_2_def
+                         switch_in_cur_domain_def in_cur_domain_def
+                         is_activatable_def st_tcb_at_kh_def obj_at_kh_def
+                         etcb_at'_def etcbs_of'_def
+                  dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_ct_in_cur_domain[wp]:
+  "thread_set_priority p t \<lbrace>ct_in_cur_domain\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: ct_in_cur_domain_def in_cur_domain_2_def etcb_at'_def etcbs_of'_def
+                 dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_valid_idle_etcb[wp]:
+  "thread_set_priority t p \<lbrace>valid_idle_etcb\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp wp_del: valid_idle_etcb_lift)
+  apply (clarsimp simp: valid_idle_etcb_def etcbs_of'_def etcb_at'_def dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_not_cur_thread[wp]:
+  "thread_set_priority p t \<lbrace>not_cur_thread t'\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  by (wpsimp wp: set_object_wp)
+
+lemma thread_set_priority_valid_blocked_except[wp]:
+  "thread_set_priority p t \<lbrace>valid_blocked_except t'\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: valid_blocked_except_def st_tcb_at_kh_def obj_at_kh_def dest!:get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_valid_blocked[wp]:
+  "thread_set_priority p t \<lbrace>valid_blocked\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: valid_blocked_def st_tcb_at_kh_def obj_at_kh_def dest!:get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_weak_valid_sched_action[wp]:
+  "thread_set_priority t p \<lbrace>weak_valid_sched_action\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: weak_valid_sched_action_def
+                        st_tcb_at_kh_def obj_at_kh_def
+                 dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_switch_in_cur_domain[wp]:
+  "thread_set_priority t p \<lbrace>switch_in_cur_domain\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: switch_in_cur_domain_def in_cur_domain_def etcb_at'_def etcbs_of'_def
+                 dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_activatable[wp]:
+  "thread_set_priority t p \<lbrace>\<lambda>s. is_activatable (cur_thread s) s\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: is_activatable_def st_tcb_at_kh_def obj_at_kh_def dest!: get_tcb_SomeD)
   done
 
+lemma thread_set_priority_valid_sched[wp]:
+  "\<lbrace>valid_sched and not_queued t\<rbrace>thread_set_priority t p \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+  unfolding valid_sched_def valid_sched_action_def
+  by (wpsimp wp: thread_set_priority_valid_queues_not_q)
+
+crunch thread_set_priority
+  for cur_thread[wp]: "\<lambda>s. P (cur_thread s)"
+  and st_tcb_at[wp]: "\<lambda>s. st_tcb_at P t s"
+  (wp: thread_set_no_change_tcb_state)
+
 lemma set_priority_valid_sched[wp]:
   "\<lbrace>valid_sched and (\<lambda>s. tptr \<noteq> idle_thread s)\<rbrace> set_priority tptr prio \<lbrace>\<lambda>_. valid_sched\<rbrace>"
-  apply (rule hoare_pre)
-   apply (simp add: set_priority_def thread_set_priority_def)
-   apply (wp gts_wp hoare_vcg_if_lift ethread_set_not_queued_valid_queues hoare_vcg_all_lift
-             tcb_dequeue_not_queued hoare_vcg_imp_lift hoare_vcg_disj_lift
-             tcb_sched_action_enqueue_valid_blocked
-             ethread_set_not_domain_valid_sched_action
-             ethread_set_not_domain_ct_in_cur_domain
-             ethread_set_not_domain_valid_blocked_except
-             ethread_set_not_queued_valid_sched
-             tcb_sched_action_dequeue_valid_blocked_except
-             tcb_sched_action_dequeue_valid_sched_not_runnable
-             reschedule_required_valid_sched_cur_thread ethread_set_valid_idle_etcb
-             possible_switch_to_valid_sched_except
-          | simp add: ct_in_state_def2[symmetric])+
+  unfolding set_priority_def
+   apply (wpsimp wp: gts_wp hoare_vcg_if_lift hoare_vcg_all_lift hoare_vcg_imp_lift'
+                     tcb_dequeue_not_queued hoare_vcg_imp_lift hoare_vcg_disj_lift
+                     tcb_sched_action_enqueue_valid_blocked
+                     tcb_sched_action_dequeue_valid_blocked_except
+                     tcb_sched_action_dequeue_valid_sched_not_runnable
+                     reschedule_required_valid_sched_cur_thread
+                     possible_switch_to_valid_sched_except
+                     thread_set_priority_valid_queues_not_q
+               simp: ct_in_state_def2[symmetric]
+          | wps)+
   apply (auto simp: valid_sched_def valid_sched_action_def st_tcb_at_def obj_at_def not_cur_thread_def split: thread_state.splits)
-done
+  done
 
 context DetSchedSchedule_AI begin
 
 crunch
   set_mcpriority, cap_insert, cap_delete, option_update_thread
-  for simple_sched_action[wp]: simple_sched_action
+  for simple_sched_action[wp]: "simple_sched_action :: det_state \<Rightarrow> _"
 
 crunch
   option_update_thread, set_mcpriority, finalise_cap, cap_swap_for_delete
@@ -2015,12 +2001,12 @@ crunch
   for idle_thread[wp]: "\<lambda>(s:: det_state). P (idle_thread s)"
 
 crunch cap_delete
-  for valid_sched[wp]: valid_sched
+  for valid_sched[wp]: "valid_sched :: det_state \<Rightarrow> _"
 
 lemma tc_valid_sched[wp]:
   "\<lbrace>valid_sched and simple_sched_action and (\<lambda>s. a \<noteq> idle_thread s)\<rbrace>
       invoke_tcb (ThreadControl a sl b mcp pr e f g)
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply clarsimp
   apply wp
         apply wpsimp
@@ -2043,21 +2029,19 @@ lemma possible_switch_to_valid_sched:
   by (fastforce simp: etcb_at'_def not_cur_thread_2_def valid_sched_def valid_sched_action_def
                       in_cur_domain_def ct_in_cur_domain_2_def valid_blocked_def
                       valid_blocked_except_def
+                dest!: ko_at_etcbD
                 split: option.splits)
 
 lemma set_thread_state_not_cur_thread[wp]:
   "\<lbrace>not_cur_thread thread\<rbrace> set_thread_state ref ts \<lbrace>\<lambda>rv. not_cur_thread thread\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_def set_thread_state_ext_def set_object_def get_object_def |
+  apply (simp add: set_thread_state_def set_thread_state_act_def set_object_def get_object_def |
          wp gts_wp)+
   done
 
 crunch setup_reply_master
   for valid_sched[wp]: valid_sched
 
-crunch setup_reply_master
-  for valid_etcbs[wp]: valid_etcbs
-
 crunch setup_reply_master
   for valid_queues[wp]: valid_queues
 
@@ -2069,25 +2053,28 @@ crunch setup_reply_master
 
 crunch setup_reply_master
   for ct_in_cur_domain[wp]: ct_in_cur_domain
+  (wp: ct_in_cur_domain_lift)
 
 crunch setup_reply_master
   for valid_blocked[wp]: valid_blocked
 
-context DetSchedSchedule_AI begin
-
-crunch empty_slot
+crunch
+  thread_set, set_irq_state, deleted_irq_handler, set_cdt, set_bound_notification, setup_reply_master,
+  blocked_cancel_ipc, cancel_signal, cancel_all_signals, cancel_all_ipc, unbind_maybe_notification
   for not_cur_thread[wp]: "not_cur_thread thread"
   (wp: crunch_wps)
 
-crunch setup_reply_master, cancel_ipc
-  for not_cur_thread[wp]: "not_cur_thread thread"
+context DetSchedSchedule_AI begin
+
+crunch empty_slot, cancel_ipc
+  for not_cur_thread[wp]: "not_cur_thread thread :: det_state \<Rightarrow> _"
   (wp: hoare_drop_imps mapM_x_wp simp: unless_def if_fun_split)
 
 crunch setup_reply_master
   for etcb_at[wp]: "etcb_at P t"
 
 lemma restart_valid_sched[wp]:
-  "\<lbrace>valid_sched and (\<lambda>s. thread \<noteq> idle_thread s)\<rbrace> restart thread \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  "\<lbrace>valid_sched and (\<lambda>s. thread \<noteq> idle_thread s)\<rbrace> restart thread \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: restart_def | wp set_thread_state_runnable_valid_queues
                                     set_thread_state_runnable_valid_sched_action
                                     set_thread_state_valid_blocked_except
@@ -2111,18 +2098,23 @@ lemma restart_valid_sched[wp]:
 
 end
 
+lemma etcbs_of_arch_state[simp]:
+  "get_tcb ref s = Some tcb \<Longrightarrow>
+  etcbs_of' (\<lambda>r. if r = ref then Some (TCB (tcb_arch_update f tcb)) else kheap s r) = etcbs_of' (kheap s)"
+  by (auto simp: etcbs_of_update_unrelated dest!: get_tcb_SomeD)
+
 lemma as_user_valid_sched[wp]:
   "\<lbrace>valid_sched\<rbrace> as_user tptr f \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
   apply (simp add: as_user_def set_object_def get_object_def)
   apply (wp | wpc)+
   apply clarsimp
-  by (fastforce simp: valid_sched_def valid_etcbs_def valid_queues_def
+  by (fastforce simp: valid_sched_def valid_queues_def
                       valid_sched_action_def is_activatable_def
                       weak_valid_sched_action_def st_tcb_at_kh_if_split
                       st_tcb_def2 valid_blocked_def)
 
 crunch bind_notification
-  for valid_sched[wp]: "valid_sched"
+  for valid_sched[wp]: valid_sched
 
 crunch suspend
   for it[wp]: "\<lambda> s. P (idle_thread s)"
@@ -2132,7 +2124,7 @@ context DetSchedSchedule_AI begin
 lemma invoke_tcb_valid_sched[wp]:
   "\<lbrace>invs and valid_sched and simple_sched_action and tcb_inv_wf ti\<rbrace>
      invoke_tcb ti
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (cases ti, simp_all only:)
         apply (wp mapM_x_wp | simp | rule subset_refl | rule reschedule_preserves_valid_sched |
                clarsimp simp:invs_valid_objs invs_valid_global_refs idle_no_ex_cap |
@@ -2164,6 +2156,18 @@ crunch set_mrs, as_user
   for exst[wp]: "\<lambda>s. P (exst s)"
   (simp: crunch_simps wp: crunch_wps)
 
+crunch set_mrs,set_message_info
+  for scheduler_action[wp]: "\<lambda>s. P (scheduler_action s)"
+  and cur_domain[wp]: "\<lambda>s. P (cur_domain s)"
+  and ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
+  (simp: zipWithM_x_mapM wp: mapM_wp')
+
+lemma set_mrs_etcbs[wp]:
+  "set_mrs thread buf msgs \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
+  unfolding set_mrs_def store_word_offs_def
+  supply if_split [split del]
+  by (wpsimp simp: zipWithM_x_mapM wp: mapM_wp' set_object_wp)
+
 crunch set_mrs
   for valid_sched[wp]: valid_sched
   (wp: valid_sched_lift)
@@ -2180,21 +2184,11 @@ lemma reschedule_required_switch_valid_blocked:
   done
 
 lemma reschedule_required_switch_valid_sched:
-  "\<lbrace>valid_etcbs and valid_queues and weak_valid_sched_action and (\<lambda>s. case scheduler_action s of switch_thread t \<Rightarrow> valid_blocked_except t s | _ \<Rightarrow> False) and valid_idle_etcb\<rbrace>
+  "\<lbrace>valid_queues and weak_valid_sched_action and (\<lambda>s. case scheduler_action s of switch_thread t \<Rightarrow> valid_blocked_except t s | _ \<Rightarrow> False) and valid_idle_etcb\<rbrace>
     reschedule_required
    \<lbrace>\<lambda>_. valid_sched\<rbrace>"
   by (simp add: valid_sched_def | wp reschedule_required_switch_valid_blocked | force)+
 
-lemma set_scheduler_action_swt_weak_valid_sched':
-  "\<lbrace>valid_sched_except_blocked and valid_blocked_except t and st_tcb_at runnable t
-     and in_cur_domain t and simple_sched_action\<rbrace>
-     set_scheduler_action (switch_thread t)
-   \<lbrace>\<lambda>_.valid_sched\<rbrace>"
-  apply (simp add: set_scheduler_action_def)
-  apply wp
-  apply (force simp: valid_sched_def ct_not_in_q_def valid_sched_action_def weak_valid_sched_action_def in_cur_domain_def ct_in_cur_domain_def switch_in_cur_domain_def valid_blocked_def valid_blocked_except_def simple_sched_action_def split: scheduler_action.splits)
-  done
-
 lemma enqueue_thread_not_not_queued:
   "\<lbrace>\<lambda>s. t = thread \<rbrace>
      tcb_sched_action tcb_sched_enqueue thread
@@ -2205,12 +2199,6 @@ lemma enqueue_thread_not_not_queued:
                   split: option.splits)
   done
 
-crunch tcb_sched_action
-  for scheduler_action[wp]: "\<lambda>s. P (scheduler_action s)"
-
-crunch possible_switch_to
-  for valid_etcbs[wp]: "valid_etcbs"
-
 (* FIXME: Move *)
 lemma valid_blocked_except_lift:
   assumes a: "\<And>Q t. \<lbrace>\<lambda>s. st_tcb_at Q t s\<rbrace> f \<lbrace>\<lambda>rv s. st_tcb_at Q t s\<rbrace>"
@@ -2239,12 +2227,9 @@ lemma set_simple_ko_valid_sched_action[wp]:
   "\<lbrace>valid_sched_action\<rbrace> set_simple_ko f ptr ntfn \<lbrace>\<lambda>rv. valid_sched_action\<rbrace>"
   by (wp hoare_drop_imps valid_sched_action_lift | simp add: set_simple_ko_def)+
 
-crunch cap_insert_ext
-  for not_cur_thread[wp]: "not_cur_thread t"
-
 crunch cap_insert, set_extra_badge
   for not_cur_thread[wp]: "not_cur_thread t"
-  (wp: hoare_drop_imps)
+  (wp: hoare_drop_imps dxo_wp_weak)
 
 lemma transfer_caps_not_cur_thread[wp]:
   "\<lbrace>not_cur_thread t\<rbrace> transfer_caps info caps ep recv recv_buf
@@ -2257,7 +2242,7 @@ crunch as_user
   (wp: crunch_wps simp: crunch_simps ignore: const_on_failure)
 
 crunch (in DetSchedSchedule_AI) do_ipc_transfer
-  for not_cur_thread[wp]: "not_cur_thread t"
+  for not_cur_thread[wp]: "not_cur_thread t :: det_state \<Rightarrow> _"
   (wp: crunch_wps simp: crunch_simps ignore: const_on_failure)
 
 lemmas set_thread_state_active_valid_sched_except_blocked =
@@ -2271,7 +2256,7 @@ lemma set_thread_state_runnable_valid_blocked:
    apply (wp set_object_wp)
    apply (clarsimp simp: valid_blocked_def not_queued_def runnable_eq_active
                          pred_tcb_at_def st_tcb_at_kh_def obj_at_kh_def obj_at_def)
-  apply (simp add: set_thread_state_ext_def)
+  apply (simp add: set_thread_state_act_def)
   apply (rule bind_wp[OF _ gts_sp])
   apply (rule_tac S="runnable ts" in hoare_gen_asm_spec)
    apply (clarsimp simp: pred_tcb_at_def obj_at_def)
@@ -2287,7 +2272,9 @@ lemma set_thread_state_runnable_valid_sched:
 
 context DetSchedSchedule_AI begin
 lemma update_waiting_ntfn_valid_sched[wp]:
-  "\<lbrace> \<lambda>s. valid_sched s \<and> hd queue \<noteq> idle_thread s \<and> (scheduler_action s = resume_cur_thread \<longrightarrow> hd queue \<noteq> cur_thread s)\<rbrace> update_waiting_ntfn ntfnptr queue badge val \<lbrace> \<lambda>_. valid_sched \<rbrace>"
+  "\<lbrace> \<lambda>s. valid_sched s \<and> hd queue \<noteq> idle_thread s \<and> (scheduler_action s = resume_cur_thread \<longrightarrow> hd queue \<noteq> cur_thread s)\<rbrace>
+   update_waiting_ntfn ntfnptr queue badge val
+   \<lbrace> \<lambda>_. valid_sched \<rbrace>"
   apply (simp add: update_waiting_ntfn_def)
   apply (wp sts_st_tcb_at' possible_switch_to_valid_sched_except
             set_thread_state_runnable_valid_sched
@@ -2303,42 +2290,28 @@ end
 crunch dec_domain_time
   for valid_sched[wp]: valid_sched
 
-lemma thread_set_time_slice_valid_queues[wp]:
-  "ethread_set (tcb_time_slice_update f) tptr \<lbrace>valid_queues\<rbrace>"
-  apply (unfold thread_set_time_slice_def ethread_set_def set_eobject_def)
-  apply wpsimp
-  apply (fastforce simp: get_etcb_def valid_queues_def is_etcb_at'_def etcb_at'_def)
-  done
+lemma thread_set_valid_blocked_except:
+  "(\<And>x. tcb_state (f x) = tcb_state x) \<Longrightarrow>
+   thread_set f tptr \<lbrace>valid_blocked_except t\<rbrace>"
+  by (wpsimp wp: hoare_drop_imps valid_blocked_except_lift thread_set_no_change_tcb_state)
+
+lemma etcbs_of_update_tcb_time_slice[simp]:
+  "get_tcb ref s = Some tcb \<Longrightarrow>
+   etcbs_of' (\<lambda>r. if r = ref then Some (TCB (tcb_time_slice_update f tcb)) else kheap s r) = etcbs_of' (kheap s)"
+  by (auto simp: etcbs_of_update_unrelated dest!: get_tcb_SomeD)
 
 lemma timer_tick_valid_sched[wp]:
   "\<lbrace>valid_sched\<rbrace> timer_tick \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
-  apply (simp add: timer_tick_def crunch_simps thread_set_time_slice_def
-                   trans_state_update'[symmetric] ethread_set_def set_eobject_def
-           | wp gts_wp reschedule_required_valid_sched tcb_sched_action_append_valid_blocked
-           | wpc | rule hoare_strengthen_post, rule dec_domain_time_valid_sched,
-                                      simp add: valid_sched_def valid_sched_action_def)+
-  by (fastforce simp: valid_sched_def valid_etcbs_def valid_queues_def pred_tcb_weakenE
-         valid_sched_action_def weak_valid_sched_action_def etcb_at_def is_etcb_at_def
-         get_etcb_def in_cur_domain_def ct_in_cur_domain_2_def switch_in_cur_domain_def
-         valid_idle_etcb_2_def
-         split: option.splits)
-
-lemma cancel_badged_sends_filterM_valid_etcbs[wp]:
-   "\<lbrace>valid_etcbs\<rbrace>
-      filterM (\<lambda>t. do st \<leftarrow> get_thread_state t;
-                      if blocking_ipc_badge st = badge
-                      then do y \<leftarrow> set_thread_state t Structures_A.thread_state.Restart;
-                              y \<leftarrow> (tcb_sched_action tcb_sched_enqueue t);
-                              return False
-                      od
-                      else return True
-                   od) xs
-   \<lbrace>\<lambda>rv. valid_etcbs\<rbrace>"
-  apply (rule rev_induct[where xs=xs])
-   apply simp
-  apply (clarsimp simp: filterM_append)
-  apply (wp sts_st_tcb_at' | simp)+
-  done
+  unfolding timer_tick_def thread_set_time_slice_def
+  apply (simp
+         | wp gts_wp reschedule_required_valid_sched tcb_sched_action_append_valid_blocked
+              thread_get_wp thread_set_not_state_valid_sched thread_set_valid_queues
+              thread_set_no_change_tcb_state thread_set_weak_valid_sched_action
+              thread_set_valid_blocked_except thread_set_etcbs
+         | wpc
+         | rule hoare_strengthen_post, rule dec_domain_time_valid_sched,
+           simp add: valid_sched_def valid_sched_action_def)+
+  by (fastforce simp: valid_sched_def valid_queues_def valid_sched_action_def obj_at_def pred_tcb_at_def)
 
 lemma cancel_badged_sends_filterM_valid_queues[wp]:
    "\<lbrace>valid_queues\<rbrace>
@@ -2438,41 +2411,44 @@ lemma cancel_badged_sends_valid_sched[wp]:
 context DetSchedSchedule_AI begin
 
 lemma cap_revoke_valid_sched[wp]:
-  "\<lbrace>valid_sched and simple_sched_action\<rbrace> cap_revoke slot \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  "\<lbrace>valid_sched and simple_sched_action\<rbrace> cap_revoke slot \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (rule hoare_strengthen_post)
    apply (rule validE_valid, rule cap_revoke_preservation)
     apply (wpsimp wp: preemption_point_inv')+
   done
 
 lemma cap_revoke_simple_sched_action[wp]:
-  "\<lbrace>simple_sched_action\<rbrace> cap_revoke slot \<lbrace>\<lambda>rv. simple_sched_action\<rbrace>"
+  "\<lbrace>simple_sched_action\<rbrace> cap_revoke slot \<lbrace>\<lambda>rv. simple_sched_action :: det_state \<Rightarrow> _\<rbrace>"
   by (wp cap_revoke_preservation preemption_point_inv' | fastforce)+
 
 end
 
 lemma thread_set_state_eq_valid_queues:
-  "(\<And>x. tcb_state (f x) = ts) \<Longrightarrow>
+  "\<lbrakk>\<And>x. tcb_state (f x) = ts; \<And>x. etcb_of (f x) = etcb_of x\<rbrakk> \<Longrightarrow>
    \<lbrace>valid_queues and st_tcb_at ((=) ts) tptr\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. valid_queues\<rbrace>"
   apply (simp add: thread_set_def set_object_def get_object_def)
-  apply wp
-  apply (fastforce simp: valid_queues_def st_tcb_at_kh_if_split st_tcb_def2)
+  apply wpsimp
+  apply (clarsimp simp: valid_queues_def etcbs_of_update_unrelated dest!: get_tcb_SomeD)
+  apply (fastforce simp: st_tcb_at_kh_if_split st_tcb_def2)
   done
 
 lemma thread_set_state_eq_valid_sched_action:
-  "(\<And>x. tcb_state (f x) = ts) \<Longrightarrow>
+  "\<lbrakk>\<And>x. tcb_state (f x) = ts; \<And>x. etcb_of (f x) = etcb_of x\<rbrakk> \<Longrightarrow>
    \<lbrace>valid_sched_action and st_tcb_at ((=) ts) tptr\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. valid_sched_action\<rbrace>"
   apply (simp add: thread_set_def set_object_def get_object_def)
-  apply wp
-  apply (fastforce simp: valid_sched_action_def weak_valid_sched_action_def
-                         is_activatable_def st_tcb_at_kh_if_split st_tcb_def2)
+  apply wpsimp
+  apply (clarsimp simp: valid_sched_action_def weak_valid_sched_action_def is_activatable_def
+                        etcbs_of_update_unrelated
+                 dest!: get_tcb_SomeD)
+  apply (fastforce simp: st_tcb_at_kh_if_split st_tcb_def2 dest!: get_tcb_SomeD)
   done
 
 lemma thread_set_state_eq_ct_in_cur_domain:
-  "(\<And>x. tcb_state (f x) = ts) \<Longrightarrow>
+  "\<lbrakk>\<And>x. tcb_state (f x) = ts; \<And>x. etcb_of (f x) = etcb_of x\<rbrakk> \<Longrightarrow>
    \<lbrace>ct_in_cur_domain and st_tcb_at ((=) ts) tptr\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. ct_in_cur_domain\<rbrace>"
   apply (simp add: thread_set_def set_object_def get_object_def)
-  apply wp
-  apply (fastforce simp: ct_in_cur_domain_def st_tcb_at_kh_if_split st_tcb_def2)
+  apply wpsimp
+  apply (clarsimp simp: etcbs_of_update_unrelated dest!: get_tcb_SomeD)
   done
 
 lemma thread_set_state_eq_valid_blocked:
@@ -2483,58 +2459,20 @@ lemma thread_set_state_eq_valid_blocked:
   apply (fastforce simp: valid_blocked_def st_tcb_at_kh_if_split st_tcb_def2)
   done
 
-crunch thread_set
-  for etcb_at[wp]: "etcb_at P t"
-
 context DetSchedSchedule_AI begin
 lemma thread_set_state_eq_valid_sched:
-  "(\<And>x. tcb_state (f x) = ts) \<Longrightarrow>
+  "\<lbrakk>\<And>x. tcb_state (f x) = ts; \<And>x. etcb_of (f x) = etcb_of x\<rbrakk> \<Longrightarrow>
    \<lbrace>valid_sched and st_tcb_at ((=) ts) tptr\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
   apply (simp add: valid_sched_def)
-  apply (wp thread_set_state_eq_valid_queues thread_set_state_eq_valid_blocked thread_set_state_eq_valid_sched_action thread_set_state_eq_ct_in_cur_domain | simp)+
+  apply (wp thread_set_state_eq_valid_queues thread_set_state_eq_valid_blocked
+            thread_set_state_eq_valid_sched_action thread_set_state_eq_ct_in_cur_domain
+            thread_set_etcbs | simp)+
   done
 end
 
 crunch thread_set
   for exst[wp]: "\<lambda>s. P (exst s)"
 
-lemma ethread_set_not_switch_switch_in_cur_domain:
-  "\<lbrace>switch_in_cur_domain and (\<lambda>s. scheduler_action s \<noteq> switch_thread tptr)\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. switch_in_cur_domain\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def | wp)+
-  apply (clarsimp simp: switch_in_cur_domain_def in_cur_domain_def is_etcb_at_def etcb_at_def get_etcb_def)
-  done
-
-lemma ethread_set_not_cur_ct_in_cur_domain:
-  "\<lbrace>ct_in_cur_domain and not_cur_thread tptr\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
-  apply (simp add: ethread_set_def set_eobject_def | wp)+
-  apply (clarsimp simp: ct_in_cur_domain_def in_cur_domain_def not_cur_thread_def etcb_at_def get_etcb_def)
-  done
-
-lemma ethread_set_valid_blocked:
-  "\<lbrace>valid_blocked\<rbrace> ethread_set f tptr \<lbrace>\<lambda>_. valid_blocked\<rbrace>"
-  by (wp valid_blocked_lift | simp add: ethread_set_def set_eobject_def)+
-
-lemma ethread_set_inactive_valid_idle_etcb:
-  notes valid_idle_etcb_lift[wp del]
-  shows
-  "\<lbrace>valid_idle_etcb and valid_idle and st_tcb_at inactive tptr\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_idle_etcb\<rbrace>"
-  apply(simp add: ethread_set_def set_eobject_def)
-  apply wp
-  apply(clarsimp simp: get_etcb_def valid_idle_etcb_def etcb_at'_def valid_idle_def pred_tcb_at_def obj_at_def)
-  done
-
-lemma ethread_set_inactive_valid_sched:
-  "\<lbrace>valid_sched and valid_idle and st_tcb_at inactive tptr\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_sched\<rbrace>"
-  apply (simp add: valid_sched_def valid_sched_action_def | wp ethread_set_not_queued_valid_queues ethread_set_not_switch_switch_in_cur_domain ethread_set_not_cur_ct_in_cur_domain ethread_set_valid_blocked ethread_set_inactive_valid_idle_etcb)+
-        apply (force simp: valid_idle_def st_tcb_at_def obj_at_def not_cur_thread_def
-                           is_activatable_def weak_valid_sched_action_def valid_queues_def
-                           not_queued_def)+
-  done
-
 lemma thread_set_not_idle_valid_idle:
   "\<lbrace>valid_idle and (\<lambda>s. tptr \<noteq> idle_thread s)\<rbrace>
      thread_set f tptr \<lbrace>\<lambda>_. valid_idle\<rbrace>"
@@ -2551,10 +2489,11 @@ lemma thread_set_st_tcb_at:
 
 crunch cap_move
   for valid_sched[wp]: valid_sched
+  (wp: dxo_wp_weak)
 
 context DetSchedSchedule_AI begin
 lemma invoke_cnode_valid_sched:
-  "\<lbrace>valid_sched and invs and valid_cnode_inv a and simple_sched_action\<rbrace> invoke_cnode a \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  "\<lbrace>valid_sched and invs and valid_cnode_inv a and simple_sched_action\<rbrace> invoke_cnode a \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: invoke_cnode_def)
   apply (rule hoare_pre)
    apply wpc
@@ -2574,7 +2513,7 @@ lemma transfer_caps_valid_sched:
 context DetSchedSchedule_AI begin
 
 crunch do_ipc_transfer, handle_fault_reply
-  for valid_sched[wp]: valid_sched
+  for valid_sched[wp]: "valid_sched :: det_state \<Rightarrow> _"
   (wp: crunch_wps)
 
 lemma thread_set_ct_active_wp:
@@ -2585,7 +2524,7 @@ lemma do_reply_transfer_valid_sched[wp]:
   "\<lbrace>valid_sched and valid_objs and ct_active and cte_wp_at (is_reply_cap_to t') slot
        and (\<lambda>s. receiver \<noteq> idle_thread s)\<rbrace>
      do_reply_transfer sender receiver slot grant
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: do_reply_transfer_def)
   apply (wp set_thread_state_not_runnable_valid_sched sts_st_tcb_at'
             cap_delete_one_reply_st_tcb_at do_ipc_transfer_non_null_cte_wp_at2
@@ -2629,7 +2568,7 @@ lemma set_thread_state_not_queued_valid_queues:
       set_thread_state thread ts
    \<lbrace>\<lambda>rv. valid_queues\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (wp | simp add: set_thread_state_ext_def set_object_def get_object_def)+
+  apply (wp | simp add: set_thread_state_act_def set_object_def get_object_def)+
   apply (fastforce simp: valid_queues_def st_tcb_at_kh_if_split not_queued_def)
   done
 
@@ -2649,11 +2588,11 @@ lemma set_thread_state_sched_act_not_valid_sched_action:
    \<lbrace>\<lambda>rv. valid_sched_action\<rbrace>"
   apply (simp add: valid_sched_action_def set_thread_state_def)
   apply (rule hoare_conjI)
-   apply (wp gts_wp | simp add: set_thread_state_ext_def set_object_def get_object_def)+
+   apply (wp gts_wp | simp add: set_thread_state_act_def set_object_def get_object_def)+
    apply (clarsimp simp: weak_valid_sched_action_def st_tcb_at_kh_if_split
                          scheduler_act_not_def is_activatable_def pred_tcb_at_def
                          obj_at_def)
-  apply (wp gts_wp | simp add: set_thread_state_ext_def set_object_def get_object_def)+
+  apply (wp gts_wp | simp add: set_thread_state_act_def set_object_def get_object_def)+
   apply (clarsimp simp: weak_valid_sched_action_def st_tcb_at_kh_if_split
                         scheduler_act_not_def is_activatable_def)
   done
@@ -2700,31 +2639,33 @@ lemma possible_switch_to_not_queued[wp]:
                    split: option.splits)
 
 lemma set_thread_state_ready_queues[wp]:
-  "\<lbrace>\<lambda>s :: det_state. P (ready_queues s)\<rbrace>
+  "\<lbrace>\<lambda>s. P (ready_queues s)\<rbrace>
     set_thread_state thread ts
    \<lbrace>\<lambda>r s. P (ready_queues s)\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (simp add: set_thread_state_ext_def[abs_def] reschedule_required_def
+  apply (simp add: set_thread_state_act_def[abs_def] reschedule_required_def
                    set_scheduler_action_def set_object_def get_object_def)
   apply (wp | wpc | simp add: tcb_sched_action_def)+
   done
 
-crunch set_extra_badge,cap_insert
-  for scheduler_act[wp]: "\<lambda>s :: det_state. P (scheduler_action s)" (wp: crunch_wps)
+crunch set_extra_badge
+  for scheduler_act[wp]: "\<lambda>s. P (scheduler_action s)"
+  (wp: crunch_wps)
+
+crunch set_simple_ko, set_extra_badge, setup_caller_cap
+  for ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
+  (wp: crunch_wps)
 
 context DetSchedSchedule_AI begin
 
 crunch do_ipc_transfer
   for scheduler_act[wp]: "\<lambda>s :: det_state. P (scheduler_action s)"
-  (wp: crunch_wps ignore: const_on_failure rule: transfer_caps_loop_pres)
-
-crunch cap_insert,set_extra_badge,do_ipc_transfer, set_simple_ko, thread_set, setup_caller_cap
-  for ready_queues[wp]: "\<lambda>s :: det_state. P (ready_queues s)"
+  and ready_queues[wp]: "\<lambda>s :: det_state. P (ready_queues s)"
   (wp: crunch_wps ignore: const_on_failure rule: transfer_caps_loop_pres)
 
 end
 
-crunch set_thread_state_ext
+crunch set_thread_state_act
   for sched_act_not[wp]: "scheduler_act_not t"
   (ignore: set_scheduler_action
    simp: set_scheduler_action_def if_fun_split scheduler_act_not_def
@@ -2738,7 +2679,7 @@ context DetSchedSchedule_AI begin
 lemma send_ipc_valid_sched:
   "\<lbrace>valid_sched and st_tcb_at active thread and scheduler_act_not thread and not_queued thread
       and (ct_active or ct_idle) and invs\<rbrace>
-   send_ipc block call badge can_grant can_grant_reply thread epptr \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   send_ipc block call badge can_grant can_grant_reply thread epptr \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: send_ipc_def)
   apply (wp set_thread_state_sched_act_not_valid_sched | wpc)+
             apply ((wp set_thread_state_sched_act_not_valid_sched
@@ -2792,7 +2733,7 @@ lemma send_fault_ipc_valid_sched[wp]:
   "\<lbrace>valid_sched and st_tcb_at active tptr and scheduler_act_not tptr and
        not_queued tptr and (ct_active or ct_idle) and invs and (\<lambda>_. valid_fault fault)\<rbrace>
      send_fault_ipc tptr fault
-   \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: send_fault_ipc_def Let_def)
   apply (wp send_ipc_valid_sched thread_set_not_state_valid_sched thread_set_no_change_tcb_state
             hoare_gen_asm'[OF thread_set_tcb_fault_set_invs]  hoare_drop_imps hoare_vcg_all_liftE_R
@@ -2802,7 +2743,7 @@ lemma send_fault_ipc_valid_sched[wp]:
   done
 
 crunch delete_caller_cap
-  for valid_sched[wp]: valid_sched
+  for valid_sched[wp]: "valid_sched :: det_state \<Rightarrow> _"
 
 end
 
@@ -2811,7 +2752,7 @@ lemma handle_double_fault_valid_queues:
      handle_double_fault tptr ex1 ex2
    \<lbrace>\<lambda>rv. valid_queues\<rbrace>"
   apply (simp add: handle_double_fault_def set_thread_state_def)
-  apply (wp | simp add: set_thread_state_ext_def set_object_def get_object_def)+
+  apply (wp | simp add: set_thread_state_act_def set_object_def get_object_def)+
   apply (fastforce simp: valid_queues_def st_tcb_at_kh_if_split not_queued_def)
   done
 
@@ -2820,7 +2761,7 @@ lemma handle_double_fault_valid_sched_action:
      handle_double_fault tptr ex1 ex2
    \<lbrace>\<lambda>rv. valid_sched_action\<rbrace>"
   apply (simp add: handle_double_fault_def set_thread_state_def)
-  apply (wp gts_wp | simp add: set_thread_state_ext_def set_object_def get_object_def)+
+  apply (wp gts_wp | simp add: set_thread_state_act_def set_object_def get_object_def)+
   apply (clarsimp simp: valid_sched_action_def weak_valid_sched_action_def
                         is_activatable_def pred_tcb_at_def obj_at_def
                         st_tcb_at_kh_if_split scheduler_act_not_def
@@ -2858,7 +2799,7 @@ context DetSchedSchedule_AI begin
 lemma handle_fault_valid_sched:
   "\<lbrace>valid_sched and st_tcb_at active thread and not_queued thread and (ct_active or ct_idle)
       and scheduler_act_not thread and invs and (\<lambda>_. valid_fault ex)\<rbrace>
-   handle_fault thread ex \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   handle_fault thread ex \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   unfolding handle_fault_def
   by (simp add: handle_fault_def |
       wp handle_double_fault_valid_sched send_fault_ipc_valid_sched)+
@@ -2872,7 +2813,7 @@ lemma idle_not_queued'':
 context DetSchedSchedule_AI begin
 
 lemma send_signal_valid_sched[wp]:
-  "\<lbrace> valid_sched and invs \<rbrace> send_signal ntfnptr badge \<lbrace> \<lambda>_. valid_sched \<rbrace>"
+  "\<lbrace> valid_sched and invs \<rbrace> send_signal ntfnptr badge \<lbrace> \<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: send_signal_def)
   apply (wp get_simple_ko_wp possible_switch_to_valid_sched_except
             set_thread_state_runnable_valid_queues set_thread_state_runnable_valid_sched_action
@@ -2916,7 +2857,7 @@ lemma receive_ipc_valid_sched:
   "\<lbrace>valid_sched and st_tcb_at active thread and ct_active
           and not_queued thread and scheduler_act_not thread and invs\<rbrace>
    receive_ipc thread cap is_blocking
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   supply option.case_cong_weak[cong]
   apply (simp add: receive_ipc_def)
   apply (wp | wpc | simp)+
@@ -2979,7 +2920,7 @@ crunch delete_caller_cap
 context DetSchedSchedule_AI begin
 
 crunch delete_caller_cap
-  for sched_act_not[wp]: "scheduler_act_not t"
+  for sched_act_not[wp]: "scheduler_act_not t :: det_state \<Rightarrow> _"
   (simp: unless_def
    wp: hoare_drop_imps set_scheduler_action_wp mapM_x_wp
    ignore: set_scheduler_action)
@@ -3011,7 +2952,7 @@ lemma cancel_all_ipc_not_queued:
   "\<lbrace>st_tcb_at active t and valid_objs and not_queued t and scheduler_act_not t
         and sym_refs \<circ> state_refs_of\<rbrace>
      cancel_all_ipc epptr
-   \<lbrace>\<lambda>rv. not_queued t\<rbrace>"
+   \<lbrace>\<lambda>rv. not_queued t :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: cancel_all_ipc_def)
   apply (wp reschedule_required_not_queued | wpc | simp)+
       apply (rule hoare_gen_asm)
@@ -3114,14 +3055,14 @@ lemma fast_finalise_not_queued:
   "\<lbrace>not_queued t and (st_tcb_at active t and valid_objs and scheduler_act_not t and
     sym_refs \<circ> state_refs_of)\<rbrace>
    fast_finalise cap final
-   \<lbrace>\<lambda>_. not_queued t\<rbrace>"
+   \<lbrace>\<lambda>_. not_queued t :: det_state \<Rightarrow> _\<rbrace>"
   apply (cases cap, simp_all)
      apply (wp cancel_all_ipc_not_queued cancel_all_signals_not_queued
             get_simple_ko_wp unbind_maybe_notification_valid_objs | simp)+
   done
 
 crunch delete_caller_cap
-  for not_queued: "not_queued t"
+  for not_queued: "not_queued t :: det_state \<Rightarrow> _"
   (wp: fast_finalise_not_queued hoare_drop_imps simp: if_fun_split unless_def)
 
 end
@@ -3133,38 +3074,9 @@ lemma set_simple_ko_ct_active:
                   split: kernel_object.splits)
   done
 
-context DetSchedSchedule_AI begin
-
-crunch setup_reply_master, cancel_ipc
-  for is_etcb_at[wp]: "is_etcb_at t"
-  (wp: hoare_drop_imps crunch_wps select_inv simp: crunch_simps unless_def)
-
-end
-
 crunch setup_reply_master
   for weak_valid_sched_action[wp]: "weak_valid_sched_action"
 
-crunch set_thread_state_ext, tcb_sched_action,
-                           reschedule_required, empty_slot_ext
-  for is_etcb_at_ext[wp]: "is_etcb_at t"
-
-crunch set_thread_state
-  for is_etcb_at[wp]: "is_etcb_at t"
-  (wp: hoare_drop_imps crunch_wps select_inv simp: crunch_simps unless_def)
-
-lemma set_eobject_is_etcb_at_ext[wp]:
-  "\<lbrace>is_etcb_at t\<rbrace> set_eobject ptr etcb \<lbrace>\<lambda>_. is_etcb_at t\<rbrace>"
-  apply (simp add: set_eobject_def | wp)+
-  apply (simp add: is_etcb_at_def split: if_split_asm)
-  done
-
-crunch ethread_set
-  for is_etcb_at_ext[wp]: "is_etcb_at t"
-
-crunch set_mrs
-  for valid_etcbs[wp]: valid_etcbs
-  (wp: valid_etcbs_lift)
-
 lemma cap_insert_check_cap_ext_valid[wp]:"
   \<lbrace>valid_list\<rbrace>
    check_cap_at new_cap src_slot (check_cap_at t slot (cap_insert new_cap src_slot x))
@@ -3174,7 +3086,7 @@ lemma cap_insert_check_cap_ext_valid[wp]:"
   done
 
 lemma opt_update_thread_valid_sched[wp]:
-  "(\<And>x a. tcb_state (fn a x) = tcb_state x) \<Longrightarrow>
+  "\<lbrakk>\<And>x a. tcb_state (fn a x) = tcb_state x; \<And>x a. etcb_of (fn a x) = etcb_of x\<rbrakk> \<Longrightarrow>
     \<lbrace>valid_sched\<rbrace> option_update_thread t fn v \<lbrace>\<lambda>_. valid_sched\<rbrace>"
   apply (rule hoare_pre)
    apply (simp add: option_update_thread_def)
@@ -3193,17 +3105,12 @@ lemma opt_update_thread_simple_sched_action[wp]:
 crunch delete_caller_cap
   for ct_active[wp]: ct_active (wp: ct_in_state_thread_state_lift)
 
-lemma test:
-"invs s \<longrightarrow> (\<exists>y. get_tcb thread s = Some y) \<longrightarrow> s \<turnstile> tcb_ctable (the (get_tcb thread s))"
-apply (simp add: invs_valid_tcb_ctable_strengthen)
-done
-
 context DetSchedSchedule_AI begin
 
 lemma handle_recv_valid_sched:
   "\<lbrace>valid_sched and invs and ct_active
       and ct_not_queued and scheduler_act_sane\<rbrace>
-   handle_recv is_blocking \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   handle_recv is_blocking \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: handle_recv_def Let_def ep_ntfn_cap_case_helper
               cong: if_cong)
   apply (wp get_simple_ko_wp handle_fault_valid_sched delete_caller_cap_not_queued
@@ -3220,7 +3127,7 @@ lemma handle_recv_valid_sched:
 lemma handle_recv_valid_sched':
   "\<lbrace>invs and valid_sched and ct_active and ct_not_queued and scheduler_act_sane\<rbrace>
     handle_recv is_blocking
-   \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (wp handle_recv_valid_sched)
   apply (simp add: invs_def valid_state_def valid_pspace_def)
   done
@@ -3254,7 +3161,7 @@ lemma set_thread_state_Restart_valid_sched:
 
 context DetSchedSchedule_AI begin
 crunch invoke_irq_control, invoke_irq_handler
-  for valid_sched[wp]: "valid_sched"
+  for valid_sched[wp]: "valid_sched :: det_state \<Rightarrow> _"
 end
 
 lemma simple_sched_action_sched_act_not[simp]:
@@ -3263,51 +3170,101 @@ lemma simple_sched_action_sched_act_not[simp]:
 
 declare valid_idle_etcb_lift[wp del]
 
-lemma ethread_set_not_activatable_valid_idle_etcb:
-  "\<lbrace>valid_idle_etcb and valid_idle and st_tcb_at (\<lambda>ts. \<not> activatable ts) tptr\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_idle_etcb\<rbrace>"
-  apply(simp add: ethread_set_def set_eobject_def)
-  apply wp
-  apply(clarsimp simp: get_etcb_def valid_idle_etcb_def etcb_at'_def valid_idle_def pred_tcb_at_def obj_at_def)
-  done
+crunch thread_set_domain
+  for ct[wp]: "\<lambda>s. P (cur_thread s)"
+  and sched[wp]: "\<lambda>s. P (scheduler_action s)"
+  and ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
 
-
-lemma ethread_set_not_activatable_valid_sched:
-  "\<lbrace>valid_sched and valid_idle and st_tcb_at (\<lambda>ts. \<not> activatable ts) tptr\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_sched\<rbrace>"
-  apply (simp add: valid_sched_def valid_sched_action_def | wp ethread_set_not_queued_valid_queues ethread_set_not_switch_switch_in_cur_domain ethread_set_not_cur_ct_in_cur_domain ethread_set_valid_blocked ethread_set_not_activatable_valid_idle_etcb)+
-        apply (force simp: valid_idle_def st_tcb_at_def obj_at_def not_cur_thread_def
-                           is_activatable_def weak_valid_sched_action_def valid_queues_def
-                           not_queued_def split: thread_state.splits)+
+lemma thread_set_domain_st_tcb[wp]:
+  "thread_set_domain t d \<lbrace>\<lambda>s. P (st_tcb_at Q p s)\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: st_tcb_at_def obj_at_def dest!: get_tcb_SomeD)
   done
 
-lemma ethread_set_not_idle_valid_idle_etcb:
+lemma thread_set_domain_not_idle_valid_idle_etcb:
   "\<lbrace>valid_idle_etcb and valid_idle and (\<lambda>s. tptr \<noteq> idle_thread s)\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_idle_etcb\<rbrace>"
-  apply(simp add: ethread_set_def set_eobject_def)
-  apply wp
-  apply(clarsimp simp: get_etcb_def valid_idle_etcb_def etcb_at'_def valid_idle_def st_tcb_at_def obj_at_def)
+   thread_set_domain tptr d
+   \<lbrace>\<lambda>_. valid_idle_etcb\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: valid_idle_etcb_def etcb_at'_def etcbs_of'_def valid_idle_def
+                        pred_tcb_at_def obj_at_def)
   done
 
-lemma ethread_set_not_idle_valid_sched:
-  "\<lbrace>valid_sched and simple_sched_action and not_queued tptr and (\<lambda>s. tptr \<noteq> cur_thread s) and (\<lambda>s. tptr \<noteq> idle_thread s) and valid_idle\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_sched\<rbrace>"
-  apply (simp add: valid_sched_def valid_sched_action_def | wp ethread_set_not_queued_valid_queues ethread_set_not_switch_switch_in_cur_domain ethread_set_not_cur_ct_in_cur_domain ethread_set_valid_blocked ethread_set_not_idle_valid_idle_etcb)+
-        apply (force simp: simple_sched_action_def st_tcb_at_def obj_at_def not_cur_thread_def
-                           is_activatable_def weak_valid_sched_action_def valid_queues_def
-                           not_queued_def split: thread_state.splits)+
+lemma thread_set_domain_cur_activatable[wp]:
+  "thread_set_domain tptr d \<lbrace>\<lambda>s. is_activatable (cur_thread s) s\<rbrace>"
+  unfolding is_activatable_def
+  by (rule hoare_lift_Pf[where f=cur_thread]; wpsimp wp: hoare_vcg_imp_lift)
+
+lemma thread_set_domain_weak_valid_sched_action[wp]:
+  "thread_set_domain tptr d \<lbrace>weak_valid_sched_action\<rbrace>"
+  unfolding weak_valid_sched_action_def
+  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift)
+
+lemma thread_set_domain_not_switch_switch_in_cur_domain:
+  "\<lbrace>switch_in_cur_domain and (\<lambda>s. scheduler_action s \<noteq> switch_thread tptr)\<rbrace>
+   thread_set_domain tptr d
+   \<lbrace>\<lambda>_. switch_in_cur_domain\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: switch_in_cur_domain_def in_cur_domain_def is_etcb_at_def etcb_at_def etcbs_of'_def
+                 dest!:get_tcb_SomeD)
   done
 
-lemma ethread_set_ssa_valid_sched_action:
+lemma thread_set_domain_ssa_valid_sched_action:
   "\<lbrace>valid_sched_action and simple_sched_action\<rbrace>
-     ethread_set f tptr \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
-  apply (simp add: valid_sched_action_def | wp ethread_set_not_switch_switch_in_cur_domain)+
-    apply (force simp: simple_sched_action_def)+
-    done
+   thread_set_domain tptr d
+   \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
+  unfolding valid_sched_action_def
+  apply (wpsimp wp: thread_set_domain_not_switch_switch_in_cur_domain)
+  apply (force simp: simple_sched_action_def)
+  done
+
+lemma thread_set_domain_valid_blocked[wp]:
+  "thread_set_domain tptr d \<lbrace>valid_blocked\<rbrace>"
+  by (wpsimp wp: valid_blocked_lift)
+
+lemma thread_set_domain_valid_blocked_except[wp]:
+  "thread_set_domain tptr d \<lbrace>valid_blocked_except t\<rbrace>"
+  by (wpsimp wp: valid_blocked_except_lift)
+
+lemma thread_set_domain_ct_in_cur_domain:
+  "\<lbrace>ct_in_cur_domain and not_cur_thread t\<rbrace> thread_set_domain t d \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: ct_in_cur_domain_def in_cur_domain_2_def etcb_at'_def etcbs_of'_def
+                        not_cur_thread_def)
+  done
+
+lemma thread_set_domain_not_cur_thread[wp]:
+  "thread_set_domain t d \<lbrace>not_cur_thread t\<rbrace>"
+  unfolding not_cur_thread_def by (wpsimp wp: hoare_vcg_imp_lift)
+
+lemma thread_set_domain_valid_queues_not_q:
+  "\<lbrace>valid_queues and not_queued t\<rbrace> thread_set_domain t d \<lbrace>\<lambda>_. valid_queues\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  apply (wpsimp wp: set_object_wp)
+  apply (clarsimp simp: valid_queues_def is_etcb_at'_def etcb_at'_def etcbs_of'_def
+                        not_queued_def
+                 dest!: get_tcb_SomeD)
+  by (fastforce simp: st_tcb_at_kh_def obj_at_kh_def st_tcb_at_def obj_at_def)
+
+lemma thread_set_domain_ct_not_in_q[wp]:
+  "thread_set_domain p d \<lbrace>ct_not_in_q\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  by (wpsimp wp: set_object_wp)
 
-lemma ethread_set_valid_blocked_except:
-  "\<lbrace>valid_blocked_except t\<rbrace> ethread_set f tptr \<lbrace>\<lambda>_. valid_blocked_except t\<rbrace>"
-  by (wp valid_blocked_except_lift | simp add: ethread_set_def set_eobject_def)+
+lemma thread_set_domain_not_idle_valid_sched:
+  "\<lbrace>valid_sched and simple_sched_action and not_queued tptr and (\<lambda>s. tptr \<noteq> cur_thread s) and (\<lambda>s. tptr \<noteq> idle_thread s) and valid_idle\<rbrace>
+   thread_set_domain tptr d
+   \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+  unfolding valid_sched_def valid_sched_action_def
+  apply (wpsimp wp: thread_set_domain_valid_queues_not_q thread_set_domain_ct_in_cur_domain
+                    thread_set_domain_not_switch_switch_in_cur_domain
+                    thread_set_domain_not_idle_valid_idle_etcb)
+  apply (clarsimp simp: simple_sched_action_def not_cur_thread_def)
+  done
 
 declare tcb_sched_action_valid_idle_etcb[wp]
 
@@ -3317,14 +3274,15 @@ lemma invoke_domain_valid_sched[wp]:
     invoke_domain t d \<lbrace>\<lambda>_. valid_sched\<rbrace>"
   apply (simp add: invoke_domain_def)
   apply wp
-   apply (simp add: set_domain_def thread_set_domain_def)
+   apply (simp add: set_domain_def)
    apply (wp gts_st_tcb_at hoare_vcg_if_lift hoare_vcg_if_lift2 hoare_vcg_imp_lift
-             hoare_vcg_disj_lift ethread_set_not_queued_valid_queues reschedule_required_valid_sched
-             tcb_sched_action_enqueue_valid_blocked ethread_set_valid_blocked_except
-             ethread_set_valid_blocked ethread_set_ssa_valid_sched_action
-             ethread_set_not_cur_ct_in_cur_domain ethread_set_not_idle_valid_sched
-             ethread_set_not_idle_valid_idle_etcb)
-      apply (wp hoare_weak_lift_imp hoare_weak_lift_imp_conj tcb_dequeue_not_queued tcb_sched_action_dequeue_valid_blocked_except)
+             hoare_vcg_disj_lift reschedule_required_valid_sched
+             tcb_sched_action_enqueue_valid_blocked
+             thread_set_domain_valid_queues_not_q
+             thread_set_domain_ssa_valid_sched_action
+             thread_set_domain_ct_in_cur_domain thread_set_domain_not_idle_valid_sched
+             thread_set_domain_not_idle_valid_idle_etcb)
+      apply (wp tcb_dequeue_not_queued tcb_sched_action_dequeue_valid_blocked_except)
      apply simp
      apply (wp hoare_vcg_disj_lift)
      apply (rule_tac Q'="\<lambda>_. valid_sched and not_queued t and valid_idle and (\<lambda>s. t \<noteq> idle_thread s)" in hoare_strengthen_post)
@@ -3357,7 +3315,7 @@ lemma perform_invocation_valid_sched[wp]:
   "\<lbrace>invs and valid_invocation i and ct_active and simple_sched_action and valid_sched
          and (\<lambda>s. not_queued (cur_thread s) s)\<rbrace>
      perform_invocation calling blocking i
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (cases i, simp_all)
           apply (wp invoke_untyped_valid_sched send_ipc_valid_sched | clarsimp)+
          apply (clarsimp simp: ct_in_state_def)
@@ -3368,7 +3326,7 @@ lemma perform_invocation_valid_sched[wp]:
   done
 end
 
-crunch set_thread_state_ext
+crunch set_thread_state_act
   for not_queued[wp]: "not_queued t"
 
 crunch set_thread_state
@@ -3379,7 +3337,7 @@ lemma handle_invocation_valid_sched:
   "\<lbrace>invs and valid_sched and ct_active and
     (\<lambda>s. scheduler_action s = resume_cur_thread)\<rbrace>
      handle_invocation a b
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: handle_invocation_def)
   apply (wp syscall_valid handle_fault_valid_sched | wpc)+
                 apply (wp set_thread_state_runnable_valid_sched)[1]
@@ -3405,7 +3363,7 @@ lemma valid_sched_ct_not_queued:
 
 context DetSchedSchedule_AI begin
 lemma handle_reply_valid_sched:
-  "\<lbrace>valid_sched and ct_active and invs\<rbrace> handle_reply \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  "\<lbrace>valid_sched and ct_active and invs\<rbrace> handle_reply \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: handle_reply_def)
   apply (wp get_cap_wp | wpc | clarsimp)+
 
@@ -3416,7 +3374,7 @@ end
 
 crunch do_machine_op, cap_insert, set_extra_badge
   for ct_not_queued[wp]: "\<lambda>s. not_queued (cur_thread s) s"
-  (wp: hoare_drop_imps)
+  (wp: hoare_drop_imps dxo_wp_weak)
 
 lemma transfer_caps_ct_not_queued[wp]:
   "\<lbrace>\<lambda>s. not_queued (cur_thread s) s\<rbrace>
@@ -3433,22 +3391,17 @@ crunch set_thread_state
 context DetSchedSchedule_AI begin
 
 crunch handle_fault_reply
-  for not_queued[wp]: "not_queued t"
+  for not_queued[wp]: "not_queued t :: det_state \<Rightarrow> _"
 
 crunch handle_fault_reply
-  for sched_act_not[wp]: "scheduler_act_not t"
-
-crunch set_extra_badge, do_ipc_transfer
-  for valid_etcbs[wp]: valid_etcbs
-  (wp: crunch_wps const_on_failure_wp simp: crunch_simps
-   rule: transfer_caps_loop_pres)
+  for sched_act_not[wp]: "scheduler_act_not t :: det_state \<Rightarrow> _"
 
 crunch handle_fault_reply
   for cur[wp]: "cur_tcb :: det_ext state \<Rightarrow> bool"
   (wp: crunch_wps simp: crunch_simps)
 
 crunch empty_slot_ext, cap_delete_one
-  for weak_valid_sched_action[wp]: weak_valid_sched_action
+  for weak_valid_sched_action[wp]: "weak_valid_sched_action :: det_state \<Rightarrow> _"
   (wp: crunch_wps set_thread_state_runnable_weak_valid_sched_action
        set_bound_notification_weak_valid_sched_action
    simp: cur_tcb_def unless_def)
@@ -3457,7 +3410,7 @@ lemma do_reply_transfer_not_queued[wp]:
   "\<lbrace>not_queued t and invs and st_tcb_at active t and scheduler_act_not t and
     K(receiver \<noteq> t)\<rbrace>
      do_reply_transfer sender receiver slot grant
-   \<lbrace>\<lambda>_. not_queued t\<rbrace>"
+   \<lbrace>\<lambda>_. not_queued t :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: do_reply_transfer_def)
   apply (wp cap_delete_one_not_queued hoare_vcg_if_lift | wpc |
          clarsimp split del: if_split | wp (once) hoare_drop_imps)+
@@ -3467,7 +3420,7 @@ lemma do_reply_transfer_not_queued[wp]:
 lemma do_reply_transfer_schedact_not[wp]:
   "\<lbrace>scheduler_act_not t and K(receiver \<noteq> t)\<rbrace>
      do_reply_transfer sender receiver slot grant
-   \<lbrace>\<lambda>_. scheduler_act_not t\<rbrace>"
+   \<lbrace>\<lambda>_. scheduler_act_not t :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: do_reply_transfer_def)
   apply (wp hoare_vcg_if_lift | wpc | clarsimp split del: if_split |
          wp (once) hoare_drop_imps)+
@@ -3507,7 +3460,7 @@ context DetSchedSchedule_AI begin
 lemma do_reply_transfer_ct_not_queued[wp]:
   "\<lbrace>ct_not_queued and invs and ct_active and scheduler_act_sane\<rbrace>
      do_reply_transfer sender receiver slot grant
-   \<lbrace>\<lambda>_. ct_not_queued\<rbrace>"
+   \<lbrace>\<lambda>_. ct_not_queued :: det_state \<Rightarrow> _\<rbrace>"
   apply (rule do_reply_transfer_add_assert)
   apply (rule hoare_pre)
    apply (wp ct_not_queued_lift)
@@ -3517,7 +3470,7 @@ lemma do_reply_transfer_ct_not_queued[wp]:
 lemma do_reply_transfer_scheduler_act_sane[wp]:
   "\<lbrace>scheduler_act_sane and ct_active\<rbrace>
      do_reply_transfer sender receiver slot grant
-   \<lbrace>\<lambda>_. scheduler_act_sane\<rbrace>"
+   \<lbrace>\<lambda>_. scheduler_act_sane :: det_state \<Rightarrow> _\<rbrace>"
   apply (rule do_reply_transfer_add_assert)
   apply (rule hoare_pre)
    apply (wp sch_act_sane_lift)
@@ -3525,9 +3478,9 @@ lemma do_reply_transfer_scheduler_act_sane[wp]:
   done
 
 crunch handle_reply
-  for ct_not_queued[wp]: "ct_not_queued"
+  for ct_not_queued[wp]: "ct_not_queued :: det_state \<Rightarrow> _"
 crunch handle_reply
-  for scheduler_act_sane[wp]: "scheduler_act_sane"
+  for scheduler_act_sane[wp]: "scheduler_act_sane :: det_state \<Rightarrow> _"
 
 end
 
@@ -3537,19 +3490,19 @@ locale DetSchedSchedule_AI_handle_hypervisor_fault = DetSchedSchedule_AI +
       \<lbrace>valid_sched and invs and st_tcb_at active t and not_queued t and scheduler_act_not t
           and (ct_active or ct_idle)\<rbrace>
         handle_hypervisor_fault t fault
-      \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+      \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   assumes handle_reserved_irq_valid_sched' [wp]:
     "\<And>irq.
       \<lbrace>valid_sched and invs and
          (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> scheduler_act_sane s \<and> ct_not_queued s)\<rbrace>
         handle_reserved_irq irq
-      \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+      \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
 
 context DetSchedSchedule_AI_handle_hypervisor_fault begin
 
 lemma handle_interrupt_valid_sched[wp]:
   "\<lbrace>valid_sched and invs and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> scheduler_act_sane s \<and> ct_not_queued s)\<rbrace>
-  handle_interrupt irq \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+  handle_interrupt irq \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   unfolding handle_interrupt_def
   by (wpsimp wp: get_cap_wp hoare_drop_imps hoare_vcg_all_lift|rule conjI)+
 
@@ -3567,7 +3520,7 @@ lemma possible_switch_to_not_cur_thread [wp]:
   done
 
 crunch handle_recv
-  for not_cur_thread[wp]: "not_cur_thread target"
+  for not_cur_thread[wp]: "not_cur_thread target :: det_state \<Rightarrow> _"
   (wp: crunch_wps simp: crunch_simps)
 
 crunch handle_recv
@@ -3578,7 +3531,7 @@ lemma handle_event_valid_sched:
   "\<lbrace>invs and valid_sched and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_active s)
       and (\<lambda>s. scheduler_action s = resume_cur_thread)\<rbrace>
    handle_event e
-   \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>rv. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (cases e, simp_all)
       apply (rename_tac syscall)
       apply (case_tac syscall, simp_all add: handle_send_def handle_call_def)
@@ -3600,8 +3553,12 @@ crunch guarded_switch_to, switch_to_idle_thread, choose_thread
 
 end
 
-crunch next_domain
-  for valid_list[wp]: valid_list (simp: Let_def)
+lemma next_domain_valid_list[wp]:
+  "next_domain \<lbrace>valid_list\<rbrace>"
+  unfolding next_domain_def Let_def
+  apply (fold reset_work_units_def)
+  apply (wpsimp | simp add: reset_work_units_def)+
+  done
 
 context DetSchedSchedule_AI_handle_hypervisor_fault begin
 
@@ -3611,7 +3568,6 @@ crunch schedule_choose_new_thread
 lemma schedule_valid_list[wp]: "\<lbrace>valid_list\<rbrace> Schedule_A.schedule \<lbrace>\<lambda>_. valid_list\<rbrace>"
   apply (simp add: Schedule_A.schedule_def)
   apply (wp add: tcb_sched_action_valid_list gts_wp hoare_drop_imps
-            del: ethread_get_wp
          | wpc | simp)+
   done
 
@@ -3623,7 +3579,7 @@ lemma call_kernel_valid_sched:
   "\<lbrace>invs and valid_sched and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running s) and (ct_active or ct_idle)
       and (\<lambda>s. scheduler_action s = resume_cur_thread)\<rbrace>
      call_kernel e
-   \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+   \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
   apply (simp add: call_kernel_def)
   apply (wp schedule_valid_sched activate_thread_valid_sched | simp)+
      apply (rule_tac Q'="\<lambda>rv. invs" in hoare_strengthen_post)
diff --git a/proof/invariant-abstract/Deterministic_AI.thy b/proof/invariant-abstract/Deterministic_AI.thy
index c4db9f5153..d09718d02a 100644
--- a/proof/invariant-abstract/Deterministic_AI.thy
+++ b/proof/invariant-abstract/Deterministic_AI.thy
@@ -1504,12 +1504,10 @@ lemma set_cap_match: "(\<And>s x. P s = P (s\<lparr>kheap := x\<rparr>)) \<Longr
   apply wpsimp
   done
 
-crunch cap_insert_ext, empty_slot_ext, cap_swap_ext, create_cap_ext, set_thread_state_ext,
-         retype_region_ext
+crunch cap_insert_ext, empty_slot_ext, cap_swap_ext, create_cap_ext
   for all_but_exst[wp]:  "all_but_exst P"
   and (empty_fail) empty_fail[wp]
-  (ignore_del: cap_insert_ext empty_slot_ext cap_swap_ext create_cap_ext set_thread_state_ext
-               retype_region_ext)
+  (ignore_del: cap_insert_ext empty_slot_ext cap_swap_ext create_cap_ext)
 
 interpretation cap_insert_ext_extended: is_extended "cap_insert_ext a b c d e"
   by (unfold_locales; wp)
@@ -3819,19 +3817,9 @@ crunch set_extra_badge
 lemmas transfer_caps_loop_ext_valid[wp] =
   transfer_caps_loop_pres[OF cap_insert_valid_list set_extra_badge_valid_list]
 
-crunch tcb_sched_action,reschedule_required,set_thread_state_ext
+crunch tcb_sched_action,reschedule_required
   for valid_list[wp]: "valid_list"
-  (simp: unless_def ignore_del: tcb_sched_action reschedule_required set_thread_state_ext)
-
-interpretation set_thread_state_ext_extended: is_extended "set_thread_state_ext a"
-  by (unfold_locales; wp)
-
-crunch reschedule_required
-  for all_but_exst[wp]: "all_but_exst P"
-  (ignore_del: reschedule_required)
-
-interpretation reschedule_required_ext_extended: is_extended "reschedule_required"
-  by (unfold_locales; wp)
+  (simp: unless_def)
 
 crunch fast_finalise
   for valid_list[wp]: valid_list (wp: crunch_wps)
@@ -3903,20 +3891,8 @@ lemma cap_revoke_valid_list[wp]:"\<lbrace>valid_list\<rbrace> cap_revoke a \<lbr
   apply (wp preemption_point_inv'|simp)+
   done
 
-crunch ethread_set
-  for valid_list[wp]: "valid_list"
-
 end
 
-crunch ethread_set
-  for all_but_exst[wp]: "all_but_exst P"
-
-crunch ethread_set
-  for (empty_fail) empty_fail[wp]
-
-global_interpretation ethread_set_extended: is_extended "ethread_set a b"
-  by (unfold_locales; wp)
-
 crunch cancel_badged_sends
   for valid_list[wp]: valid_list
   (wp: crunch_wps preemption_point_inv' simp: crunch_simps filterM_mapM unless_def
@@ -3933,46 +3909,18 @@ lemma invoke_cnode_valid_list[wp]:
 end
 
 crunch possible_switch_to
-  for all_but_exst[wp]: "all_but_exst P"
-  and valid_list[wp]: "valid_list"
+  for valid_list[wp]: "valid_list"
   and (empty_fail) empty_fail[wp]
-  (simp: ethread_get_def ignore_del: possible_switch_to)
 
 crunch set_priority,set_mcpriority
   for valid_list[wp]: "valid_list"
-  (wp: crunch_wps ignore_del: set_priority)
-
-global_interpretation possible_switch_to_extended: is_extended "possible_switch_to a"
-  by (unfold_locales; wp)
-
-crunch set_priority
-  for all_but_exst[wp]: "all_but_exst P"
-  (simp: ethread_get_def ignore_del: set_priority)
 
 crunch set_priority,set_mcpriority
   for (empty_fail) empty_fail[wp]
 
-global_interpretation set_priority_extended: is_extended "set_priority a b"
-  by (unfold_locales; wp)
-
-crunch set_domain
-  for all_but_exst[wp]: "all_but_exst P" (simp: ethread_get_def)
-
-global_interpretation set_domain_extended: is_extended "set_domain a b"
-  by (unfold_locales; wp)
-
-global_interpretation thread_set_domain_extended: is_extended "thread_set_domain a b"
-  by (unfold_locales; wp)
-
-crunch dec_domain_time
-  for all_but_exst[wp]: "all_but_exst P" (simp: ethread_get_def)
-
 crunch dec_domain_time
   for (empty_fail) empty_fail[wp]
 
-global_interpretation dec_domain_time_extended: is_extended "dec_domain_time"
-  by (unfold_locales; wp)
-
 crunch update_restart_pc
   for valid_list[wp]: "valid_list"
 
@@ -3984,25 +3932,14 @@ end
 
 lemma delete_objects_valid_list[wp]: "\<lbrace>valid_list\<rbrace> delete_objects ptr bits \<lbrace>\<lambda>_.valid_list\<rbrace>"
   unfolding delete_objects_def
-  apply (wp | simp add: detype_def detype_ext_def wrap_ext_det_ext_ext_def)+
+  apply (wp | simp add: detype_def)+
   done
 
 lemmas mapM_x_def_bak = mapM_x_def[symmetric]
 
-lemma retype_region_ext_valid_list_ext[wp]: "\<lbrace>valid_list\<rbrace> retype_region_ext a b \<lbrace>\<lambda>_.valid_list\<rbrace>"
-  by (wpsimp simp: retype_region_ext_def)
-
-global_interpretation retype_region_ext_extended: is_extended "retype_region_ext a b"
-  by (unfold_locales; wp)
-
 crunch timer_tick
   for valid_list[wp]: "valid_list"
-  and all_but_exst[wp]: "all_but_exst P"
   and (empty_fail) empty_fail[wp]
-  (ignore_del: timer_tick)
-
-global_interpretation timer_tick_extended: is_extended "timer_tick"
-  by (unfold_locales; wp)
 
 locale Deterministic_AI_2 = Deterministic_AI_1 +
   assumes arch_invoke_irq_handler_valid_list[wp]:
diff --git a/proof/invariant-abstract/EmptyFail_AI.thy b/proof/invariant-abstract/EmptyFail_AI.thy
index 8ccf6bfa90..b4dd935163 100644
--- a/proof/invariant-abstract/EmptyFail_AI.thy
+++ b/proof/invariant-abstract/EmptyFail_AI.thy
@@ -58,8 +58,7 @@ crunch_ignore (empty_fail)
   (add: Nondet_Monad.bind bindE lift liftE liftM "when" whenE unless unlessE return fail
         assert_opt mapM mapM_x sequence_x catch handleE do_extended_op returnOk throwError
         cap_insert_ext empty_slot_ext create_cap_ext cap_swap_ext cap_move_ext
-        reschedule_required possible_switch_to set_thread_state_ext
-        OR_choice OR_choiceE timer_tick getRegister lookup_error_on_failure
+        OR_choice OR_choiceE getRegister lookup_error_on_failure
         mapME_x const_on_failure liftME mapME do_machine_op select
         empty_on_failure unify_failure zipWithM_x throw_on_false
         decode_tcb_invocation without_preemption as_user syscall
@@ -159,8 +158,7 @@ lemmas resolve_address_bits_empty_fail[wp] =
 
 crunch
   lookup_slot_for_cnode_op, decode_untyped_invocation, range_check,
-  lookup_source_slot, lookup_pivot_slot, cap_swap_for_delete, is_final_cap, set_cap,
-  allActiveTCBs
+  lookup_source_slot, lookup_pivot_slot, cap_swap_for_delete, is_final_cap, set_cap
   for (empty_fail) empty_fail[wp]
 
 locale EmptyFail_AI_load_word =
@@ -331,38 +329,33 @@ locale EmptyFail_AI_schedule = EmptyFail_AI_cap_revoke state_ext_t
     "empty_fail (switch_to_idle_thread :: (unit, 'state_ext) s_monad)"
   assumes get_thread_state_empty_fail[wp]:
     "empty_fail (get_thread_state ref :: (thread_state, 'state_ext) s_monad)"
-  assumes guarded_switch_to_empty_fail[wp]:
-    "empty_fail (guarded_switch_to thread :: (unit, 'state_ext) s_monad)"
-
-locale EmptyFail_AI_schedule_unit = EmptyFail_AI_schedule "TYPE(unit)"
-
-context EmptyFail_AI_schedule_unit begin
-
-lemma schedule_empty_fail[wp]:
-  "empty_fail (schedule :: (unit,unit) s_monad)"
-  apply (simp add: schedule_def)
-  apply (wp disjI2)
-  done
-
-end
+  assumes arch_switch_to_thread_empty_fail[wp]:
+    "empty_fail (arch_switch_to_thread t :: (unit, 'state_ext) s_monad)"
 
 crunch set_scheduler_action, next_domain, reschedule_required
   for (empty_fail) empty_fail[wp]
   (simp: scheduler_action.split ignore_del: reschedule_required)
 
-crunch ethread_get_when
-  for (empty_fail) empty_fail[wp, intro!, simp]
+context EmptyFail_AI_schedule begin
 
-locale EmptyFail_AI_schedule_det = EmptyFail_AI_schedule "TYPE(det_ext)" +
-  assumes choose_thread_empty_fail[wp]: "empty_fail choose_thread"
+lemma switch_to_thread_empty_fail[intro!, wp, simp]:
+  "empty_fail (switch_to_thread thread :: (unit,'state_ext) s_monad)"
+  by (wpsimp simp: switch_to_thread_def)
 
-context EmptyFail_AI_schedule_det begin
+lemma guarded_switch_to_empty_fail[intro!, wp, simp]:
+  "empty_fail (guarded_switch_to thread :: (unit,'state_ext) s_monad)"
+  by (wpsimp simp: guarded_switch_to_def)
 
-crunch schedule_choose_new_thread
-  for (empty_fail) empty_fail[wp, intro!, simp]
+lemma choose_thread_empty_fail[intro!, wp, simp]:
+  "empty_fail (choose_thread :: (unit,'state_ext) s_monad)"
+  by (wpsimp simp: choose_thread_def)
+
+lemma schedule_choose_new_thread_empty_fail[intro!, wp, simp]:
+  "empty_fail (schedule_choose_new_thread :: (unit,'state_ext) s_monad)"
+  by (wpsimp simp: schedule_choose_new_thread_def)
 
 lemma schedule_empty_fail'[intro!, wp, simp]:
-  "empty_fail (schedule :: (unit,det_ext) s_monad)"
+  "empty_fail (schedule :: (unit,'state_ext) s_monad)"
   apply (simp add: schedule_def schedule_switch_thread_fastfail_def)
   apply (wp | clarsimp split: scheduler_action.splits|
             intro impI conjI)+
@@ -381,26 +374,9 @@ locale EmptyFail_AI_call_kernel = EmptyFail_AI_schedule state_ext_t
   assumes handle_interrupt_empty_fail[wp]:
     "\<And>interrupt. empty_fail (handle_interrupt interrupt :: (unit, 'state_ext) s_monad)"
 
-locale EmptyFail_AI_call_kernel_unit
-  = EmptyFail_AI_schedule_unit
-  + EmptyFail_AI_call_kernel "TYPE(unit)"
-
-context EmptyFail_AI_call_kernel_unit begin
-
-lemma call_kernel_empty_fail': "empty_fail (call_kernel a :: (unit,unit) s_monad)"
-  apply (simp add: call_kernel_def)
-  apply (wp | simp)+
-  done
-
-end
-
-locale EmptyFail_AI_call_kernel_det
-  = EmptyFail_AI_schedule_det
-  + EmptyFail_AI_call_kernel "TYPE(det_ext)"
-
-context EmptyFail_AI_call_kernel_det begin
+begin
 
-lemma call_kernel_empty_fail: "empty_fail (call_kernel a :: (unit,det_ext) s_monad)"
+lemma call_kernel_empty_fail: "empty_fail (call_kernel a :: (unit,'state_ext) s_monad)"
   apply (simp add: call_kernel_def)
   by (wp|simp)+
 
diff --git a/proof/invariant-abstract/Finalise_AI.thy b/proof/invariant-abstract/Finalise_AI.thy
index 310653546c..2ae89ba7ed 100644
--- a/proof/invariant-abstract/Finalise_AI.thy
+++ b/proof/invariant-abstract/Finalise_AI.thy
@@ -855,15 +855,18 @@ lemma sts_emptyable:
   apply (clarsimp simp: pred_tcb_at_def obj_at_def)
   done
 
+crunch tcb_sched_action, reschedule_required, possible_switch_to
+  for emptyable[wp]: "emptyable sl"
+  (wp: emptyable_lift)
 
 lemma cancel_all_emptyable_helper:
   "\<lbrace>emptyable sl and (\<lambda>s. \<forall>t \<in> set q. st_tcb_at (\<lambda>st. \<not> halted st) t s)\<rbrace>
      mapM_x (\<lambda>t. do y \<leftarrow> set_thread_state t Structures_A.Restart;
-                    do_extended_op (tcb_sched_enqueue_ext t) od) q
+                    tcb_sched_action tcb_sched_enqueue t od) q
    \<lbrace>\<lambda>rv. emptyable sl\<rbrace>"
   apply (rule hoare_strengthen_post)
    apply (rule mapM_x_wp [where S="set q", simplified])
-    apply (wp, simp, wp hoare_vcg_const_Ball_lift sts_emptyable sts_st_tcb_at_cases)
+    apply (wpsimp wp: hoare_vcg_const_Ball_lift sts_emptyable sts_st_tcb_at_cases)
      apply simp+
   done
 
@@ -1217,11 +1220,6 @@ lemma valid_irq_node_arch [iff]:
   "valid_irq_node (arch_state_update f s) = valid_irq_node s"
   by (simp add: valid_irq_node_def)
 
-(* FIXME: move *)
-lemma vms_arch_state_update[simp]:
-  "valid_machine_state (arch_state_update f s) = valid_machine_state s"
-  by (simp add: valid_machine_state_def)
-
 (* FIXME: move *)
 lemma dmo_bind_return:
   "\<lbrace>P\<rbrace> do_machine_op f \<lbrace>\<lambda>_. Q\<rbrace> \<Longrightarrow>
@@ -1237,12 +1235,12 @@ lemma st_tcb_at_idle_thread:
 
 lemma tcb_state_merge_tcb_state_default:
   "tcb_state (tcb_registers_caps_merge tcb tcb') = tcb_state tcb"
-  "tcb_state default_tcb = Structures_A.Inactive"
+  "tcb_state (default_tcb d) = Structures_A.Inactive"
   by (auto simp add: tcb_registers_caps_merge_def default_tcb_def)
 
 lemma tcb_bound_notification_merge_tcb_state_default:
   "tcb_bound_notification (tcb_registers_caps_merge tcb tcb') = tcb_bound_notification tcb"
-  "tcb_bound_notification default_tcb = None"
+  "tcb_bound_notification (default_tcb d) = None"
   by (auto simp add: tcb_registers_caps_merge_def default_tcb_def)
 
 (*Lift hoare triples from an instantiation to the nondeterministic hoare triple version.
diff --git a/proof/invariant-abstract/Include_AI.thy b/proof/invariant-abstract/Include_AI.thy
index 55f8b63534..8777152a20 100644
--- a/proof/invariant-abstract/Include_AI.thy
+++ b/proof/invariant-abstract/Include_AI.thy
@@ -41,8 +41,6 @@ crunch_ignore (add:
   setNextPC)
 
 crunch_ignore (add:
-  cap_swap_ext cap_move_ext cap_insert_ext empty_slot_ext create_cap_ext
-  reschedule_required set_thread_state_ext tcb_sched_action
-  possible_switch_to timer_tick set_priority retype_region_ext)
+  cap_swap_ext cap_move_ext cap_insert_ext empty_slot_ext create_cap_ext)
 
 end
diff --git a/proof/invariant-abstract/Invariants_AI.thy b/proof/invariant-abstract/Invariants_AI.thy
index 005db58cf7..c3e7053ac9 100644
--- a/proof/invariant-abstract/Invariants_AI.thy
+++ b/proof/invariant-abstract/Invariants_AI.thy
@@ -2642,6 +2642,10 @@ lemma valid_reply_masters_update [iff]:
 lemmas in_user_frame_update[iff] = in_user_frame_update
 lemmas in_device_frame_update[iff] = in_device_frame_update
 
+lemma zombies_final_update[iff]:
+  "zombies_final (f s) = zombies_final s"
+  by (simp add: zombies_final_def is_final_cap'_def)
+
 end
 
 
@@ -2764,6 +2768,42 @@ interpretation more_update:
 
 sublocale Arch \<subseteq> more_update: Arch_p_arch_idle_update_int_eq "trans_state f" ..
 
+interpretation scheduler_action_update:
+  p_arch_idle_update_int_eq "scheduler_action_update f"
+  by unfold_locales auto
+
+sublocale Arch \<subseteq> scheduler_action_update: Arch_p_arch_idle_update_int_eq "scheduler_action_update f" ..
+
+interpretation domain_list_update:
+  p_arch_idle_update_int_eq "domain_list_update f"
+  by unfold_locales auto
+
+sublocale Arch \<subseteq> domain_list_update: Arch_p_arch_idle_update_int_eq "domain_list_update f" ..
+
+interpretation domain_index_update:
+  p_arch_idle_update_int_eq "domain_index_update f"
+  by unfold_locales auto
+
+sublocale Arch \<subseteq> domain_index_update: Arch_p_arch_idle_update_int_eq "domain_index_update f" ..
+
+interpretation cur_domain_update:
+  p_arch_idle_update_int_eq "cur_domain_update f"
+  by unfold_locales auto
+
+sublocale Arch \<subseteq> cur_domain_update: Arch_p_arch_idle_update_int_eq "cur_domain_update f" ..
+
+interpretation domain_time_update:
+  p_arch_idle_update_int_eq "domain_time_update f"
+  by unfold_locales auto
+
+sublocale Arch \<subseteq> domain_time_update: Arch_p_arch_idle_update_int_eq "domain_time_update f" ..
+
+interpretation ready_queues_update:
+  p_arch_idle_update_int_eq "ready_queues_update f"
+  by unfold_locales auto
+
+sublocale Arch \<subseteq> ready_queues_update: Arch_p_arch_idle_update_int_eq "ready_queues_update f" ..
+
 interpretation interrupt_update:
   p_arch_idle_update_eq "interrupt_states_update f"
   by unfold_locales auto
@@ -2802,6 +2842,18 @@ lemma valid_mdb_cur [iff]:
   "valid_mdb (cur_thread_update f s) = valid_mdb s"
   by (auto elim!: valid_mdb_eqI)
 
+lemma valid_mdb_ready_queues_update[simp]:
+  "valid_mdb (ready_queues_update f s) = valid_mdb s"
+  by (simp add: valid_mdb_def mdb_cte_at_def)
+
+lemma valid_mdb_domain_time_update[simp]:
+  "valid_mdb (domain_time_update f s) = valid_mdb s"
+  by (simp add: valid_mdb_def mdb_cte_at_def)
+
+lemma valid_mdb_sched_act_update[simp]:
+  "valid_mdb (scheduler_action_update f s) = valid_mdb s"
+  by (simp add: valid_mdb_def mdb_cte_at_def)
+
 lemma valid_mdb_more_update [iff]:
   "valid_mdb (trans_state f s) = valid_mdb s"
   by (auto elim!: valid_mdb_eqI)
@@ -2890,7 +2942,7 @@ lemma dom_empty_cnode: "dom (empty_cnode us) = {x. length x = us}"
   by (simp add: dom_def)
 
 lemma obj_at_default_cap_valid:
-  "\<lbrakk>obj_at (\<lambda>ko. ko = default_object ty dev us) x s;
+  "\<lbrakk>obj_at (\<lambda>ko. ko = default_object ty dev us d) x s;
    ty = CapTableObject \<Longrightarrow> 0 < us;
    ty \<noteq> Untyped; ty \<noteq> ArchObject ASIDPoolObj;
    cap_aligned (default_cap ty x us dev)\<rbrakk>
@@ -3121,6 +3173,7 @@ lemmas (in pspace_update_eq) state_hyp_refs_update[iff] = state_hyp_refs_update[
 
 declare more_update.state_refs_update[iff]
 declare more_update.state_hyp_refs_update[iff]
+declare ready_queues_update.state_refs_update[simp]
 
 lemma zombies_final_arch_update [iff]:
   "zombies_final (arch_state_update f s) = zombies_final s"
@@ -3156,10 +3209,94 @@ lemma vms_ioc_update[iff]:
   "valid_machine_state (is_original_cap_update f s::'z::state_ext state) = valid_machine_state s"
   by (simp add: valid_machine_state_def)+
 
+lemma valid_ioc_sched_act_update[simp]:
+  "valid_ioc (scheduler_action_update f s) = valid_ioc s"
+  by (simp add: valid_ioc_def)
+
+lemma valid_ioc_ready_queues_update[simp]:
+  "valid_ioc (ready_queues_update f s) = valid_ioc s"
+  by (simp add: valid_ioc_def)
+
+lemma valid_ioc_domain_time_update[simp]:
+  "valid_ioc (domain_time_update f s) = valid_ioc s"
+  by (simp add: valid_ioc_def)
+
+lemma cur_tcb_cdt_update [simp]:
+  "cur_tcb (cdt_update f s) = cur_tcb s"
+  by (simp add: cur_tcb_def)
+
+lemma cur_tcb_more_update[iff]:
+  "cur_tcb (trans_state f s) = cur_tcb s"
+  by (simp add: cur_tcb_def)
+
+lemma cur_tcb_ready_queues_update[simp]:
+  "cur_tcb (ready_queues_update f s) = cur_tcb s"
+  by (simp add: cur_tcb_def)
+
+lemma cur_tcb_domain_time_update[simp]:
+  "cur_tcb (domain_time_update f s) = cur_tcb s"
+  by (simp add: cur_tcb_def)
+
+lemma vms_arch_state_update[simp]:
+  "valid_machine_state (arch_state_update f s) = valid_machine_state s"
+  by (simp add: valid_machine_state_def)
+
+lemma valid_machine_state_ready_queues_update[simp]:
+  "valid_machine_state (ready_queues_update f s) = valid_machine_state s"
+  by (simp add: valid_machine_state_def)
+
+lemma valid_machine_state_domain_time_update[simp]:
+  "valid_machine_state (domain_time_update f s) = valid_machine_state s"
+  by (simp add: valid_machine_state_def)
+
+lemma valid_machine_state_sched_act_update[simp]:
+  "valid_machine_state (scheduler_action_update f s) = valid_machine_state s"
+  by (simp add: valid_machine_state_def)
+
 lemma valid_machine_state_more_update[iff]:
   "valid_machine_state (trans_state f s) = valid_machine_state s"
   by (simp add: valid_machine_state_def)
 
+lemma valid_irq_states_cur_thread_update[simp]:
+  "valid_irq_states (cur_thread_update f s) = valid_irq_states s"
+  by(simp add: valid_irq_states_def)
+
+lemma valid_irq_states_cdt_update[simp]:
+  "valid_irq_states (cdt_update f s) = valid_irq_states s"
+  by(auto simp: valid_irq_states_def)
+
+lemma valid_irq_states_is_original_cap_update[simp]:
+  "valid_irq_states (is_original_cap_update f s) = valid_irq_states s"
+  by(auto simp: valid_irq_states_def)
+
+lemma valid_irq_states_arch_state_update[simp]:
+  "valid_irq_states (arch_state_update f s) = valid_irq_states s"
+  by(auto simp: valid_irq_states_def)
+
+lemma valid_irq_states_ready_queues_update[simp]:
+  "valid_irq_states (ready_queues_update f s) = valid_irq_states s"
+  by (simp add: valid_irq_states_def)
+
+lemma valid_irq_states_domain_time_update[simp]:
+  "valid_irq_states (domain_time_update f s) = valid_irq_states s"
+  by (simp add: valid_irq_states_def)
+
+lemma valid_irq_states_exst_update[simp]:
+  "valid_irq_states (exst_update f s) = valid_irq_states s"
+  by(auto simp: valid_irq_states_def)
+
+lemma valid_irq_states_more_update[iff]:
+  "valid_irq_states (trans_state f s) = valid_irq_states s"
+  by (simp add: valid_irq_states_def)
+
+lemma ex_nonz_cap_to_sched_act_update[simp]:
+  "ex_nonz_cap_to p (scheduler_action_update f s) = ex_nonz_cap_to p s"
+  by (simp add: ex_nonz_cap_to_def)
+
+lemma ex_nonz_cap_to_more_update[iff]:
+  "ex_nonz_cap_to w (trans_state f s) = ex_nonz_cap_to w s"
+   by (simp add: ex_nonz_cap_to_def)
+
 lemma only_idle_lift_weak:
   assumes "\<And>Q P t. \<lbrace>\<lambda>s. Q (st_tcb_at P t s)\<rbrace> f \<lbrace>\<lambda>_ s. Q (st_tcb_at P t s)\<rbrace>"
   assumes "\<And>P. \<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> f \<lbrace>\<lambda>_ s. P (idle_thread s)\<rbrace>"
@@ -3220,11 +3357,6 @@ lemma tcb_at_invs [elim!]:
   "invs s \<Longrightarrow> tcb_at (cur_thread s) s"
   by (simp add: invs_def cur_tcb_def)
 
-lemma valid_irq_states_more_update[iff]:
-  "valid_irq_states (trans_state f s) = valid_irq_states s"
-  by (simp add: valid_irq_states_def)
-
-
 lemma invs_valid_objs [elim!]:
   "invs s \<Longrightarrow> valid_objs s"
   by (simp add: invs_def valid_state_def valid_pspace_def)
diff --git a/proof/invariant-abstract/IpcCancel_AI.thy b/proof/invariant-abstract/IpcCancel_AI.thy
index 30c49f0710..1c48e7fed1 100644
--- a/proof/invariant-abstract/IpcCancel_AI.thy
+++ b/proof/invariant-abstract/IpcCancel_AI.thy
@@ -26,15 +26,14 @@ crunch cancel_all_ipc
   for typ_at: "\<lambda>s. P (typ_at T p s)" (wp: crunch_wps mapM_x_wp)
 
 lemma cancel_all_helper:
-  " \<lbrace>valid_objs and
-    (\<lambda>s. \<forall>t \<in> set queue. st_tcb_at (\<lambda>st. \<not> halted st) t s) \<rbrace>
-     mapM_x (\<lambda>t. do y \<leftarrow> set_thread_state t Structures_A.Restart;
-                    do_extended_op (tcb_sched_enqueue_ext t) od) queue
+  "\<lbrace>valid_objs and
+    (\<lambda>s. \<forall>t \<in> set queue. st_tcb_at (\<lambda>st. \<not> halted st) t s)\<rbrace>
+   mapM_x (\<lambda>t. do y \<leftarrow> set_thread_state t Structures_A.Restart;
+                  tcb_sched_action tcb_sched_enqueue t od) queue
    \<lbrace>\<lambda>rv. valid_objs\<rbrace>"
   apply (rule hoare_strengthen_post)
    apply (rule mapM_x_wp [where S="set queue", simplified])
-    apply (wp, simp, wp hoare_vcg_const_Ball_lift sts_st_tcb_at_cases, simp)
-    apply (clarsimp elim: pred_tcb_weakenE)
+    apply (wpsimp wp: hoare_vcg_const_Ball_lift sts_st_tcb_at_cases)
     apply (erule(1) my_BallE)
     apply (clarsimp simp: st_tcb_def2)
     apply (frule(1) valid_tcb_objs)
@@ -364,11 +363,12 @@ lemma blocked_cancel_ipc_invs:
    apply (erule(1) obj_at_valid_objsE, clarsimp simp: valid_obj_def)
    apply (frule st_tcb_at_state_refs_ofD)
    apply (subgoal_tac "epptr \<notin> set (remove1 t queue)")
-    apply (case_tac ep, simp_all add: valid_ep_def)[1]
-     apply (auto elim!: delta_sym_refs pred_tcb_weaken_strongerE
+    subgoal for epptr ep queue s
+    apply (case_tac ep; simp add: valid_ep_def)
+     by (auto elim!: delta_sym_refs pred_tcb_weaken_strongerE
                  simp: obj_at_def is_ep_def2 idle_not_queued refs_in_tcb_bound_refs
                  dest: idle_no_refs
-                 split: if_split_asm)[2]
+                 split: if_split_asm)
    apply (case_tac ep, simp_all add: valid_ep_def)[1]
     apply (clarsimp, drule(1) bspec, clarsimp simp: obj_at_def is_tcb_def)+
   apply fastforce
@@ -601,9 +601,14 @@ lemma (in delete_one_abs) cancel_ipc_no_reply_cap[wp]:
                    elim!: pred_tcb_weakenE)+
   done
 
+lemma tcb_sched_action_invs[wp]:
+  "\<lbrace>invs\<rbrace> tcb_sched_action action thread \<lbrace>\<lambda>rv. invs\<rbrace>"
+  by (wpsimp simp: tcb_sched_action_def set_tcb_queue_def get_tcb_queue_def)
+
 lemma (in delete_one_abs) suspend_invs[wp]:
   "\<lbrace>invs and tcb_at t and (\<lambda>s. t \<noteq> idle_thread s)\<rbrace>
-   (suspend t :: (unit,'a) s_monad) \<lbrace>\<lambda>rv. invs\<rbrace>"
+   (suspend t :: (unit,'a) s_monad)
+   \<lbrace>\<lambda>rv. invs\<rbrace>"
   by (wp sts_invs_minor user_getreg_inv as_user_invs sts_invs_minor cancel_ipc_invs
          cancel_ipc_no_reply_cap
      | strengthen no_refs_simple_strg
@@ -769,13 +774,16 @@ lemma reply_cancel_ipc_bound_tcb_at[wp]:
 
 crunch cancel_ipc
   for bound_tcb_at[wp]: "bound_tcb_at P t"
-(ignore: set_object thread_set wp: mapM_x_wp_inv)
+  (ignore: set_object thread_set wp: mapM_x_wp_inv)
+
+crunch tcb_sched_action
+  for obj_at[wp]: "\<lambda>s. P (obj_at Q p s)"
 
 context IpcCancel_AI begin
 lemma suspend_unlive:
   "\<lbrace>\<lambda>(s::'a state).
       (bound_tcb_at ((=) None) t and valid_mdb and valid_objs) s \<rbrace>
-      suspend t
+   suspend t
    \<lbrace>\<lambda>rv. obj_at (Not \<circ> live0) t\<rbrace>"
   apply (simp add: suspend_def set_thread_state_def set_object_def get_object_def)
     (* avoid creating two copies of obj_at *)
@@ -798,9 +806,10 @@ where
                               Some (TCB tcb) \<Rightarrow> tcb_bound_refs (tcb_bound_notification tcb)
                             | _ \<Rightarrow> {}"
 
-lemma bound_refs_of_tcb_trans:
-  "bound_refs_of_tcb (trans_state f s) x = bound_refs_of_tcb s x"
-  by (clarsimp simp:bound_refs_of_tcb_def trans_state_def)
+crunch tcb_sched_action, possible_switch_to
+  for valid_reply_caps[wp]: valid_reply_caps
+  and valid_reply_masters[wp]: valid_reply_masters
+  and valid_ioports[wp]: valid_ioports
 
 lemma cancel_all_invs_helper:
   "\<lbrace>all_invs_but_sym_refs
@@ -809,23 +818,15 @@ lemma cancel_all_invs_helper:
                                   else state_refs_of s x)
                   \<and> sym_refs (\<lambda>x. state_hyp_refs_of s x)
                   \<and> (\<forall>x\<in>set q. st_tcb_at (Not \<circ> (halted or awaiting_reply)) x s))\<rbrace>
-     mapM_x (\<lambda>t. do y \<leftarrow> set_thread_state t Structures_A.thread_state.Restart;
-                    do_extended_op (tcb_sched_enqueue_ext t) od) q
+   mapM_x (\<lambda>t. do y \<leftarrow> set_thread_state t Structures_A.thread_state.Restart;
+                  tcb_sched_action tcb_sched_enqueue t od) q
    \<lbrace>\<lambda>rv. invs\<rbrace>"
   apply (simp add: invs_def valid_state_def valid_pspace_def)
-  apply (rule mapM_x_inv_wp2)
-   apply (clarsimp simp: )
-  apply wp
-   apply (simp add:bound_refs_of_tcb_trans)
-  apply wp[1]
-          apply (rule hoare_pre, wp hoare_vcg_const_Ball_lift
-                                    valid_irq_node_typ sts_only_idle)
-           apply (rule sts_st_tcb_at_cases, simp)
-          apply (strengthen reply_cap_doesnt_exist_strg)
-          apply (auto simp: valid_tcb_state_def idle_no_ex_cap o_def if_split_asm
-                     elim!: rsubst[where P=sym_refs] st_tcb_weakenE)
-  done
-
+  apply (rule mapM_x_inv_wp2, wpsimp)
+  apply (wpsimp wp: hoare_vcg_const_Ball_lift valid_irq_node_typ sts_only_idle sts_st_tcb_at_cases)
+  apply (strengthen reply_cap_doesnt_exist_strg)
+  by (auto simp: valid_tcb_state_def idle_no_ex_cap o_def if_split_asm
+          elim!: rsubst[where P=sym_refs] st_tcb_weakenE)
 
 lemma ep_no_bound_refs:
   "ep_at p s \<Longrightarrow> {r \<in> state_refs_of s p. snd r = TCBBound} = {}"
@@ -862,6 +863,15 @@ lemma ep_no_ntfn_bound:
   apply (clarsimp simp: refs_of_rev is_ep)
   done
 
+lemma set_scheduler_action_invs[wp]:
+  "set_scheduler_action action \<lbrace>invs\<rbrace>"
+  apply (wpsimp simp: set_scheduler_action_def)
+  apply (clarsimp simp: invs_def valid_state_def)
+  done
+
+crunch possible_switch_to
+  for invs[wp]: invs
+
 lemma cancel_all_ipc_invs_helper:
   assumes x: "\<And>x ko. (x, symreftype k) \<in> refs_of ko
                 \<Longrightarrow> (refs_of ko = {(x, symreftype k)} \<or>
@@ -870,13 +880,12 @@ lemma cancel_all_ipc_invs_helper:
   "\<lbrace>invs and obj_at (\<lambda>ko. is_ep ko \<and> refs_of ko = set q \<times> {k}) p\<rbrace>
      do y \<leftarrow> set_endpoint p Structures_A.endpoint.IdleEP;
         y \<leftarrow> mapM_x (\<lambda>t. do y \<leftarrow> set_thread_state t Structures_A.thread_state.Restart;
-                           do_extended_op (tcb_sched_action (tcb_sched_enqueue) t) od) q;
-        do_extended_op reschedule_required
+                           tcb_sched_action tcb_sched_enqueue t od) q;
+        reschedule_required
     od \<lbrace>\<lambda>rv. invs\<rbrace>"
   apply (subst bind_assoc[symmetric])
   apply (rule bind_wp)
-   apply wp
-   apply simp
+   apply wpsimp
   apply (rule hoare_pre)
    apply (wp cancel_all_invs_helper hoare_vcg_const_Ball_lift valid_irq_node_typ valid_ioports_lift)
   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_ep_def live_def)
@@ -1073,7 +1082,7 @@ lemma cancel_all_signals_invs:
 lemma cancel_all_unlive_helper:
   "\<lbrace>obj_at (\<lambda>obj. \<not> live obj \<and> (\<forall>tcb. obj \<noteq> TCB tcb)) ptr\<rbrace>
      mapM_x (\<lambda>t. do y \<leftarrow> set_thread_state t Structures_A.Restart;
-                    do_extended_op (tcb_sched_enqueue_ext t) od) q
+                    tcb_sched_action tcb_sched_enqueue t od) q
    \<lbrace>\<lambda>rv. obj_at (Not \<circ> live) ptr\<rbrace>"
   apply (rule hoare_strengthen_post [OF mapM_x_wp'])
    apply (simp add: set_thread_state_def set_object_def get_object_def)
@@ -1083,6 +1092,8 @@ lemma cancel_all_unlive_helper:
   apply (clarsimp elim!: obj_at_weakenE)
   done
 
+crunch possible_switch_to
+  for obj_at[wp]: "\<lambda>s. P (obj_at Q p s)"
 
 lemma cancel_all_ipc_unlive[wp]:
   "\<lbrace>\<top>\<rbrace> cancel_all_ipc ptr \<lbrace>\<lambda> rv. obj_at (Not \<circ> live) ptr\<rbrace>"
@@ -1137,7 +1148,7 @@ lemma cancel_badged_sends_filterM_helper':
       filterM (\<lambda>t. do st \<leftarrow> get_thread_state t;
                       if blocking_ipc_badge st = badge
                       then do y \<leftarrow> set_thread_state t Structures_A.thread_state.Restart;
-                              y \<leftarrow> do_extended_op (tcb_sched_action action t);
+                              y \<leftarrow> tcb_sched_action action t;
                               return False
                       od
                       else return True
diff --git a/proof/invariant-abstract/Ipc_AI.thy b/proof/invariant-abstract/Ipc_AI.thy
index 1db26a08b9..bb16c57b28 100644
--- a/proof/invariant-abstract/Ipc_AI.thy
+++ b/proof/invariant-abstract/Ipc_AI.thy
@@ -2756,7 +2756,7 @@ lemma ri_invs':
   assumes set_endpoint_Q[wp]: "\<And>a b.\<lbrace>Q\<rbrace> set_endpoint a b \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes set_notification_Q[wp]: "\<And>a b.\<lbrace>Q\<rbrace> complete_signal a b \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes sts_Q[wp]: "\<And>a b. \<lbrace>Q\<rbrace> set_thread_state a b \<lbrace>\<lambda>_.Q\<rbrace>"
-  assumes ext_Q[wp]: "\<And>a (s::'a::state_ext state). \<lbrace>Q and valid_objs\<rbrace> do_extended_op (possible_switch_to a) \<lbrace>\<lambda>_.Q\<rbrace>"
+  assumes ext_Q[wp]: "\<And>a. \<lbrace>Q and valid_objs\<rbrace> possible_switch_to a \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes scc_Q[wp]: "\<And>a b c. \<lbrace>valid_mdb and Q\<rbrace> setup_caller_cap a b c \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes dit_Q[wp]: "\<And>a b c d e. \<lbrace>valid_mdb and valid_objs and Q\<rbrace> do_ipc_transfer a b c d e \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes failed_transfer_Q[wp]: "\<And>a. \<lbrace>Q\<rbrace> do_nbrecv_failed_transfer a \<lbrace>\<lambda>_. Q\<rbrace>"
@@ -2780,7 +2780,7 @@ lemma ri_invs':
            apply (simp add: invs_def valid_state_def valid_pspace_def)
            apply (rule hoare_pre, wp valid_irq_node_typ valid_ioports_lift)
            apply (simp add: valid_ep_def)
-          apply (wp valid_irq_node_typ sts_only_idle sts_ep_at_inv[simplified ep_at_def2, simplified]
+          apply (wp valid_irq_node_typ sts_only_idle sts_typ_ats[simplified ep_at_def2, simplified]
                     failed_transfer_Q[simplified do_nbrecv_failed_transfer_def, simplified]
                  | simp add: live_def do_nbrecv_failed_transfer_def)+
      apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def invs_def valid_state_def valid_pspace_def)
@@ -2841,7 +2841,7 @@ lemma ri_invs':
    apply (simp add: invs_def valid_state_def valid_pspace_def)
    apply (rule hoare_pre)
     apply (wp hoare_vcg_const_Ball_lift valid_irq_node_typ sts_only_idle
-              sts_ep_at_inv[simplified ep_at_def2, simplified] valid_ioports_lift
+              sts_typ_ats[simplified ep_at_def2, simplified] valid_ioports_lift
               failed_transfer_Q[unfolded do_nbrecv_failed_transfer_def, simplified]
               | simp add: live_def valid_ep_def do_nbrecv_failed_transfer_def
               | wpc)+
@@ -2970,7 +2970,7 @@ lemma rai_invs':
     apply (simp add: invs_def valid_state_def valid_pspace_def)
     apply (rule hoare_pre)
      apply (wp set_simple_ko_valid_objs valid_irq_node_typ sts_only_idle valid_ioports_lift
-              sts_ntfn_at_inv[simplified ntfn_at_def2, simplified] | wpc
+              sts_typ_ats[simplified ntfn_at_def2, simplified] | wpc
           | simp add: live_def valid_ntfn_def do_nbrecv_failed_transfer_def)+
     apply (clarsimp simp: valid_tcb_state_def st_tcb_at_tcb_at)
     apply (rule conjI, clarsimp elim!: obj_at_weakenE simp: is_ntfn_def)
@@ -2995,7 +2995,7 @@ lemma rai_invs':
    apply (simp add: invs_def valid_state_def valid_pspace_def)
    apply (rule hoare_pre)
     apply (wpsimp wp: set_simple_ko_valid_objs hoare_vcg_const_Ball_lift sts_only_idle valid_ioports_lift
-                      valid_irq_node_typ sts_ntfn_at_inv[simplified ntfn_at_def2, simplified]
+                      valid_irq_node_typ sts_typ_ats[simplified ntfn_at_def2, simplified]
                simp: live_def valid_ntfn_def do_nbrecv_failed_transfer_def)
    apply (clarsimp simp: valid_tcb_state_def st_tcb_at_tcb_at)
    apply (rule conjI, clarsimp elim!: obj_at_weakenE simp: is_ntfn_def)
@@ -3102,7 +3102,7 @@ context Ipc_AI_cont begin
 
 lemma si_invs':
   assumes set_endpoint_Q[wp]: "\<And>a b.\<lbrace>Q\<rbrace> set_endpoint a b \<lbrace>\<lambda>_.Q\<rbrace>"
-  assumes ext_Q[wp]: "\<And>a b. \<lbrace>Q and valid_objs\<rbrace> do_extended_op (possible_switch_to a) \<lbrace>\<lambda>_. Q\<rbrace>"
+  assumes ext_Q[wp]: "\<And>a. \<lbrace>Q and valid_objs\<rbrace> possible_switch_to a \<lbrace>\<lambda>_. Q\<rbrace>"
   assumes sts_Q[wp]: "\<And>a b. \<lbrace>Q\<rbrace> set_thread_state a b \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes setup_caller_cap_Q[wp]: "\<And>send receive grant. \<lbrace>Q and valid_mdb\<rbrace> setup_caller_cap send receive grant \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes do_ipc_transfer_Q[wp]: "\<And>a b c d e. \<lbrace>Q and valid_objs and valid_mdb\<rbrace> do_ipc_transfer a b c d e \<lbrace>\<lambda>_.Q\<rbrace>"
@@ -3119,10 +3119,11 @@ lemma si_invs':
      apply (simp add: invs_def valid_state_def valid_pspace_def)
      apply (wpsimp wp: valid_irq_node_typ valid_ioports_lift)
       apply (simp add: live_def valid_ep_def)
-      apply (wp valid_irq_node_typ sts_only_idle sts_ep_at_inv[simplified ep_at_def2, simplified])
+      apply (wp valid_irq_node_typ sts_only_idle sts_typ_ats[simplified ep_at_def2, simplified])
      apply (clarsimp simp: valid_tcb_state_def st_tcb_at_tcb_at)+
      apply (rule conjI, clarsimp elim!: obj_at_weakenE simp: is_ep_def)
      apply (rule conjI, clarsimp simp: st_tcb_at_reply_cap_valid)
+     apply (rule conjI, clarsimp simp: valid_ep_def pred_tcb_at_tcb_at)
      apply (rule conjI, subgoal_tac "t \<noteq> epptr")
        apply (drule ko_at_state_refs_ofD active_st_tcb_at_state_refs_ofD)+
        apply (erule delta_sym_refs)
@@ -3144,7 +3145,7 @@ lemma si_invs':
     apply (wpsimp wp: valid_irq_node_typ valid_ioports_lift)
     apply (simp add: live_def valid_ep_def)
     apply (wp hoare_vcg_const_Ball_lift valid_irq_node_typ sts_only_idle
-              sts_ep_at_inv[simplified ep_at_def2, simplified])
+              sts_typ_ats[simplified ep_at_def2, simplified])
     apply (clarsimp simp: valid_tcb_state_def st_tcb_at_tcb_at)
     apply (frule ko_at_state_refs_ofD)
     apply (frule active_st_tcb_at_state_refs_ofD)
@@ -3153,6 +3154,7 @@ lemma si_invs':
      apply (clarsimp simp: valid_obj_def valid_ep_def)
      apply (rule conjI, clarsimp simp: obj_at_def is_ep_def)
      apply (rule conjI, clarsimp simp: st_tcb_at_reply_cap_valid)
+     apply (rule conjI, clarsimp simp: pred_tcb_at_tcb_at)
      apply (rule conjI, erule delta_sym_refs)
        apply (fastforce split: if_split_asm)
       apply (fastforce simp: pred_tcb_at_def2
@@ -3216,7 +3218,7 @@ lemma si_invs':
 lemma hf_invs':
   assumes set_endpoint_Q[wp]: "\<And>a b.\<lbrace>Q\<rbrace> set_endpoint a b \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes sts_Q[wp]: "\<And>a b. \<lbrace>Q\<rbrace> set_thread_state a b \<lbrace>\<lambda>_.Q\<rbrace>"
-  assumes ext_Q[wp]: "\<And>a b. \<lbrace>Q and valid_objs\<rbrace> do_extended_op (possible_switch_to a) \<lbrace>\<lambda>_.Q\<rbrace>"
+  assumes ext_Q[wp]: "\<And>a. \<lbrace>Q and valid_objs\<rbrace> possible_switch_to a \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes setup_caller_cap_Q[wp]: "\<And>send receive grant. \<lbrace>Q and valid_mdb\<rbrace> setup_caller_cap send receive grant \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes do_ipc_transfer_Q[wp]: "\<And>a b c d e. \<lbrace>Q and valid_objs and valid_mdb\<rbrace> do_ipc_transfer a b c d e \<lbrace>\<lambda>_.Q\<rbrace>"
   assumes thread_set_Q[wp]: "\<And>a b. \<lbrace>Q\<rbrace> thread_set a b \<lbrace>\<lambda>_.Q\<rbrace>"
diff --git a/proof/invariant-abstract/KHeap_AI.thy b/proof/invariant-abstract/KHeap_AI.thy
index 81f0520c59..3039094d69 100644
--- a/proof/invariant-abstract/KHeap_AI.thy
+++ b/proof/invariant-abstract/KHeap_AI.thy
@@ -53,6 +53,9 @@ arch_requalify_facts
   state_hyp_refs_of_ntfn_update
   state_hyp_refs_of_tcb_state_update
   state_hyp_refs_of_tcb_bound_ntfn_update
+  state_hyp_refs_of_tcb_domain_update
+  state_hyp_refs_of_tcb_priority_update
+  state_hyp_refs_of_tcb_time_slice_update
   arch_valid_obj_same_type
   default_arch_object_not_live
   default_tcb_not_live
@@ -193,19 +196,15 @@ lemma dxo_wp_weak[wp]:
 crunch set_thread_state
   for ct[wp]: "\<lambda>s. P (cur_thread s)"
 
-lemma sts_ep_at_inv[wp]:
-  "\<lbrace> ep_at ep \<rbrace> set_thread_state t s \<lbrace> \<lambda>rv. ep_at ep \<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (wp | simp add: set_object_def)+
-  apply (clarsimp simp: obj_at_def is_ep is_tcb get_tcb_def)
-  done
+crunch set_scheduler_action, get_thread_state
+  for typ_at[wp]: "\<lambda>s. P (typ_at T p s)"
 
-lemma sts_ntfn_at_inv[wp]:
-  "\<lbrace> ntfn_at ep \<rbrace> set_thread_state t s \<lbrace> \<lambda>rv. ntfn_at ep \<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (wp | simp add: set_object_def)+
-  apply (clarsimp simp: obj_at_def is_ntfn is_tcb get_tcb_def)
-  done
+lemma set_thread_state_typ_at[wp]:
+  "\<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> set_thread_state t s \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
+  unfolding set_thread_state_def set_thread_state_act_def
+  by (wpsimp wp: set_object_typ_at)
+
+lemmas set_thread_state_typ_ats[wp] = abs_typ_at_lifts[OF set_thread_state_typ_at]
 
 lemma sbn_ep_at_inv[wp]:
   "\<lbrace> ep_at ep \<rbrace> set_bound_notification t ntfn \<lbrace> \<lambda>rv. ep_at ep \<rbrace>"
@@ -589,7 +588,7 @@ lemma ex_cte_cap_to_after_update:
      \<Longrightarrow> ex_cte_cap_wp_to P p (kheap_update (\<lambda>a b. if b = p' then Some val else kheap s b) s)"
   by (clarsimp simp: ex_cte_cap_wp_to_def cte_wp_at_after_update)
 
-lemma set_object_iflive:
+lemma set_object_iflive[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap s \<and>
         (live val \<longrightarrow> ex_nonz_cap_to p s) \<and> obj_at (same_caps val) p s\<rbrace>
    set_object p val
@@ -726,6 +725,18 @@ lemma cap_refs_respects_region_cong:
 
 lemmas device_region_congs[cong] = pspace_respects_region_cong cap_refs_respects_region_cong
 
+lemma invs_ready_queues_update[simp]:
+  "invs (ready_queues_update f s) = invs s"
+  by (simp add: invs_def valid_state_def)
+
+lemma invs_domain_time_update[simp]:
+  "invs (domain_time_update f s) = invs s"
+  by (simp add: invs_def valid_state_def)
+
+lemma invs_exst [iff]:
+  "invs (trans_state f s) = invs s"
+  by (simp add: invs_def valid_state_def)
+
 lemma dmo_invs1:
   assumes "\<And>P. f \<lbrace>\<lambda>ms. P (device_state ms)\<rbrace>"
   shows
@@ -899,12 +910,10 @@ lemma ep_redux_simps:
 
 crunch set_simple_ko
   for arch[wp]: "\<lambda>s. P (arch_state s)"
+  and irq_node_inv[wp]: "\<lambda>s. P (interrupt_irq_node s)"
+  and scheduler_action[wp]: "\<lambda>s. P (scheduler_action s)"
   (wp: crunch_wps simp: crunch_simps)
 
-crunch set_simple_ko
-  for irq_node_inv[wp]: "\<lambda>s. P (interrupt_irq_node s)"
-  (wp: crunch_wps)
-
 lemma set_simple_ko_global_refs [wp]:
   "set_simple_ko f ntfn p \<lbrace>valid_global_refs\<rbrace>"
   by (rule valid_global_refs_cte_lift; wpsimp)
@@ -1116,6 +1125,9 @@ locale non_aobj_non_cap_non_mem_op = non_aobj_non_mem_op f + non_aobj_non_cap_op
 
 sublocale non_aobj_non_cap_non_mem_op < non_vspace_non_cap_non_mem_op ..
 
+crunch set_thread_state_act
+  for caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
+
 lemma shows
   sts_caps_of_state[wp]:
     "set_thread_state t st \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace>" and
@@ -1143,6 +1155,12 @@ lemma
   apply (safe; erule rsubst[where P=P], rule cte_wp_caps_of_lift)
   by (auto simp: cte_wp_at_cases2 tcb_cnode_map_def dest!: get_tcb_SomeD)
 
+crunch set_thread_state_act
+  for obj_at[wp]: "\<lambda>s. P (obj_at P' p' s)"
+crunch set_thread_state
+  for arch_state[wp]: "\<lambda>s. P (arch_state s)"
+  and machine[wp]: "\<lambda>s. P (underlying_memory (machine_state s))"
+
 interpretation
   set_simple_ko: non_aobj_non_cap_non_mem_op "set_simple_ko c p ep" +
   sts: non_aobj_non_cap_non_mem_op "set_thread_state p st" +
@@ -1291,6 +1309,10 @@ lemma valid_irq_states_triv:
    apply assumption
   by blast
 
+lemma valid_irq_states_scheduler_action[simp]:
+  "valid_irq_states (s\<lparr>scheduler_action := x\<rparr>) = valid_irq_states s"
+  by (simp add: valid_irq_states_def)
+
 crunch set_simple_ko, set_cap, thread_set, set_thread_state, set_bound_notification
   for valid_irq_states[wp]: "valid_irq_states"
   (wp: crunch_wps simp: crunch_simps rule: valid_irq_states_triv)
diff --git a/proof/invariant-abstract/Retype_AI.thy b/proof/invariant-abstract/Retype_AI.thy
index 6091a83335..5a63754c91 100644
--- a/proof/invariant-abstract/Retype_AI.thy
+++ b/proof/invariant-abstract/Retype_AI.thy
@@ -16,7 +16,6 @@ abbreviation "up_aligned_area ptr sz \<equiv> {ptr..(ptr && ~~ mask sz) + (2 ^ s
 abbreviation "down_aligned_area ptr sz \<equiv> {(ptr && ~~ mask sz) + (2 ^ sz - 1) .. ptr}"
 
 arch_requalify_facts
-  global_refs_kheap
   valid_vspace_obj_default
 
 arch_requalify_consts
@@ -34,8 +33,8 @@ end
 
 
 lemma default_object_tcbE:
-  "\<lbrakk> default_object ty dev us = TCB tcb; ty \<noteq> Untyped;
-   \<lbrakk> tcb = default_tcb; ty = Structures_A.TCBObject \<rbrakk> \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
+  "\<lbrakk> default_object ty dev us d = TCB tcb; ty \<noteq> Untyped;
+   \<lbrakk> tcb = default_tcb d; ty = Structures_A.TCBObject \<rbrakk> \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
   unfolding default_object_def by (cases ty, auto)
 
 
@@ -47,20 +46,19 @@ locale Retype_AI_slot_bits =
 
 
 lemma (in Retype_AI_slot_bits) obj_bits_cong:
-  "\<lbrakk>a = a1; c=c1\<rbrakk> \<Longrightarrow> obj_bits (default_object a b c)
-    = obj_bits (default_object a1 b1 c1)"
+  "\<lbrakk>a = a1; c=c1\<rbrakk> \<Longrightarrow> obj_bits (default_object a b c d) = obj_bits (default_object a1 b1 c1 d1)"
   by (simp add: default_object_def arch_kobj_size_cong
          split: if_splits apiobject_type.splits)
 
 lemma (in Retype_AI_slot_bits) obj_bits_api_default_object:
-  "\<lbrakk> ty \<noteq> Untyped\<rbrakk> \<Longrightarrow> obj_bits_api ty us = obj_bits (default_object ty dev us)"
+  "\<lbrakk> ty \<noteq> Untyped\<rbrakk> \<Longrightarrow> obj_bits_api ty us = obj_bits (default_object ty dev us d)"
   unfolding obj_bits_api_def default_object_def
   by (cases ty)
      (simp_all add: slot_bits_def2 arch_kobj_size_cong wf_empty_bits)
 
 
 lemma obj_bits_api_default_CapTableObject:
-  "obj_bits (default_object Structures_A.apiobject_type.CapTableObject dev us)
+  "obj_bits (default_object Structures_A.apiobject_type.CapTableObject dev us d)
   = cte_level_bits + us"
   by (simp add: default_object_def wf_empty_bits)
 
@@ -75,7 +73,7 @@ context Retype_AI_slot_bits begin
 lemma obj_bits_api_def2:
   "obj_bits_api type obj_size_bits =
    (case type of Structures_A.Untyped \<Rightarrow> obj_size_bits
-           | _ \<Rightarrow> obj_bits (default_object type False obj_size_bits))"
+           | _ \<Rightarrow> obj_bits (default_object type False obj_size_bits default_domain))"
   by (simp add: obj_bits_api_def default_object_def
                 wf_empty_bits dom_empty_cnode ex_with_length
                 slot_bits_def2
@@ -84,7 +82,7 @@ lemma obj_bits_api_def2:
 lemma obj_bits_api_def3:
   "obj_bits_api type obj_size_bits =
    (if type = Structures_A.Untyped then obj_size_bits
-     else obj_bits (default_object type False obj_size_bits))"
+     else obj_bits (default_object type False obj_size_bits default_domain))"
   by (simp add: obj_bits_api_def default_object_def
                 wf_empty_bits dom_empty_cnode ex_with_length
                 slot_bits_def2
@@ -93,18 +91,18 @@ lemma obj_bits_api_def3:
 lemma obj_bits_api_def4:
   "obj_bits_api type obj_size_bits =
    (if type = Structures_A.Untyped then obj_size_bits
-     else obj_bits (default_object type True obj_size_bits))"
+     else obj_bits (default_object type True obj_size_bits default_domain))"
   by (simp add: obj_bits_api_def default_object_def arch_kobj_size_cong
                 wf_empty_bits dom_empty_cnode ex_with_length
                 slot_bits_def2
          split: apiobject_type.split)
 
 lemma obj_bits_dev_irr:
-  "ty \<noteq> Untyped \<Longrightarrow> obj_bits (default_object ty dev us) = obj_bits_api ty us"
+  "ty \<noteq> Untyped \<Longrightarrow> obj_bits (default_object ty dev us d) = obj_bits_api ty us"
   by (simp add: obj_bits_api_def3 cong: obj_bits_cong)
 
 lemma default_obj_range:
-  "ty \<noteq> Untyped \<Longrightarrow> obj_range p (default_object ty dev us) = {p..p + 2 ^ (obj_bits_api ty us) - 1}"
+  "ty \<noteq> Untyped \<Longrightarrow> obj_range p (default_object ty dev us d) = {p..p + 2 ^ (obj_bits_api ty us) - 1}"
   by (simp add: obj_range_def obj_bits_dev_irr)
 end
 
@@ -557,8 +555,8 @@ lemma mdb_cte_at_no_descendants:
 
 lemma caps_of_state_foldr:
   assumes tyun: "ty \<noteq> Untyped"
-  fixes s sz ptr us addrs dev
-  defines "s' \<equiv> (s\<lparr>kheap := foldr (\<lambda>p ps. ps(p \<mapsto> default_object ty dev us))
+  fixes s sz ptr us addrs dev d
+  defines "s' \<equiv> (s\<lparr>kheap := foldr (\<lambda>p ps. ps(p \<mapsto> default_object ty dev us d))
                   addrs (kheap s)\<rparr>)"
   shows
   "caps_of_state s' =
@@ -595,10 +593,10 @@ lemma caps_of_state_foldr:
 
 
 lemma null_filter_caps_of_state_foldr:
-  fixes s sz ptr us addrs dev
+  fixes s sz ptr us addrs dev d
   assumes tyun: "ty \<noteq> Untyped"
     and nondom: "\<forall>x \<in> set addrs. x \<notin> dom (kheap s)"
-  defines "s' \<equiv> (s\<lparr>kheap := foldr (\<lambda>p ps. ps(p \<mapsto> default_object ty dev us))
+  defines "s' \<equiv> (s\<lparr>kheap := foldr (\<lambda>p ps. ps(p \<mapsto> default_object ty dev us d))
                   addrs (kheap s)\<rparr>)"
   shows
   "null_filter (caps_of_state s') =
@@ -1166,18 +1164,11 @@ lemma obj_at_kheap_trans_state[simp]:"obj_at P ptr (kheap_update f (trans_state
 lemma retype_region_obj_at:
   assumes tyunt: "ty \<noteq> Structures_A.apiobject_type.Untyped"
   shows "\<lbrace>\<top>\<rbrace> retype_region ptr n us ty dev
-  \<lbrace>\<lambda>r s. \<forall>x \<in> set (retype_addrs ptr ty n us). obj_at (\<lambda>ko. ko = default_object ty dev us) x s\<rbrace>"
+  \<lbrace>\<lambda>r s. \<forall>x \<in> set (retype_addrs ptr ty n us). obj_at (\<lambda>ko. ko = default_object ty dev us (cur_domain s)) x s\<rbrace>"
   using tyunt unfolding retype_region_def
   apply (simp only: return_bind bind_return foldr_upd_app_if fun_app_def K_bind_def)
   apply wp
-  apply (simp only: obj_at_kheap_trans_state)
-  apply wp
-  apply (simp only: simp_thms if_True)
-  apply (rule ballI)
-  apply (subst retype_addrs_fold)
-  apply simp
-  apply (unfold obj_at_def)
-  apply clarsimp
+  apply (clarsimp simp: retype_addrs_fold obj_at_def)
   done
 
 
@@ -1261,19 +1252,19 @@ lemma retype_addrs_range_subset:
 context Retype_AI_slot_bits begin
 
 lemma retype_addrs_obj_range_subset:
-  "\<lbrakk>  p \<in> set (retype_addrs ptr ty n us);
-      range_cover ptr sz (obj_bits (default_object ty dev us)) n;
-  ty \<noteq> Untyped \<rbrakk>
-  \<Longrightarrow> obj_range p (default_object ty dev us) \<subseteq> {ptr..(ptr && ~~ mask sz) + (2^sz - 1)}"
-  by(simp add: obj_range_def obj_bits_api_default_object[symmetric]
+  "\<lbrakk> p \<in> set (retype_addrs ptr ty n us);
+     range_cover ptr sz (obj_bits (default_object ty dev us d)) n;
+     ty \<noteq> Untyped \<rbrakk>
+   \<Longrightarrow> obj_range p (default_object ty dev us d') \<subseteq> {ptr..(ptr && ~~ mask sz) + (2^sz - 1)}"
+  by (simp add: obj_range_def obj_bits_api_default_object[symmetric]
                 retype_addrs_range_subset p_assoc_help[symmetric]
            del: atLeastatMost_subset_iff)
 
 lemma retype_addrs_obj_range_subset_strong:
   "\<lbrakk> p \<in> set (retype_addrs ptr ty n us);
-    range_cover ptr sz (obj_bits_api ty us) n;
-  ty \<noteq> Untyped \<rbrakk>
-   \<Longrightarrow> obj_range p (default_object ty dev us) \<subseteq>  {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}"
+     range_cover ptr sz (obj_bits_api ty us) n;
+     ty \<noteq> Untyped \<rbrakk>
+   \<Longrightarrow> obj_range p (default_object ty dev us d) \<subseteq>  {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}"
   unfolding obj_range_def
   apply (frule retype_addrs_obj_range_subset)
    apply (simp add:obj_bits_dev_irr)
@@ -1292,13 +1283,13 @@ lemma retype_addrs_obj_range_subset_strong:
     have unat_of_nat_m1: "unat (of_nat n - (1::machine_word)) < n"
       using not_0 n_less
        by (simp add:unat_of_nat_minus_1)
-    have decomp:"of_nat n * 2 ^ obj_bits_api ty us = of_nat (n - 1) * 2 ^ (obj_bits (default_object ty dev us))
-      + (2 :: machine_word) ^ obj_bits (default_object ty dev us)"
+    have decomp:"of_nat n * 2 ^ obj_bits_api ty us = of_nat (n - 1) * 2 ^ (obj_bits (default_object ty dev us d))
+      + (2 :: machine_word) ^ obj_bits (default_object ty dev us d)"
       apply (simp add:distrib_right[where b = "1::'a::len word",simplified,symmetric])
       using not_0 n_less
       apply (simp add: unat_of_nat_minus_1 obj_bits_api_def3 tyunt cong: obj_bits_cong)
       done
-    show  "p + 2 ^ obj_bits (default_object ty dev us) - 1 \<le> ptr + of_nat n * 2 ^ obj_bits_api ty us - 1"
+    show  "p + 2 ^ obj_bits (default_object ty dev us d) - 1 \<le> ptr + of_nat n * 2 ^ obj_bits_api ty us - 1"
       using cover
       apply (subst decomp)
       apply (simp add:add.assoc[symmetric])
@@ -1326,7 +1317,7 @@ lemma retype_addrs_obj_range_subset_strong:
           apply (clarsimp simp:unat_of_nat_m1)
          apply (simp add:range_cover_def word_bits_def)
         apply (rule olen_add_eqv[THEN iffD2])
-        apply (subst add.commute[where a = "2^(obj_bits (default_object ty dev us)) - 1"])
+        apply (subst add.commute[where a = "2^(obj_bits (default_object ty dev us d)) - 1"])
         apply (subst p_assoc_help[symmetric])
         apply (rule is_aligned_no_overflow)
         apply (insert cover)
@@ -1354,9 +1345,9 @@ lemma pspace_no_overlap_retype_addrs_empty:
   and tyv: "ty \<noteq> Structures_A.apiobject_type.Untyped"
   and cover: "range_cover ptr sz (obj_bits_api ty us) n"
   and oab: "obj_bits_api ty us \<le> sz"
-  shows "{x..x + (2 ^ obj_bits (default_object ty dev us) - 1)} \<inter> {y..y + (2 ^ obj_bits ko - 1)} = {}"
+  shows "{x..x + (2 ^ obj_bits (default_object ty dev us d) - 1)} \<inter> {y..y + (2 ^ obj_bits ko - 1)} = {}"
 proof -
-  have "{x..x + (2 ^ obj_bits (default_object ty dev us) - 1)} \<subseteq> {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)}"
+  have "{x..x + (2 ^ obj_bits (default_object ty dev us d) - 1)} \<subseteq> {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)}"
    by (subst obj_bits_api_default_object [OF tyv, symmetric],
       rule retype_addrs_mem_subset_ptr_bits) fact+
 
@@ -1373,7 +1364,7 @@ lemma valid_obj_default_object:
   assumes tyunt: "ty \<noteq> Untyped"
   and      tyct: "ty = CapTableObject \<Longrightarrow> us < word_bits - cte_level_bits \<and> 0 < us"
   and      arch: "valid_arch_tcb default_arch_tcb s"
-  shows "valid_obj ptr (default_object ty dev us) s"
+  shows "valid_obj ptr (default_object ty dev us d) s"
   unfolding valid_obj_def default_object_def
   apply (cases ty)
        apply (simp add: tyunt)
@@ -1428,7 +1419,7 @@ locale Retype_AI_valid_untyped_helper =
         valid_pspace s \<rbrakk>
       \<Longrightarrow> valid_cap c
            (s\<lparr>kheap := \<lambda>x. if x \<in> set (retype_addrs ptr ty n us)
-                             then Some (default_object ty dev us)
+                             then Some (default_object ty dev us (cur_domain s))
                              else kheap s x\<rparr>)"
 
 
@@ -1455,7 +1446,7 @@ locale retype_region_proofs =
       and  mem :  "caps_no_overlap ptr sz s"
       and cover: "range_cover ptr sz (obj_bits_api ty us) n"
       and dev: "\<exists>slot. cte_wp_at (\<lambda>c.  {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s"
-  defines "ps \<equiv> (\<lambda>x. if x \<in> set (retype_addrs ptr ty n us) then Some (default_object ty dev us)
+  defines "ps \<equiv> (\<lambda>x. if x \<in> set (retype_addrs ptr ty n us) then Some (default_object ty dev us (cur_domain s))
                        else kheap s x)"
       and "s' \<equiv> kheap_update (\<lambda>y. ps) s"
 
@@ -1505,8 +1496,9 @@ end
 context retype_region_proofs_gen begin
 
 lemma psp_dist:
-  shows         "pspace_distinct s'"
+  shows "pspace_distinct s'"
 proof -
+  define cur_d where "cur_d = cur_domain s"
   have distinct:"pspace_distinct s"
     apply (rule valid_pspaceE)
     apply (rule vp)
@@ -1531,8 +1523,8 @@ proof -
       apply (auto simp: range_cover_def word_bits_def)
       done
     ultimately have
-      "{x..x + (2 ^ obj_bits (default_object ty dev us) - 1)} \<inter>
-       {y..y + (2 ^ obj_bits (default_object ty dev us) - 1)} = {}"
+      "{x..x + (2 ^ obj_bits (default_object ty dev us cur_d) - 1)} \<inter>
+       {y..y + (2 ^ obj_bits (default_object ty dev us cur_d) - 1)} = {}"
       using xne tyunt cover
       apply -
       apply (rule aligned_neq_into_no_overlap)
@@ -1544,7 +1536,7 @@ proof -
     fix x y ko'
     assume xne: "x \<noteq> y" and xv: "x \<in> set (retype_addrs ptr ty n us)"
         and yv: "y \<notin> set (retype_addrs ptr ty n us)" and  "kheap s y = Some ko'"
-    have "{x..x + (2 ^ obj_bits (default_object ty dev us) - 1)} \<inter> {y..y + (2 ^ obj_bits ko' - 1)} = {}"
+    have "{x..x + (2 ^ obj_bits (default_object ty dev us cur_d) - 1)} \<inter> {y..y + (2 ^ obj_bits ko' - 1)} = {}"
       apply (rule pspace_no_overlap_retype_addrs_empty [OF orth])
       apply fact+
       apply (insert cover tyunt)
@@ -1553,6 +1545,7 @@ proof -
   }note inter' = this
   show ?thesis
     unfolding pspace_distinct_def s'_def ps_def
+    apply (fold cur_d_def)
     apply (clarsimp split: if_split_asm option.splits
               simp del: Int_atLeastAtMost)
     apply (intro conjI impI allI)
@@ -1580,7 +1573,7 @@ lemma psp_al:
 proof (clarsimp split: if_split_asm)
   fix x
   assume "x \<in> set (retype_addrs ptr ty n us)"
-  thus "is_aligned x (obj_bits (default_object ty dev us))"
+  thus "is_aligned x (obj_bits (default_object ty dev us (cur_domain s)))"
     apply -
     apply (drule retype_addrs_aligned)
     apply (insert cover tyunt)
@@ -1689,7 +1682,8 @@ lemma cte_retype:
 
 lemma iflive_s: "if_live_then_nonz_cap s" by (rule valid_pspaceE [OF vp])
 
-lemma default_object_not_live: "\<not> live (default_object ty dev us)"
+lemma default_object_not_live:
+  "\<not> live (default_object ty dev us d)"
   apply (cases ty, simp_all add: tyunt default_object_def default_tcb_not_live default_arch_object_not_live)
   apply (simp add: live_def default_ep_def default_notification_def default_ntfn_def)+
   done
@@ -1877,7 +1871,7 @@ lemma only_idle:
   apply (clarsimp simp: only_idle_def)
   apply (clarsimp simp: s'_def pred_tcb_at_def obj_at_def ps_def split: if_split_asm)
   apply (simp add: default_object_def tyunt split: Structures_A.apiobject_type.splits)
-  apply (simp add: default_tcb_def)
+  apply (clarsimp simp: default_tcb_def)
   done
 
 lemma valid_irq_states:
@@ -1922,7 +1916,7 @@ lemma use_retype_region_proofs':
   assumes x: "\<And>s. \<lbrakk> retype_region_proofs s ty us ptr sz n dev; P s \<rbrakk>
    \<Longrightarrow> Q (retype_addrs ptr ty n us) (s\<lparr>kheap :=
            \<lambda>x. if x \<in> set (retype_addrs ptr ty n us)
-             then Some (default_object ty dev us)
+             then Some (default_object ty dev us (cur_domain s))
              else kheap s x\<rparr>)"
   assumes y: "\<And>x s f. Q x (trans_state f s) = Q x s"
   shows
@@ -2116,14 +2110,9 @@ lemma retype_region_cte_at_other:
   unfolding retype_region_def
   apply (simp only: foldr_upd_app_if fun_app_def K_bind_def)
   apply wp
-      apply (simp only: cte_wp_at_trans_state)
-      apply wp+
-  apply (subst retype_addrs_fold)
-  apply clarsimp
-  apply (clarsimp simp: cte_wp_at_cases del: disjCI)
-  apply (erule disjEI)
-   apply (auto dest!: pspace_no_overlapD1[OF _ _ cover])
-done
+  apply (clarsimp simp: cte_wp_at_cases retype_addrs_fold del: disjCI)
+  apply (auto dest!: pspace_no_overlapD1[OF _ _ cover])
+  done
 
 
 lemma retype_cte_wp_at:
diff --git a/proof/invariant-abstract/Schedule_AI.thy b/proof/invariant-abstract/Schedule_AI.thy
index 7f6e8cd564..7c1b28dc14 100644
--- a/proof/invariant-abstract/Schedule_AI.thy
+++ b/proof/invariant-abstract/Schedule_AI.thy
@@ -23,10 +23,14 @@ locale Schedule_AI =
       "\<And>t'. \<lbrace>invs\<rbrace> arch_switch_to_thread t' \<lbrace>\<lambda>_. (invs :: 'a state \<Rightarrow> bool)\<rbrace>"
     assumes arch_stt_tcb [wp]:
       "\<And>t'. \<lbrace>tcb_at t'\<rbrace> arch_switch_to_thread t' \<lbrace>\<lambda>_. (tcb_at t' :: 'a state \<Rightarrow> bool)\<rbrace>"
-    assumes arch_stt_runnable:
-      "\<And>t. \<lbrace>st_tcb_at runnable t\<rbrace> arch_switch_to_thread t \<lbrace>\<lambda>r . (st_tcb_at runnable t :: 'a state \<Rightarrow> bool)\<rbrace>"
+    assumes arch_stt_st_tcb_at:
+      "\<And>t. arch_switch_to_thread t \<lbrace>st_tcb_at Q t :: 'a state \<Rightarrow> bool\<rbrace>"
+    assumes arch_stt_scheduler_action[wp]:
+      "\<And>t'. arch_switch_to_thread t' \<lbrace>\<lambda>s::'a state. P (scheduler_action s)\<rbrace>"
     assumes stit_invs [wp]:
       "\<lbrace>invs\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>rv. (invs :: 'a state \<Rightarrow> bool)\<rbrace>"
+    assumes arch_stit_scheduler_action[wp]:
+      "\<And>t'. arch_switch_to_idle_thread \<lbrace>\<lambda>s::'a state. P (scheduler_action s)\<rbrace>"
     assumes stit_activatable:
       "\<lbrace>invs\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>rv . (ct_in_state activatable :: 'a state \<Rightarrow> bool)\<rbrace>"
 
@@ -58,11 +62,6 @@ lemma findM_inv:
   by (rule findM_inv', simp_all add: x)
 
 
-lemma allActiveTCBs_gets:
-  "allActiveTCBs = gets (\<lambda>state. {x. getActiveTCB x state \<noteq> None})"
-  by (simp add: allActiveTCBs_def gets_def)
-
-
 lemma postfix_tails:
   "\<lbrakk> suffix (xs # ys) (tails zs) \<rbrakk>
      \<Longrightarrow> suffix xs zs \<and> (xs # ys) = tails xs"
@@ -80,15 +79,6 @@ lemma postfix_tails:
   done
 
 
-lemma valid_irq_states_cur_thread_update[simp]:
-  "valid_irq_states (cur_thread_update f s) = valid_irq_states s"
-  by(simp add: valid_irq_states_def)
-
-lemma sct_invs:
-  "\<lbrace>invs and tcb_at t\<rbrace> modify (cur_thread_update (%_. t)) \<lbrace>\<lambda>rv. invs\<rbrace>"
-  by wp (clarsimp simp add: invs_def cur_tcb_def valid_state_def valid_idle_def
-                            valid_irq_node_def valid_machine_state_def)
-
 lemma storeWord_valid_irq_states:
   "\<lbrace>\<lambda>m. valid_irq_states (s\<lparr>machine_state := m\<rparr>)\<rbrace> storeWord x y
    \<lbrace>\<lambda>a b. valid_irq_states (s\<lparr>machine_state := b\<rparr>)\<rbrace>"
@@ -112,41 +102,21 @@ lemma dmo_kheap_arch_state[wp]:
 lemmas do_machine_op_tcb[wp] =
   do_machine_op_obj_at[where P=id and Q=is_tcb, simplified]
 
+
 lemma (in Schedule_AI) stt_tcb [wp]:
   "\<lbrace>tcb_at t\<rbrace> switch_to_thread t \<lbrace>\<lambda>_. (tcb_at t :: 'a state \<Rightarrow> bool)\<rbrace>"
   apply (simp add: switch_to_thread_def)
   apply (wp | simp)+
-   done
-
-(* FIXME - Move Invariants_AI *)
-lemma invs_exst [iff]:
-  "invs (trans_state f s) = invs s"
-  by (simp add: invs_def valid_state_def)
-
-lemma (in Schedule_AI) stt_invs [wp]:
-  "\<lbrace>invs :: 'a state \<Rightarrow> bool\<rbrace> switch_to_thread t' \<lbrace>\<lambda>_. invs\<rbrace>"
-  apply (simp add: switch_to_thread_def)
-  apply wp
-     apply (simp add: trans_state_update[symmetric] del: trans_state_update)
-    apply (rule_tac Q'="\<lambda>_. invs and tcb_at t'" in hoare_strengthen_post, wp)
-    apply (clarsimp simp: invs_def valid_state_def valid_idle_def
-                          valid_irq_node_def valid_machine_state_def)
-    apply (fastforce simp: cur_tcb_def obj_at_def
-                     elim: valid_pspace_eqI ifunsafe_pspaceI)
-   apply wp+
-  apply clarsimp
-  apply (simp add: is_tcb_def)
   done
 
 lemma (in Schedule_AI) stt_activatable:
   "\<lbrace>st_tcb_at runnable t\<rbrace> switch_to_thread t \<lbrace>\<lambda>rv . (ct_in_state activatable :: 'a state \<Rightarrow> bool) \<rbrace>"
   apply (simp add: switch_to_thread_def)
   apply (wp | simp add: ct_in_state_def)+
-     apply (rule hoare_post_imp [OF _ arch_stt_runnable])
-     apply (clarsimp elim!: pred_tcb_weakenE)
+     apply (rule hoare_post_imp [OF _ arch_stt_st_tcb_at], assumption)
     apply (rule assert_inv)
-   apply wp
-  apply assumption
+   apply (wpsimp wp: hoare_drop_imp)
+  apply (clarsimp simp: pred_tcb_weakenE)
   done
 
 
@@ -168,48 +138,4 @@ lemma OR_choice_weak_wp:
           split: option.splits if_split_asm)
   done
 
-locale Schedule_AI_U = Schedule_AI "TYPE(unit)"
-
-lemma (in Schedule_AI_U) schedule_invs[wp]:
-  "\<lbrace>invs\<rbrace> (Schedule_A.schedule :: (unit,unit) s_monad) \<lbrace>\<lambda>rv. invs\<rbrace>"
-  apply (simp add: Schedule_A.schedule_def allActiveTCBs_def)
-  apply (wp OR_choice_weak_wp dmo_invs thread_get_inv
-            do_machine_op_tcb select_ext_weak_wp when_def
-          | clarsimp simp: getActiveTCB_def get_tcb_def)+
-  done
-
-(* FIXME - move *)
-lemma get_tcb_exst_update:
-  "get_tcb p (trans_state f s) = get_tcb p s"
-  by (simp add: get_tcb_def)
-
-lemma ct_in_state_trans_update[simp]: "ct_in_state st (trans_state f s) = ct_in_state st s"
-  apply (simp add: ct_in_state_def)
-  done
-
-lemma (in Schedule_AI_U) schedule_ct_activateable[wp]:
-  "\<lbrace>invs\<rbrace> (Schedule_A.schedule :: (unit,unit) s_monad) \<lbrace>\<lambda>rv. ct_in_state activatable \<rbrace>"
-  proof -
-  have P: "\<And>t s. ct_in_state activatable (cur_thread_update (\<lambda>_. t) s) = st_tcb_at activatable t s"
-    by (fastforce simp: ct_in_state_def pred_tcb_at_def intro: obj_at_pspaceI)
-  have Q: "\<And>s. invs s \<longrightarrow> idle_thread s = cur_thread s \<longrightarrow> ct_in_state activatable s"
-    apply (clarsimp simp: ct_in_state_def dest!: invs_valid_idle)
-    apply (clarsimp simp: valid_idle_def pred_tcb_def2)
-    done
-  show ?thesis
-    apply (simp add: Schedule_A.schedule_def allActiveTCBs_def)
-    apply (wp select_ext_weak_wp stt_activatable stit_activatable
-           | simp add: P Q)+
-    apply (clarsimp simp: getActiveTCB_def ct_in_state_def)
-    apply (rule conjI)
-     apply clarsimp
-     apply (case_tac "get_tcb (cur_thread s) s", simp_all add: ct_in_state_def)
-     apply (drule get_tcb_SomeD)
-     apply (clarsimp simp: pred_tcb_at_def obj_at_def split: if_split_asm)
-    apply (case_tac "get_tcb x s", simp_all)
-    apply (drule get_tcb_SomeD)
-    apply (clarsimp simp: pred_tcb_at_def obj_at_def split: if_split_asm)
-    done
-qed
-
 end
diff --git a/proof/invariant-abstract/Syscall_AI.thy b/proof/invariant-abstract/Syscall_AI.thy
index 0ca9ec7b79..704b1a22d8 100644
--- a/proof/invariant-abstract/Syscall_AI.thy
+++ b/proof/invariant-abstract/Syscall_AI.thy
@@ -45,37 +45,89 @@ lemmas [wp] =
 lemmas [simp] =
   data_to_cptr_def
 
-crunch ethread_get, ethread_get_when
-  for inv[wp]: P
 
-lemma schedule_invs[wp]: "\<lbrace>invs\<rbrace> (Schedule_A.schedule :: (unit,det_ext) s_monad) \<lbrace>\<lambda>rv. invs\<rbrace>"
-  supply if_split[split del]
-  apply (simp add: Schedule_A.schedule_def)
-  apply (wp dmo_invs thread_get_inv gts_wp
-            do_machine_op_tcb when_def hoare_vcg_all_lift
-          | wpc
-          | clarsimp simp: guarded_switch_to_def get_tcb_def choose_thread_def ethread_get_def
-                           ethread_get_when_def
-          | wp (once) hoare_drop_imps
-          | simp add: schedule_choose_new_thread_def if_apply_def2)+
+crunch next_domain
+  for scheduler_action[wp]: "\<lambda>s. P (scheduler_action s)"
+  and valid_idle[wp]: valid_idle
+  (simp: crunch_simps)
+
+lemma next_domain_invs[wp]:
+  "next_domain \<lbrace> invs \<rbrace>"
+  unfolding next_domain_def
+  apply (wpsimp simp: Let_def)
+  apply (simp add: invs_def cur_tcb_def valid_state_def
+                   valid_mdb_def mdb_cte_at_def valid_ioc_def valid_irq_states_def
+                   valid_machine_state_def)
   done
 
-lemma schedule_choose_new_thread_ct_activatable[wp]:
-  "\<lbrace> invs \<rbrace> schedule_choose_new_thread \<lbrace>\<lambda>_. ct_in_state activatable \<rbrace>"
-  proof -
+crunch tcb_sched_action
+  for cur_thread[wp]: "\<lambda>s. P (cur_thread s)"
+  and scheduler_action[wp]: "\<lambda>s. P (scheduler_action s)"
+  (simp: crunch_simps)
+
+lemma cur_thread_update_invs:
+  "\<lbrace>\<lambda>s. invs s \<and> scheduler_action s \<noteq> resume_cur_thread \<and> tcb_at tptr s\<rbrace>
+   modify (cur_thread_update (\<lambda>_. tptr))
+   \<lbrace>\<lambda>_. invs\<rbrace>"
+  by (wpsimp simp: invs_def valid_state_def valid_pspace_def valid_machine_state_def
+                   state_refs_of_def cur_tcb_def)
+
+lemma switch_to_thread_invs:
+  "\<lbrace>\<lambda>s. invs s \<and> scheduler_action s \<noteq> resume_cur_thread\<rbrace>
+   switch_to_thread tptr
+   \<lbrace>\<lambda>_. invs\<rbrace>"
+  by (wpsimp simp: switch_to_thread_def thread_get_def is_tcb
+               wp: cur_thread_update_invs)
+
+lemma guarded_switch_to_invs:
+  "\<lbrace>\<lambda>s. invs s \<and> scheduler_action s \<noteq> resume_cur_thread\<rbrace>
+   guarded_switch_to thread
+   \<lbrace>\<lambda>_. invs\<rbrace>"
+  by (wpsimp simp: guarded_switch_to_def
+               wp: switch_to_thread_invs hoare_drop_imps)
+
+(* still true without scheduler_action s \<noteq> resume_cur_thread, but the proof for schedule_invs
+   will be simpler with it *)
+lemma schedule_choose_new_thread_valid_state_cur_tcb [wp]:
+  "\<lbrace>\<lambda>s. invs s \<and> scheduler_action s \<noteq> resume_cur_thread\<rbrace>
+   schedule_choose_new_thread
+   \<lbrace>\<lambda>_ s. invs s\<rbrace>"
+  by (wpsimp simp: schedule_choose_new_thread_def choose_thread_def
+               wp: guarded_switch_to_invs hoare_drop_imps)
+
+lemma schedule_invs[wp]:
+  "schedule \<lbrace>invs\<rbrace>"
+  apply (simp add: schedule_def)
+  apply (wpsimp wp: switch_to_thread_invs guarded_switch_to_invs hoare_drop_imps
+              simp: if_apply_def2 set_scheduler_action_def)
+  done
+
+lemma invs_domain_index_update[simp]:
+  "invs (domain_index_update f s) = invs s"
+  by (simp add: invs_def valid_state_def valid_mdb_def mdb_cte_at_def valid_ioc_def
+                valid_irq_states_def valid_machine_state_def cur_tcb_def)
+
+lemma invs_cur_domain_update[simp]:
+  "invs (cur_domain_update f s) = invs s"
+  by (simp add: invs_def valid_state_def valid_mdb_def mdb_cte_at_def valid_ioc_def
+                valid_irq_states_def valid_machine_state_def cur_tcb_def)
+
+lemma choose_thread_ct_activatable[wp]:
+  "\<lbrace> invs \<rbrace> choose_thread \<lbrace>\<lambda>_. ct_in_state activatable \<rbrace>"
+proof -
   have P: "\<And>t s. ct_in_state activatable (cur_thread_update (\<lambda>_. t) s) = st_tcb_at activatable t s"
     by (fastforce simp: ct_in_state_def st_tcb_at_def intro: obj_at_pspaceI)
   show ?thesis
-  unfolding schedule_choose_new_thread_def choose_thread_def guarded_switch_to_def
-    apply (simp add: P set_scheduler_action_def guarded_switch_to_def choose_thread_def
-                             next_domain_def Let_def tcb_sched_action_def set_tcb_queue_def
-                             get_tcb_queue_def ethread_get_def bind_assoc)
-    apply (wpsimp wp: stt_activatable stit_activatable gts_wp)+
-    apply (force simp: ct_in_state_def pred_tcb_at_def obj_at_def invs_def valid_state_def
-                       valid_idle_def split: if_split_asm)+
-  done
+    unfolding choose_thread_def guarded_switch_to_def
+    apply (wpsimp wp: stit_activatable stt_activatable gts_wp)
+    apply (clarsimp simp:  pred_tcb_at_def obj_at_def)
+    done
 qed
 
+lemma schedule_choose_new_thread_ct_activatable[wp]:
+  "\<lbrace> invs \<rbrace> schedule_choose_new_thread \<lbrace>\<lambda>_. ct_in_state activatable \<rbrace>"
+    unfolding schedule_choose_new_thread_def by wpsimp
+
 lemma guarded_switch_to_ct_in_state_activatable[wp]:
   "\<lbrace>\<top>\<rbrace> guarded_switch_to t \<lbrace>\<lambda>a. ct_in_state activatable\<rbrace>"
   unfolding guarded_switch_to_def
@@ -85,7 +137,7 @@ lemma guarded_switch_to_ct_in_state_activatable[wp]:
   done
 
 lemma schedule_ct_activateable[wp]:
-  "\<lbrace>invs\<rbrace> (Schedule_A.schedule :: (unit,det_ext) s_monad) \<lbrace>\<lambda>rv. ct_in_state activatable\<rbrace>"
+  "\<lbrace>invs\<rbrace> schedule \<lbrace>\<lambda>rv. ct_in_state activatable\<rbrace>"
   apply (simp add: Schedule_A.schedule_def)
   apply wp
       apply wpc
@@ -95,9 +147,10 @@ lemma schedule_ct_activateable[wp]:
        (* choose new thread *)
        apply wp
       (* switch to thread *)
-      apply wpsimp
-              apply (simp add: set_scheduler_action_def)
-              apply (simp | wp gts_wp | wp (once) hoare_drop_imps)+
+      apply (wpsimp simp: schedule_switch_thread_fastfail_def tcb_sched_action_def
+                          set_tcb_queue_def get_tcb_queue_def
+                      wp: thread_get_wp')
+     apply (wp gts_wp | wp (once) hoare_drop_imps)+
   apply (frule invs_valid_idle)
   apply (clarsimp simp: ct_in_state_def pred_tcb_at_def obj_at_def valid_idle_def)
   done
@@ -576,13 +629,7 @@ lemma sts_mcpriority_tcb_at[wp]:
 
 lemma sts_mcpriority_tcb_at_ct[wp]:
   "\<lbrace>\<lambda>s. mcpriority_tcb_at P (cur_thread s) s\<rbrace> set_thread_state p ts \<lbrace>\<lambda>rv s. mcpriority_tcb_at P (cur_thread s) s\<rbrace>"
-  apply (simp add: set_thread_state_def set_object_def get_object_def)
-  apply (wp | simp)+
-  apply (clarsimp simp: pred_tcb_at_def obj_at_def)
-  apply (drule get_tcb_SomeD)
-  apply clarsimp
-  done
-
+  by (wpsimp | wps)+
 
 lemma sts_tcb_inv_wf [wp]:
   "\<lbrace>tcb_inv_wf i\<rbrace> set_thread_state t st \<lbrace>\<lambda>rv. tcb_inv_wf i\<rbrace>"
@@ -1161,10 +1208,9 @@ lemma null_cap_on_failure_wp[wp]:
 
 crunch_ignore (add:null_cap_on_failure)
 
-lemma hy_inv: "(\<And>s f. P (trans_state f s) = P s) \<Longrightarrow> \<lbrace>P\<rbrace> handle_yield \<lbrace>\<lambda>rv. P\<rbrace>"
+lemma hy_invs[wp]: "handle_yield \<lbrace>invs\<rbrace>"
   apply (simp add: handle_yield_def)
-  apply (wp | simp)+
-  done
+  by wpsimp
 
 lemma ct_active_simple [elim!]:
   "ct_active s \<Longrightarrow> st_tcb_at simple (cur_thread s) s"
@@ -1231,11 +1277,6 @@ lemma tcb_state_If_valid[simp]:
       = \<top>"
   by (rule ext, simp add: valid_tcb_state_def)
 
-lemma drop_when_dxo_wp: "(\<And>f s. P (trans_state f s) = P s ) \<Longrightarrow> \<lbrace>P\<rbrace> when b (do_extended_op e) \<lbrace>\<lambda>_.P\<rbrace>"
-  apply (clarsimp simp add: when_def)
-  apply (wp | simp)+
-  done
-
 context Syscall_AI begin
 
 lemma do_reply_transfer_nonz_cap:
@@ -1251,7 +1292,7 @@ lemma do_reply_transfer_nonz_cap:
        apply (clarsimp simp add: tcb_cap_cases_def is_cap_simps can_fast_finalise_def)
       apply (strengthen ex_tcb_cap_to_tcb_at_strg)
 
-      apply (wp drop_when_dxo_wp hoare_vcg_ex_lift
+      apply (wp hoare_when_weak_wp hoare_vcg_ex_lift
              thread_set_no_change_tcb_state thread_set_cte_wp_at_trivial
              ex_nonz_cap_to_pres [OF thread_set_cte_wp_at_trivial]
              | simp add: tcb_cap_cases_def)+
@@ -1293,7 +1334,7 @@ lemma do_reply_transfer_st_tcb_at_active:
     do_reply_transfer t t' sl grant
    \<lbrace>\<lambda>rv. st_tcb_at active t :: 'state_ext state \<Rightarrow> _\<rbrace>"
   apply (simp add: do_reply_transfer_def is_reply_cap_to_def)
-  apply (wp drop_when_dxo_wp sts_st_tcb_at' sts_st_tcb_at_neq cap_delete_one_reply_st_tcb_at
+  apply (wp hoare_when_weak_wp sts_st_tcb_at' sts_st_tcb_at_neq cap_delete_one_reply_st_tcb_at
             hoare_drop_imps thread_set_no_change_tcb_state
             do_ipc_transfer_non_null_cte_wp_at2
        | wpc | clarsimp simp: is_reply_cap_to_def)+
@@ -1335,7 +1376,7 @@ lemma he_invs[wp]:
   apply (case_tac e, simp_all)
       apply (rename_tac syscall)
       apply (case_tac syscall, simp_all)
-      apply (((rule hoare_pre, wp hvmf_active hr_invs hy_inv ) |
+      apply (((rule hoare_pre, wp hvmf_active hr_invs  ) |
                  wpc | wp hoare_drop_imps hoare_vcg_all_lift |
                  simp add: if_apply_def2 |
                  fastforce simp: tcb_at_invs ct_in_state_def valid_fault_def
@@ -1379,11 +1420,11 @@ lemma fast_finalise_sym_refs:
   done
 
 crunch empty_slot
-  for state_refs_of[wp]: "\<lambda>s::det_ext state. P (state_refs_of s)"
+  for state_refs_of[wp]: "\<lambda>s. P (state_refs_of s)"
   (wp: crunch_wps simp: crunch_simps interrupt_update.state_refs_update)
 
 lemma delete_caller_cap_sym_refs:
-  "\<lbrace>invs\<rbrace> delete_caller_cap t \<lbrace>\<lambda>rv s::det_ext state. sym_refs (state_refs_of s) \<rbrace>"
+  "\<lbrace>invs\<rbrace> delete_caller_cap t \<lbrace>\<lambda>rv s. sym_refs (state_refs_of s) \<rbrace>"
   apply (simp add: delete_caller_cap_def cap_delete_one_def unless_def)
   apply (wp fast_finalise_sym_refs get_cap_wp)
   apply fastforce
@@ -1483,7 +1524,7 @@ lemma delete_caller_cap_runnable[wp]:
 
 lemma handle_recv_st_tcb_at:
   "\<lbrace>invs and st_tcb_at runnable t and (\<lambda>s. cur_thread s \<noteq> t)\<rbrace> handle_recv True
-  \<lbrace>\<lambda>rv s::det_ext state. st_tcb_at runnable t s\<rbrace>"
+  \<lbrace>\<lambda>rv s. st_tcb_at runnable t s\<rbrace>"
   apply (simp add: handle_recv_def Let_def ep_ntfn_cap_case_helper
              cong: if_cong)
   apply (rule hoare_pre)
diff --git a/proof/invariant-abstract/TcbAcc_AI.thy b/proof/invariant-abstract/TcbAcc_AI.thy
index 57c2351394..698222be9a 100644
--- a/proof/invariant-abstract/TcbAcc_AI.thy
+++ b/proof/invariant-abstract/TcbAcc_AI.thy
@@ -15,9 +15,12 @@ arch_requalify_facts
   user_getreg_inv
   set_cap_valid_arch_caps_simple
   set_cap_kernel_window_simple
+  global_refs_kheap
 
 declare user_getreg_inv[wp]
 
+declare global_refs_kheap[simp]
+
 locale TcbAcc_AI_storeWord_invs =
   fixes state_ext_t :: "'state_ext::state_ext itself"
   assumes storeWord_invs[wp]:
@@ -257,6 +260,20 @@ lemma thread_set_iflive_trivial:
   apply (clarsimp simp: live_def hyp_live_tcb_def z y a)
   done
 
+lemma thread_set_obj_at_impossible:
+  "\<lbrakk> \<And>tcb. \<not> (P (TCB tcb)) \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. obj_at P p s\<rbrace> thread_set f t \<lbrace>\<lambda>rv. obj_at P p\<rbrace>"
+  apply (simp add: thread_set_def set_object_def get_object_def)
+  apply wp
+  apply (clarsimp dest!: get_tcb_SomeD)
+  apply (clarsimp simp: obj_at_def)
+  done
+
+lemma thread_set_wp:
+  "\<lbrace> \<lambda>s. \<forall>tcb. get_tcb t s = Some tcb \<longrightarrow> Q (s\<lparr>kheap := (kheap s)(t \<mapsto> TCB (f tcb))\<rparr>) \<rbrace>
+   thread_set f t
+   \<lbrace> \<lambda>_. Q \<rbrace>"
+  by (wpsimp simp: thread_set_def wp: set_object_wp)
+
 
 lemma thread_set_ifunsafe_trivial:
   assumes x: "\<And>tcb. \<forall>(getF, v) \<in> ran tcb_cap_cases.
@@ -352,15 +369,6 @@ lemma thread_set_valid_reply_masters_trivial:
 crunch thread_set
   for interrupt_states[wp]: "\<lambda>s. P (interrupt_states s)"
 
-lemma thread_set_obj_at_impossible:
-  "\<lbrakk> \<And>tcb. \<not> (P (TCB tcb)) \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. obj_at P p s\<rbrace> thread_set f t \<lbrace>\<lambda>rv. obj_at P p\<rbrace>"
-  apply (simp add: thread_set_def set_object_def get_object_def)
-  apply wp
-  apply (clarsimp dest!: get_tcb_SomeD)
-  apply (clarsimp simp: obj_at_def)
-  done
-
-
 lemma tcb_not_empty_table:
   "\<not> empty_table S (TCB tcb)"
   by (simp add: empty_table_def)
@@ -741,6 +749,9 @@ lemma idle_thread_idle[wp]:
                  split: option.splits Structures_A.kernel_object.splits)
   done
 
+crunch set_thread_state_act
+  for valid_objs[wp]: valid_objs
+
 lemma set_thread_state_valid_objs[wp]:
  "\<lbrace>valid_objs and valid_tcb_state st and
    (\<lambda>s. (\<forall>a data. st = Structures_A.BlockedOnReceive a data \<longrightarrow>
@@ -751,14 +762,12 @@ lemma set_thread_state_valid_objs[wp]:
   set_thread_state thread st
   \<lbrace>\<lambda>r. valid_objs\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (wp, simp, (wp set_object_valid_objs)+)
-  apply (clarsimp simp: obj_at_def get_tcb_def is_tcb
-                  split: Structures_A.kernel_object.splits option.splits)
+  apply (wpsimp wp: set_object_valid_objs)
+  apply (clarsimp simp: obj_at_def get_tcb_def
+                 split: Structures_A.kernel_object.splits option.splits)
   apply (simp add: valid_objs_def dom_def)
   apply (erule allE, erule impE, blast)
-  apply (clarsimp simp: valid_obj_def valid_tcb_def
-                        a_type_def tcb_cap_cases_def)
-  (* very slow *)
+  apply (simp add: valid_obj_def valid_tcb_def a_type_def tcb_cap_cases_def)
   by (erule cte_wp_atE disjE
        | clarsimp simp: st_tcb_def2 tcb_cap_cases_def
                  dest!: get_tcb_SomeD
@@ -774,13 +783,8 @@ lemma set_bound_notification_valid_objs[wp]:
   apply (auto simp: valid_obj_def valid_tcb_def tcb_cap_cases_def)
   done
 
-lemma set_thread_state_aligned[wp]:
- "\<lbrace>pspace_aligned\<rbrace>
-  set_thread_state thread st
-  \<lbrace>\<lambda>r. pspace_aligned\<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (wp set_object_aligned|clarsimp)+
-  done
+crunch set_thread_state
+ for aligned[wp]: pspace_aligned
 
 lemma set_bound_notification_aligned[wp]:
  "\<lbrace>pspace_aligned\<rbrace>
@@ -791,33 +795,16 @@ lemma set_bound_notification_aligned[wp]:
   apply clarsimp
   done
 
-lemma set_thread_state_typ_at [wp]:
-  "\<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> set_thread_state st p' \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
-  apply (simp add: set_thread_state_def set_object_def get_object_def)
-  apply (wp|clarsimp)+
-  apply (clarsimp simp: obj_at_def a_type_def dest!: get_tcb_SomeD)
-  done
-
 crunch set_bound_notification
   for typ_at[wp]: "\<lambda>s. P (typ_at T p s)"
 
-
-lemma set_thread_state_tcb[wp]:
-  "\<lbrace>tcb_at t\<rbrace> set_thread_state ts t' \<lbrace>\<lambda>rv. tcb_at t\<rbrace>"
-  by (simp add: tcb_at_typ, wp)
-
 lemma set_bound_notification_tcb[wp]:
   "\<lbrace>tcb_at t\<rbrace> set_bound_notification t' ntfn \<lbrace>\<lambda>rv. tcb_at t\<rbrace>"
   by (simp add: tcb_at_typ, wp)
 
 lemma set_thread_state_cte_wp_at [wp]:
   "\<lbrace>cte_wp_at P c\<rbrace> set_thread_state st p' \<lbrace>\<lambda>rv. cte_wp_at P c\<rbrace>"
-  apply (simp add: set_thread_state_def set_object_def get_object_def)
-  apply (wp|simp)+
-  apply (clarsimp cong: if_cong)
-  apply (drule get_tcb_SomeD)
-  apply (auto simp: cte_wp_at_cases tcb_cap_cases_def)
-  done
+  by (wp hoare_cte_wp_caps_of_state_lift)
 
 lemma set_bound_notification_cte_wp_at [wp]:
   "\<lbrace>cte_wp_at P c\<rbrace> set_bound_notification t ntfn \<lbrace>\<lambda>rv. cte_wp_at P c\<rbrace>"
@@ -998,6 +985,8 @@ lemma sbn_bound_tcb_at':
   apply (clarsimp elim!: pred_tcb_weakenE)
   done
 
+crunch set_thread_state_act
+  for valid_idle[wp]: valid_idle
 
 lemma sts_valid_idle [wp]:
   "\<lbrace>valid_idle and
@@ -1021,11 +1010,8 @@ lemma sbn_valid_idle [wp]:
   apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def get_tcb_def)
   done
 
-lemma sts_distinct [wp]:
-  "set_thread_state t st \<lbrace>pspace_distinct\<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (wp set_object_distinct|clarsimp)+
-  done
+crunch set_thread_state
+  for distinct[wp]: pspace_distinct
 
 lemma sbn_distinct [wp]:
   "set_bound_notification t ntfn \<lbrace>pspace_distinct\<rbrace>"
@@ -1033,13 +1019,18 @@ lemma sbn_distinct [wp]:
   apply (wp set_object_distinct, simp)
   done
 
+lemma cur_tcb_scheduler_action[simp]:
+  "cur_tcb (scheduler_action_update f s) = cur_tcb s"
+  by (simp add: cur_tcb_def)
+
+crunch set_thread_state_act
+  for cur_tcb[wp]: cur_tcb
+
 lemma sts_cur_tcb [wp]:
   "set_thread_state t st \<lbrace>\<lambda>s. cur_tcb s\<rbrace>"
-  apply (clarsimp simp: set_thread_state_def set_object_def get_object_def
-                        gets_the_def valid_def in_monad)
+  unfolding set_thread_state_def set_object_def get_object_def
+  apply wpsimp
   apply (drule get_tcb_SomeD)
-  apply (frule in_dxo_pspaceD)
-  apply (drule in_dxo_cur_threadD)
   apply (clarsimp simp: cur_tcb_def obj_at_def is_tcb_def)
   done
 
@@ -1051,6 +1042,8 @@ lemma sbn_cur_tcb [wp]:
   apply (clarsimp simp: cur_tcb_def obj_at_def is_tcb_def)
   done
 
+crunch set_thread_state_act
+  for iflive[wp]: if_live_then_nonz_cap
 
 lemma sts_iflive[wp]:
   "\<lbrace>\<lambda>s. (\<not> halted st \<longrightarrow> ex_nonz_cap_to t s)
@@ -1075,6 +1068,9 @@ lemma sbn_iflive[wp]:
                    split: Structures_A.thread_state.splits)
   done
 
+crunch set_thread_state_act
+  for ifunsafe[wp]: if_unsafe_then_cap
+
 lemma sts_ifunsafe[wp]:
   "\<lbrace>if_unsafe_then_cap\<rbrace> set_thread_state t st \<lbrace>\<lambda>rv. if_unsafe_then_cap\<rbrace>"
   apply (simp add: set_thread_state_def)
@@ -1089,12 +1085,9 @@ lemma sbn_ifunsafe[wp]:
   apply (fastforce simp: tcb_cap_cases_def)
   done
 
-lemma sts_zombies[wp]:
-  "\<lbrace>zombies_final\<rbrace> set_thread_state t st \<lbrace>\<lambda>rv. zombies_final\<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (wp|simp)+
-  apply (fastforce simp: tcb_cap_cases_def)
-  done
+crunch set_thread_state
+  for zombies[wp]: zombies_final
+  (simp: tcb_cap_cases_def)
 
 lemma sbn_zombies[wp]:
   "\<lbrace>zombies_final\<rbrace> set_bound_notification t ntfn \<lbrace>\<lambda>rv. zombies_final\<rbrace>"
@@ -1110,6 +1103,11 @@ lemma sts_refs_of_helper: "
           tcb_bound_refs ntfnptr"
   by (auto simp add: tcb_st_refs_of_def tcb_bound_refs_def split: thread_state.splits option.splits)
 
+declare scheduler_action_update.state_refs_update[simp]
+
+crunch set_thread_state_act
+  for refs_of[wp]: "\<lambda>s. P (state_refs_of s)"
+  and hyp_refs_of[wp]: "\<lambda>s. P (state_hyp_refs_of s)"
 
 lemma sts_refs_of[wp]:
   "\<lbrace>\<lambda>s. P ((state_refs_of s) (t := tcb_st_refs_of st
@@ -1174,7 +1172,7 @@ lemma sbn_hyp_refs_of[wp]:
 
 lemma set_thread_state_thread_set:
   "set_thread_state p st = (do thread_set (tcb_state_update (\<lambda>_. st)) p;
-                               do_extended_op (set_thread_state_ext p)
+                               set_thread_state_act p
                             od)"
   by (simp add: set_thread_state_def thread_set_def bind_assoc)
 
@@ -1182,19 +1180,8 @@ lemma set_bound_notification_thread_set:
   "set_bound_notification p ntfn = thread_set (tcb_bound_notification_update (\<lambda>_. ntfn)) p"
   by (simp add: set_bound_notification_def thread_set_def bind_assoc)
 
-lemma set_thread_state_caps_of_state[wp]:
-  "\<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> set_thread_state t st \<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
-  apply (simp add: set_thread_state_thread_set)
-  apply (wp, simp, wp thread_set_caps_of_state_trivial)
-  apply (rule ball_tcb_cap_casesI, simp_all)
-  done
-
-lemma set_bound_notification_caps_of_state[wp]:
-  "\<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> set_bound_notification t ntfn \<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
-  apply (simp add: set_bound_notification_thread_set)
-  apply (wp thread_set_caps_of_state_trivial, simp)
-  apply (rule ball_tcb_cap_casesI, simp_all)
-  done
+crunch set_thread_state_act
+ for pred_tcb_at[wp]: "\<lambda>s. Q (pred_tcb_at proj P t s)"
 
 lemma sts_st_tcb_at_neq:
   "\<lbrace>pred_tcb_at proj P t and K (t\<noteq>t')\<rbrace> set_thread_state t' st \<lbrace>\<lambda>_. pred_tcb_at proj P t\<rbrace>"
@@ -1268,6 +1255,9 @@ lemma sbn_reply [wp]:
   apply clarsimp
   done
 
+crunch set_thread_state_act
+ for valid_reply_masters[wp]: valid_reply_masters
+
 lemma sts_reply_masters [wp]:
   "\<lbrace>valid_reply_masters\<rbrace> set_thread_state p st \<lbrace>\<lambda>_. valid_reply_masters\<rbrace>"
   apply (simp add: set_thread_state_thread_set)
@@ -1284,14 +1274,15 @@ lemma sbn_reply_masters [wp]:
   apply assumption
   done
 
+crunch set_thread_state
+  for cdt[wp]: "\<lambda>s. P (cdt s)"
+  and ioc[wp]: "\<lambda>s. P (is_original_cap s)"
+  and it[wp]: "\<lambda>s. P (idle_thread s)"
+  and irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
 
 lemma set_thread_state_mdb [wp]:
   "\<lbrace>valid_mdb\<rbrace> set_thread_state p st \<lbrace>\<lambda>_. valid_mdb\<rbrace>"
-  apply (simp add: set_thread_state_thread_set)
-  apply (wp thread_set_mdb|simp)+
-   apply (fastforce simp: tcb_cap_cases_def)
-  apply assumption
-  done
+  by (rule valid_mdb_lift; wp)
 
 lemma set_bound_notification_mdb [wp]:
   "\<lbrace>valid_mdb\<rbrace> set_bound_notification p ntfn \<lbrace>\<lambda>_. valid_mdb\<rbrace>"
@@ -1303,9 +1294,7 @@ lemma set_bound_notification_mdb [wp]:
 
 lemma set_thread_state_global_refs [wp]:
   "\<lbrace>valid_global_refs\<rbrace> set_thread_state p st \<lbrace>\<lambda>_. valid_global_refs\<rbrace>"
-  apply (simp add: set_thread_state_thread_set)
-  apply (wp thread_set_global_refs_triv|clarsimp simp: tcb_cap_cases_def)+
-  done
+  by (rule valid_global_refs_cte_lift; wp)
 
 lemma set_bound_notification_global_refs [wp]:
   "\<lbrace>valid_global_refs\<rbrace> set_bound_notification p ntfn \<lbrace>\<lambda>_. valid_global_refs\<rbrace>"
@@ -1385,25 +1374,29 @@ crunch set_thread_state, set_bound_notification
 crunch set_thread_state, set_bound_notification
   for interrupt_states[wp]: "\<lambda>s. P (interrupt_states s)"
 
+lemmas set_thread_state_caps_of_state = sts_caps_of_state
+
 lemmas set_thread_state_valid_irq_nodes[wp]
     = valid_irq_handlers_lift [OF set_thread_state_caps_of_state
                                   set_thread_state_interrupt_states]
 
 lemmas set_bound_notification_valid_irq_nodes[wp]
-    = valid_irq_handlers_lift [OF set_bound_notification_caps_of_state
+    = valid_irq_handlers_lift [OF set_bound_caps_of_state
                                   set_bound_notification_interrupt_states]
 
 
 lemma sts_obj_at_impossible:
   "(\<And>tcb. \<not> P (TCB tcb)) \<Longrightarrow> \<lbrace>obj_at P p\<rbrace> set_thread_state t st \<lbrace>\<lambda>rv. obj_at P p\<rbrace>"
   unfolding set_thread_state_thread_set
-  by (wp, simp, wp thread_set_obj_at_impossible)
+  by (wp thread_set_obj_at_impossible)
 
 lemma sbn_obj_at_impossible:
   "(\<And>tcb. \<not> P (TCB tcb)) \<Longrightarrow> \<lbrace>obj_at P p\<rbrace> set_bound_notification t ntfn \<lbrace>\<lambda>rv. obj_at P p\<rbrace>"
   unfolding set_bound_notification_thread_set
   by (wp thread_set_obj_at_impossible, simp)
 
+crunch set_thread_state_act
+  for only_idle[wp]: only_idle
 
 lemma sts_only_idle:
   "\<lbrace>only_idle and (\<lambda>s. idle st \<longrightarrow> t = idle_thread s)\<rbrace>
@@ -1425,25 +1418,15 @@ lemma sbn_only_idle[wp]:
 lemma set_thread_state_pspace_in_kernel_window[wp]:
   "\<lbrace>pspace_in_kernel_window\<rbrace>
       set_thread_state p st \<lbrace>\<lambda>rv. pspace_in_kernel_window\<rbrace>"
-  by (simp add: set_thread_state_thread_set, wp, simp, wp)
+  apply (rule pspace_in_kernel_window_atyp_lift)
+   apply wp+
+  done
 
 crunch set_thread_state
   for pspace_respects_device_region[wp]: pspace_respects_device_region
-(wp: set_object_pspace_respects_device_region)
-
-lemma set_thread_state_cap_refs_in_kernel_window[wp]:
-  "\<lbrace>cap_refs_in_kernel_window\<rbrace>
-      set_thread_state p st \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
-  by (simp add: set_thread_state_thread_set
-           | wp thread_set_cap_refs_in_kernel_window
-                ball_tcb_cap_casesI)+
-
-lemma set_thread_state_cap_refs_respects_device_regionw[wp]:
-  "\<lbrace>cap_refs_respects_device_region\<rbrace>
-      set_thread_state p st \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
-  by (simp add: set_thread_state_thread_set
-           | wp thread_set_cap_refs_respects_device_region
-                ball_tcb_cap_casesI)+
+  and cap_refs_in_kernel_window[wp]: cap_refs_in_kernel_window
+  and cap_refs_respects_device_region[wp]: cap_refs_respects_device_region
+  (wp: set_object_pspace_respects_device_region simp: tcb_cap_cases_def)
 
 lemma set_bound_notification_pspace_in_kernel_window[wp]:
   "\<lbrace>pspace_in_kernel_window\<rbrace>
@@ -1468,10 +1451,13 @@ lemma set_bound_notification_cap_refs_respects_device_region[wp]:
            | wp thread_set_cap_refs_respects_device_region
                 ball_tcb_cap_casesI)+
 
+crunch set_thread_state_act
+ for valid_ioc[wp]: valid_ioc
+
 lemma set_thread_state_valid_ioc[wp]:
   "\<lbrace>valid_ioc\<rbrace> set_thread_state t st \<lbrace>\<lambda>_. valid_ioc\<rbrace>"
   apply (simp add: set_thread_state_def)
-  apply (wp, simp, (wp set_object_valid_ioc_caps)+)
+  apply (wpsimp wp: set_object_valid_ioc_caps)
   apply (intro impI conjI, clarsimp+)
   apply (clarsimp simp: valid_ioc_def)
   apply (drule spec, drule spec, erule impE, assumption)
@@ -1614,19 +1600,11 @@ lemma set_bound_notification_ko:
   apply (clarsimp simp: obj_at_def is_tcb)
   done
 
-lemma set_thread_state_valid_cap:
-  "\<lbrace>valid_cap c\<rbrace> set_thread_state x st \<lbrace>\<lambda>rv. valid_cap c\<rbrace>"
-  apply (simp add: set_thread_state_def)
-  apply (wp set_object_valid_cap|clarsimp)+
-  done
+lemmas set_thread_state_valid_cap = set_thread_state_typ_ats(13)
 
 crunch set_bound_notification
   for valid_cap: "valid_cap c"
 
-lemma set_thread_state_cte_at:
-  "\<lbrace>cte_at p\<rbrace> set_thread_state x st \<lbrace>\<lambda>rv. cte_at p\<rbrace>"
-  by (rule set_thread_state_cte_wp_at)
-
 
 lemma as_user_mdb [wp]:
   "\<lbrace>valid_mdb\<rbrace> as_user f t \<lbrace>\<lambda>_. valid_mdb\<rbrace>"
@@ -1665,17 +1643,32 @@ crunch set_bound_notification
   for ex_nonz_cap_to[wp]: "ex_nonz_cap_to p"
   (wp: ex_nonz_cap_to_pres)
 
+lemma ct_in_state_sched_act_update[simp]:
+  "ct_in_state P (scheduler_action_update f s) = ct_in_state P s"
+  by (simp add: ct_in_state_def)
+
+crunch set_thread_state_act
+ for ct_in_state[wp]: "\<lambda>s. Q (ct_in_state P s)"
+
 lemma ct_in_state_set:
   "P st \<Longrightarrow> \<lbrace>\<lambda>s. cur_thread s = t\<rbrace> set_thread_state t st \<lbrace>\<lambda>rv. ct_in_state P \<rbrace>"
   apply (simp add: set_thread_state_def set_object_def get_object_def)
   by (wp|simp add: ct_in_state_def pred_tcb_at_def obj_at_def)+
 
+lemma set_thread_state_ct_st:
+  "\<lbrace>\<lambda>s. if thread = cur_thread s then Q (P st) else Q (ct_in_state P s)\<rbrace>
+   set_thread_state thread st
+   \<lbrace>\<lambda>rv s. Q (ct_in_state P s)\<rbrace>"
+  apply (simp add: set_thread_state_def set_object_def get_object_def)
+  apply wpsimp
+  apply (clarsimp simp: ct_in_state_def pred_tcb_at_def obj_at_def)
+  done
 
 lemma sts_ctis_neq:
-  "\<lbrace>\<lambda>s. cur_thread s \<noteq> t \<and> ct_in_state P s\<rbrace> set_thread_state t st \<lbrace>\<lambda>_. ct_in_state P\<rbrace>"
-  apply (simp add: ct_in_state_def set_thread_state_def set_object_def get_object_def)
-  apply (wp|simp add: pred_tcb_at_def obj_at_def)+
-  done
+  "\<lbrace>\<lambda>s. (cur_thread s \<noteq> t \<or> P st) \<and> ct_in_state P s\<rbrace>
+   set_thread_state t st
+   \<lbrace>\<lambda>_. ct_in_state P\<rbrace>"
+  by (wpsimp wp: set_thread_state_ct_st)
 
 
 lemma valid_running [simp]:
@@ -1710,10 +1703,9 @@ lemma ep_queued_st_tcb_at:
          clarsimp simp: pred_tcb_at_def refs_of_rev elim!: obj_at_weakenE)+
   done
 
-
-lemma thread_set_ct_running:
+lemma thread_set_ct_in_state:
   "(\<And>tcb. tcb_state (f tcb) = tcb_state tcb) \<Longrightarrow>
-  \<lbrace>ct_running\<rbrace> thread_set f t \<lbrace>\<lambda>rv. ct_running\<rbrace>"
+  \<lbrace>ct_in_state st\<rbrace> thread_set f t \<lbrace>\<lambda>rv. ct_in_state st\<rbrace>"
   apply (simp add: ct_in_state_def)
   apply (rule hoare_lift_Pf [where f=cur_thread])
    apply (wp thread_set_no_change_tcb_state; simp)
@@ -1824,16 +1816,367 @@ lemma get_tcb_ko_atD:
   "get_tcb t s = Some tcb \<Longrightarrow> ko_at (TCB tcb) t s"
   by auto
 
-(* FIXME: subsumes thread_set_ct_running *)
-lemma thread_set_ct_in_state:
-  "(\<And>tcb. tcb_state (f tcb) = tcb_state tcb) \<Longrightarrow>
-  \<lbrace>ct_in_state st\<rbrace> thread_set f t \<lbrace>\<lambda>rv. ct_in_state st\<rbrace>"
-  apply (simp add: ct_in_state_def)
-  apply (rule hoare_lift_Pf [where f=cur_thread])
-   apply (wp thread_set_no_change_tcb_state; simp)
-  apply (simp add: thread_set_def)
-  apply wp
+
+
+lemma live_tcb_domain_update[simp]:
+  "live (TCB (tcb_domain_update f t)) = live (TCB t)"
+  by (simp add: live_def)
+
+lemma live_tcb_priority_update[simp]:
+  "live (TCB (tcb_priority_update f t)) = live (TCB t)"
+  by (simp add: live_def)
+
+crunch thread_set_domain, thread_set_priority
+  for aligned[wp]: pspace_aligned
+  and distinct[wp]: pspace_distinct
+  and typ_at[wp]: "\<lambda>s. P (typ_at T p s)"
+  and irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
+  and it[wp]: "\<lambda>s. P (idle_thread s)"
+  and no_cdt[wp]: "\<lambda>s. P (cdt s)"
+  and no_revokable[wp]: "\<lambda>s. P (is_original_cap s)"
+  and valid_irq_states[wp]: valid_irq_states
+  and pspace_in_kernel_window[wp]: pspace_in_kernel_window
+  and pspace_respects_device_region[wp]: pspace_respects_device_region
+  and cur_tcb[wp]: cur_tcb
+  and interrupt_states[wp]: "\<lambda>s. P (interrupt_states s)"
+  and cap_refs_in_kernel_window[wp]: cap_refs_in_kernel_window
+  and cap_refs_respects_device_region[wp]: cap_refs_respects_device_region
+  and only_idle[wp]: only_idle
+  and valid_arch_state[wp]: valid_arch_state
+  and valid_global_objs[wp]: valid_global_objs
+  and valid_kernel_mappings[wp]: valid_kernel_mappings
+  and equal_kernel_mappings[wp]: equal_kernel_mappings
+  and valid_global_vspace_mappings[wp]: valid_global_vspace_mappings
+  and valid_vspace_objs[wp]: valid_vspace_objs
+  and valid_machine_state[wp]: valid_machine_state
+  and valid_asid_map[wp]: valid_asid_map
+  and global_refs[wp]: "\<lambda>s. P (global_refs s)"
+  (wp: crunch_wps simp: crunch_simps tcb_cap_cases_def)
+
+lemmas thread_set_domain_typ_ats[wp] = abs_typ_at_lifts[OF thread_set_domain_typ_at]
+lemmas thread_set_priority_typ_ats[wp] = abs_typ_at_lifts[OF thread_set_priority_typ_at]
+
+lemma thread_set_domain_caps_of_state[wp]:
+  "thread_set_domain t d \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def set_object_def get_object_def
+  apply wpsimp
+  apply (erule rsubst[of P])
+  apply (rule cte_wp_caps_of_lift)
+  apply (clarsimp simp: cte_wp_at_cases tcb_cap_cases_def dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_domain_cte_wp_at[wp]:
+  "thread_set_domain t d \<lbrace>\<lambda>s. P (cte_wp_at Q p s)\<rbrace>"
+  by (wpsimp simp: cte_wp_at_caps_of_state)
+
+lemma thread_set_domain_valid_objs[wp]:
+  "thread_set_domain t d \<lbrace>valid_objs\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  apply (wpsimp wp: set_object_valid_objs)
+  apply (clarsimp simp: obj_at_def dest!: get_tcb_SomeD)
+  apply (erule (1) pspace_valid_objsE)
+  apply (clarsimp simp: valid_obj_def valid_tcb_def)
+  apply (drule (1) bspec)
+  by (auto simp: tcb_cap_cases_def)
+
+lemma thread_set_domain_if_live_then_nonz_cap[wp]:
+  "thread_set_domain t d \<lbrace>if_live_then_nonz_cap\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  apply wpsimp
+  apply (auto simp: if_live_then_nonz_cap_def obj_at_def tcb_cap_cases_def dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_domain_zombies_final[wp]:
+  "thread_set_domain t d \<lbrace>zombies_final\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  by (wpsimp simp: tcb_cap_cases_def) auto
+
+lemma thread_set_domain_refs_of[wp]:
+  "thread_set_domain t d \<lbrace>\<lambda>s. P (state_refs_of s)\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def set_object_def get_object_def
+  apply (wpsimp simp: state_refs_of_def)
+  apply (erule rsubst[of P])
+  apply (rule ext)
+  apply (clarsimp split: option.splits dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_domain_hyp_refs_of[wp]:
+  "thread_set_domain t d \<lbrace>\<lambda>s. P (state_hyp_refs_of s)\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def set_object_def get_object_def
+  supply fun_upd_apply [simp del]
+  apply wpsimp
+  apply (clarsimp elim!: rsubst[where P=P] dest!: get_tcb_SomeD)
+  apply (subst state_hyp_refs_of_tcb_domain_update; auto simp: get_tcb_def)
+  done
+
+lemma thread_set_domain_valid_idle[wp]:
+  "thread_set_domain t d \<lbrace>valid_idle\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  apply wpsimp
+  apply (auto simp: obj_at_def valid_idle_def pred_tcb_at_def dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_domain_if_unsafe_then_cap[wp]:
+  "thread_set_domain t d \<lbrace>if_unsafe_then_cap\<rbrace>"
+  unfolding thread_set_domain_def thread_set_def
+  by (wpsimp simp: tcb_cap_cases_def) auto
+
+lemma thread_set_domain_valid_irq_node[wp]:
+  "thread_set_domain t d \<lbrace>valid_irq_node\<rbrace>"
+  apply (wpsimp simp: valid_irq_node_def wp: hoare_vcg_all_lift)
+   apply (rule hoare_lift_Pf[where f="interrupt_irq_node"]; wp cap_table_at_typ_at)
   apply simp
   done
 
+lemma thread_set_domain_valid_irq_handlers[wp]:
+  "thread_set_domain t d \<lbrace>valid_irq_handlers\<rbrace>"
+  apply (wpsimp simp: valid_irq_handlers_def irq_issued_def)
+  apply (rule hoare_lift_Pf[where f="caps_of_state"]; wp)
+  done
+
+lemma thread_set_domain_valid_arch_caps[wp]:
+  "thread_set_domain t d \<lbrace>valid_arch_caps\<rbrace>"
+  unfolding thread_set_domain_def
+  by (wpsimp wp: thread_set_arch_caps_trivial simp: tcb_cap_cases_def) auto
+
+lemma thread_set_domain_valid_ioports[wp]:
+  "thread_set_domain t d \<lbrace>valid_ioports\<rbrace>"
+  unfolding thread_set_domain_def
+  by (wpsimp wp: valid_ioports_lift thread_set_caps_of_state_trivial2 simp: tcb_cap_cases_def)
+
+lemma thread_set_domain_valid_reply_caps[wp]:
+  "thread_set_domain t d \<lbrace>valid_reply_caps\<rbrace>"
+  unfolding thread_set_domain_def
+  by (wpsimp wp: thread_set_valid_reply_caps_trivial ball_tcb_cap_casesI)
+
+lemma thread_set_domain_valid_reply_masters[wp]:
+  "thread_set_domain t d \<lbrace>valid_reply_masters\<rbrace>"
+  unfolding thread_set_domain_def
+  by (wpsimp wp: thread_set_valid_reply_masters_trivial ball_tcb_cap_casesI)
+
+lemma thread_set_domain_invs[wp]:
+  "thread_set_domain t d \<lbrace>invs\<rbrace>"
+  unfolding invs_def valid_state_def valid_pspace_def
+  by (wpsimp wp: valid_mdb_lift hoare_vcg_all_lift hoare_vcg_imp_lift
+           simp: valid_ioc_def valid_global_refs_def valid_refs_def cte_wp_at_caps_of_state)
+
+lemma thread_set_priority_caps_of_state[wp]:
+  "thread_set_priority t d \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def set_object_def get_object_def
+  apply wpsimp
+  apply (erule rsubst[of P])
+  apply (rule cte_wp_caps_of_lift)
+  apply (clarsimp simp: cte_wp_at_cases tcb_cap_cases_def dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_cte_wp_at[wp]:
+  "thread_set_priority t d \<lbrace>\<lambda>s. P (cte_wp_at Q p s)\<rbrace>"
+  by (wpsimp simp: cte_wp_at_caps_of_state)
+
+lemma thread_set_priority_valid_objs[wp]:
+  "thread_set_priority t d \<lbrace>valid_objs\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply (wpsimp wp: set_object_valid_objs)
+  apply (clarsimp simp: obj_at_def dest!: get_tcb_SomeD)
+  apply (erule (1) pspace_valid_objsE)
+  apply (clarsimp simp: valid_obj_def valid_tcb_def)
+  apply (drule (1) bspec)
+  by (auto simp: tcb_cap_cases_def)
+
+lemma thread_set_priority_if_live_then_nonz_cap[wp]:
+  "thread_set_priority t d \<lbrace>if_live_then_nonz_cap\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply wpsimp
+  apply (auto simp: if_live_then_nonz_cap_def obj_at_def tcb_cap_cases_def dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_zombies_final[wp]:
+  "thread_set_priority t d \<lbrace>zombies_final\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  by (wpsimp simp: tcb_cap_cases_def) auto
+
+lemma thread_set_priority_refs_of[wp]:
+  "thread_set_priority t d \<lbrace>\<lambda>s. P (state_refs_of s)\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def set_object_def get_object_def
+  apply (wpsimp simp: state_refs_of_def)
+  apply (erule rsubst[of P])
+  apply (rule ext)
+  apply (clarsimp split: option.splits dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_hyp_refs_of[wp]:
+  "thread_set_priority t d \<lbrace>\<lambda>s. P (state_hyp_refs_of s)\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def set_object_def get_object_def
+  supply fun_upd_apply [simp del]
+  apply wpsimp
+  apply (clarsimp elim!: rsubst[where P=P] dest!: get_tcb_SomeD)
+  apply (subst state_hyp_refs_of_tcb_priority_update; auto simp: get_tcb_def)
+  done
+
+lemma thread_set_priority_valid_idle[wp]:
+  "thread_set_priority t d \<lbrace>valid_idle\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  apply wpsimp
+  apply (auto simp: obj_at_def valid_idle_def pred_tcb_at_def dest!: get_tcb_SomeD)
+  done
+
+lemma thread_set_priority_if_unsafe_then_cap[wp]:
+  "thread_set_priority t d \<lbrace>if_unsafe_then_cap\<rbrace>"
+  unfolding thread_set_priority_def thread_set_def
+  by (wpsimp simp: tcb_cap_cases_def) auto
+
+lemma thread_set_priority_valid_irq_node[wp]:
+  "thread_set_priority t d \<lbrace>valid_irq_node\<rbrace>"
+  apply (wpsimp simp: valid_irq_node_def wp: hoare_vcg_all_lift)
+   apply (rule hoare_lift_Pf[where f="interrupt_irq_node"]; wp cap_table_at_typ_at)
+  apply simp
+  done
+
+lemma thread_set_priority_valid_irq_handlers[wp]:
+  "thread_set_priority t d \<lbrace>valid_irq_handlers\<rbrace>"
+  apply (wpsimp simp: valid_irq_handlers_def irq_issued_def)
+  apply (rule hoare_lift_Pf[where f="caps_of_state"]; wp)
+  done
+
+lemma thread_set_priority_valid_arch_caps[wp]:
+  "thread_set_priority t d \<lbrace>valid_arch_caps\<rbrace>"
+  unfolding thread_set_priority_def
+  by (wpsimp wp: thread_set_arch_caps_trivial simp: tcb_cap_cases_def) auto
+
+lemma thread_set_priority_valid_ioports[wp]:
+  "thread_set_priority t d \<lbrace>valid_ioports\<rbrace>"
+  unfolding thread_set_priority_def
+  by (wpsimp wp: valid_ioports_lift thread_set_caps_of_state_trivial2 simp: tcb_cap_cases_def)
+
+lemma thread_set_priority_valid_reply_caps[wp]:
+  "thread_set_priority t d \<lbrace>valid_reply_caps\<rbrace>"
+  unfolding thread_set_priority_def
+  by (wpsimp wp: thread_set_valid_reply_caps_trivial ball_tcb_cap_casesI)
+
+lemma thread_set_priority_valid_reply_masters[wp]:
+  "thread_set_priority t d \<lbrace>valid_reply_masters\<rbrace>"
+  unfolding thread_set_priority_def
+  by (wpsimp wp: thread_set_valid_reply_masters_trivial ball_tcb_cap_casesI)
+
+lemma thread_set_priority_invs[wp]:
+  "thread_set_priority t d \<lbrace>invs\<rbrace>"
+  unfolding invs_def valid_state_def valid_pspace_def
+  by (wpsimp wp: valid_mdb_lift hoare_vcg_all_lift hoare_vcg_imp_lift
+           simp: valid_ioc_def valid_global_refs_def valid_refs_def cte_wp_at_caps_of_state)
+
+lemma gts_wp:
+  "\<lbrace>\<lambda>s. \<forall>st. st_tcb_at ((=) st) t s \<longrightarrow> P st s\<rbrace> get_thread_state t \<lbrace>P\<rbrace>"
+  unfolding get_thread_state_def
+  by (wpsimp wp: thread_get_wp' simp: pred_tcb_at_def obj_at_def)
+
+text \<open>set_thread_state_act invariants\<close>
+
+crunch set_thread_state_act
+  for aligned[wp]: pspace_aligned
+  and it[wp]: "\<lambda>s. P (idle_thread s)"
+  and distinct[wp]: pspace_distinct
+  and tcb_at[wp]: "tcb_at tptr"
+  and st_tcb_at[wp]: "\<lambda>s. Q( st_tcb_at P tptr s)"
+  and interrupt_irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
+  and no_cdt[wp]: "\<lambda>s. P (cdt s)"
+  and no_revokable[wp]: "\<lambda>s. P (is_original_cap s)"
+  and valid_irq_states[wp]: "valid_irq_states"
+  and pspace_in_kernel_window[wp]: "pspace_in_kernel_window"
+  and pspace_respects_device_region[wp]: "pspace_respects_device_region"
+  and cur_tcb[wp]: "cur_tcb"
+  and typ_at[wp]: "\<lambda>s. P (typ_at T p s)"
+  and interrupt_states[wp]: "\<lambda>s. P (interrupt_states s)"
+  and valid_objs[wp]: valid_objs
+  and iflive[wp]: "if_live_then_nonz_cap"
+  and nonz_cap_to[wp]: "ex_nonz_cap_to p"
+  and valid_mdb[wp]: valid_mdb
+  and zombies[wp]: zombies_final
+  and valid_irq_handlers[wp]: "valid_irq_handlers"
+  and valid_ioc[wp]: "valid_ioc"
+  and valid_idle[wp]: valid_idle
+  and cap_refs_in_kernel_window[wp]: "cap_refs_in_kernel_window"
+  and cap_refs_respects_device_region[wp]: "cap_refs_respects_device_region"
+  and valid_arch[wp]: "valid_arch_state"
+  and ifunsafe[wp]: "if_unsafe_then_cap"
+  and only_idle[wp]: "only_idle"
+  and valid_global_objs[wp]: "valid_global_objs"
+  and valid_global_vspace_mappings[wp]: "valid_global_vspace_mappings"
+  and valid_arch_caps[wp]: "valid_arch_caps"
+  and v_ker_map[wp]: "valid_kernel_mappings"
+  and equal_mappings[wp]: "equal_kernel_mappings"
+  and vms[wp]: "valid_machine_state"
+  and valid_vspace_objs[wp]: "valid_vspace_objs"
+  and valid_global_refs[wp]: "valid_global_refs"
+  and valid_asid_map[wp]: "valid_asid_map"
+  and state_hyp_refs_of[wp]: "\<lambda>s. P (state_hyp_refs_of s)"
+  and state_refs_of[wp]: "\<lambda>s. P (state_refs_of s)"
+  and cte_wp_at[wp]: "cte_wp_at P c"
+  and caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
+  and arch_state[wp]: "\<lambda>s. P (arch_state s)"
+  and aligned[wp]: pspace_aligned
+  and distinct[wp]: pspace_distinct
+  and valid_objs[wp]: valid_objs
+  and cte_wp_at[wp]: "cte_wp_at P c"
+  and interrupt_irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
+  and caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
+  and no_cdt[wp]: "\<lambda>s. P (cdt s)"
+
+text \<open>possible_switch_to invariants\<close>
+
+lemma (in pspace_update_eq) ex_nonz_cap_to_update[iff]:
+  "ex_nonz_cap_to p (f s) = ex_nonz_cap_to p s"
+  by (simp add: ex_nonz_cap_to_def)
+
+crunch tcb_sched_action,reschedule_required,possible_switch_to
+  for aligned[wp]: pspace_aligned
+  and it[wp]: "\<lambda>s. P (idle_thread s)"
+  and distinct[wp]: pspace_distinct
+  and tcb_at[wp]: "\<lambda>s. P (tcb_at tptr s)"
+  and pred_tcb_at[wp]: "\<lambda>s. Q (pred_tcb_at proj P tptr s)"
+  and interrupt_irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
+  and no_cdt[wp]: "\<lambda>s. P (cdt s)"
+  and no_revokable[wp]: "\<lambda>s. P (is_original_cap s)"
+  and valid_irq_states[wp]: "valid_irq_states"
+  and pspace_in_kernel_window[wp]: "pspace_in_kernel_window"
+  and pspace_respects_device_region[wp]: "pspace_respects_device_region"
+  and cur_tcb[wp]: "cur_tcb"
+  and typ_at[wp]: "\<lambda>s. P (typ_at T p s)"
+  and interrupt_states[wp]: "\<lambda>s. P (interrupt_states s)"
+  and valid_objs[wp]: valid_objs
+  and iflive[wp]: "if_live_then_nonz_cap"
+  and nonz_cap_to[wp]: "ex_nonz_cap_to p"
+  and valid_mdb[wp]: valid_mdb
+  and zombies[wp]: zombies_final
+  and valid_irq_handlers[wp]: "valid_irq_handlers"
+  and valid_ioc[wp]: "valid_ioc"
+  and valid_idle[wp]: valid_idle
+  and cap_refs_in_kernel_window[wp]: "cap_refs_in_kernel_window"
+  and cap_refs_respects_device_region[wp]: "cap_refs_respects_device_region"
+  and valid_arch[wp]: "valid_arch_state"
+  and ifunsafe[wp]: "if_unsafe_then_cap"
+  and only_idle[wp]: "only_idle"
+  and valid_global_objs[wp]: "valid_global_objs"
+  and valid_global_vspace_mappings[wp]: "valid_global_vspace_mappings"
+  and valid_arch_caps[wp]: "valid_arch_caps"
+  and v_ker_map[wp]: "valid_kernel_mappings"
+  and equal_mappings[wp]: "equal_kernel_mappings"
+  and vms[wp]: "valid_machine_state"
+  and valid_vspace_objs[wp]: "valid_vspace_objs"
+  and valid_global_refs[wp]: "valid_global_refs"
+  and valid_asid_map[wp]: "valid_asid_map"
+  and state_hyp_refs_of[wp]: "\<lambda>s. P (state_hyp_refs_of s)"
+  and state_refs_of[wp]: "\<lambda>s. P (state_refs_of s)"
+  and cte_wp_at[wp]: "cte_wp_at P c"
+  and caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
+  and arch_state[wp]: "\<lambda>s. P (arch_state s)"
+  and aligned[wp]: pspace_aligned
+  and distinct[wp]: pspace_distinct
+  and valid_objs[wp]: valid_objs
+  and cte_wp_at[wp]: "cte_wp_at P c"
+  and interrupt_irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
+  and caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
+  and no_cdt[wp]: "\<lambda>s. P (cdt s)"
+  (simp: Let_def Let_def
+   wp: hoare_drop_imps hoare_vcg_if_lift2 mapM_wp)
+
 end
diff --git a/proof/invariant-abstract/Tcb_AI.thy b/proof/invariant-abstract/Tcb_AI.thy
index bb98806023..7c49eccf4a 100644
--- a/proof/invariant-abstract/Tcb_AI.thy
+++ b/proof/invariant-abstract/Tcb_AI.thy
@@ -51,9 +51,6 @@ lemma ct_in_state_weaken:
   "\<lbrakk> ct_in_state Q s; \<And>st. Q st \<Longrightarrow> P st \<rbrakk> \<Longrightarrow> ct_in_state P s"
   by (clarsimp simp: ct_in_state_def pred_tcb_at_def obj_at_def)
 
-lemma ct_in_state_exst_update[simp]: "ct_in_state P (trans_state f s) = ct_in_state P s"
-  by (simp add: ct_in_state_def)
-
 lemma set_thread_state_ct_st:
   "\<lbrace>\<lambda>s. if thread = cur_thread s then P st else ct_in_state P s\<rbrace>
         set_thread_state thread st
@@ -1248,9 +1245,9 @@ lemma out_pred_tcb_at_preserved:
   apply simp
   done
 
-lemma pred_tcb_at_arch_state[simp]:
-  "pred_tcb_at proj P t (arch_state_update f s) = pred_tcb_at proj P t s"
-  by (simp add: pred_tcb_at_def obj_at_def)
+lemma set_domain_invs[wp]:
+  "set_domain t d \<lbrace>invs\<rbrace>"
+  by (simp add: set_domain_def | wp)+
 
 lemma invoke_domain_invs:
   "\<lbrace>invs\<rbrace>
@@ -1258,6 +1255,10 @@ lemma invoke_domain_invs:
    \<lbrace>\<lambda>rv. invs\<rbrace>"
   by (simp add: invoke_domain_def | wp)+
 
+lemma set_domain_typ_at[wp]:
+  "set_domain t d \<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace>"
+  by (simp add: set_domain_def | wp)+
+
 lemma invoke_domain_typ_at[wp]:
   "\<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace>
      invoke_domain t d
@@ -1348,4 +1349,9 @@ lemma set_mcpriority_no_cap_to_obj_with_diff_ref[wp]:
   "\<lbrace>no_cap_to_obj_with_diff_ref c S\<rbrace> set_mcpriority t mcp \<lbrace>\<lambda>rv. no_cap_to_obj_with_diff_ref c S\<rbrace>"
   by (simp add: set_mcpriority_def thread_set_no_cap_to_trivial tcb_cap_cases_tcb_mcpriority)
 
+lemma set_priority_invs[wp]:
+  "set_priority t p \<lbrace>invs\<rbrace>"
+  unfolding set_priority_def
+  by wpsimp
+
 end
diff --git a/proof/invariant-abstract/Untyped_AI.thy b/proof/invariant-abstract/Untyped_AI.thy
index 8891a97681..6ca4f0c88c 100644
--- a/proof/invariant-abstract/Untyped_AI.thy
+++ b/proof/invariant-abstract/Untyped_AI.thy
@@ -270,12 +270,12 @@ locale Untyped_AI_arch =
   "\<And>ptr sz dev us n s.\<lbrakk>pspace_no_overlap_range_cover ptr sz (s::'state_ext state) \<and> 0 < us \<and> range_cover ptr sz (obj_bits_api CapTableObject us) n \<and> ptr \<noteq> 0
        \<rbrakk>
          \<Longrightarrow> \<forall>y\<in>{0..<n}. s
-                \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object CapTableObject dev us)) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api CapTableObject us)) [0..<n])
+                \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object CapTableObject dev us (cur_domain s))) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api CapTableObject us)) [0..<n])
                            (kheap s)\<rparr> \<turnstile> CNodeCap (ptr_add ptr (y * 2 ^ obj_bits_api CapTableObject us)) us []"
   assumes retype_ret_valid_caps_aobj:
   "\<And>ptr sz s x6 us n dev. \<lbrakk>pspace_no_overlap_range_cover ptr sz (s::'state_ext state) \<and> x6 \<noteq> ASIDPoolObj \<and> range_cover ptr sz (obj_bits_api (ArchObject x6) us) n \<and> ptr \<noteq> 0 \<comment> \<open>; tp = ArchObject x6\<close>\<rbrakk>
             \<Longrightarrow> \<forall>y\<in>{0..<n}. s
-                   \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object (ArchObject x6) dev us)) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api (ArchObject x6) us)) [0..<n])
+                   \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object (ArchObject x6) dev us (cur_domain s))) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api (ArchObject x6) us)) [0..<n])
                               (kheap s)\<rparr> \<turnstile> ArchObjectCap (arch_default_cap x6 (ptr_add ptr (y * 2 ^ obj_bits_api (ArchObject x6) us)) us dev)"
 
   assumes init_arch_objects_descendants_range[wp]:
@@ -1348,8 +1348,6 @@ lemma retype_ret_valid_caps:
         retype_region ptr n us tp dev\<lbrace>\<lambda>rv (s::'state_ext state). \<forall>y\<in>set rv. s \<turnstile> default_cap tp y us dev\<rbrace>"
   apply (simp add: retype_region_def split del: if_split cong: if_cong)
   apply wp
-  apply (simp only: trans_state_update[symmetric] more_update.valid_cap_update)
-  apply wp
   apply (case_tac tp,simp_all)
    defer
       apply ((clarsimp simp:valid_cap_def default_object_def cap_aligned_def
@@ -3022,7 +3020,7 @@ locale Untyped_AI_nonempty_table =
   "\<And>tp oref sz p dev cref.\<lbrace>cap_refs_in_kernel_window and cte_wp_at (\<lambda>c. cap_range (default_cap tp oref sz dev) \<subseteq> cap_range c) p\<rbrace>
      create_cap tp sz p dev (cref, oref) \<lbrace>\<lambda>rv. (cap_refs_in_kernel_window::'state_ext state \<Rightarrow> bool)\<rbrace>"
   assumes nonempty_default[simp]:
-  "\<And>tp S us dev. tp \<noteq> Untyped \<Longrightarrow> \<not> nonempty_table S (default_object tp dev us)"
+  "\<And>tp S us dev. tp \<noteq> Untyped \<Longrightarrow> \<not> nonempty_table S (default_object tp dev us d)"
   assumes nonempty_table_caps_of:
   "\<And>S ko. nonempty_table S ko \<Longrightarrow> caps_of ko = {}"
   assumes init_arch_objects_nonempty_table:
diff --git a/proof/invariant-abstract/VSpacePre_AI.thy b/proof/invariant-abstract/VSpacePre_AI.thy
index bec3a0b40c..1e1824d1a7 100644
--- a/proof/invariant-abstract/VSpacePre_AI.thy
+++ b/proof/invariant-abstract/VSpacePre_AI.thy
@@ -45,10 +45,6 @@ interpretation dmo: non_vspace_non_cap_op "do_machine_op f"
 
 declare not_Some_eq_tuple[simp]
 
-lemma valid_irq_states_arch_state_update[simp]:
-  "valid_irq_states (s\<lparr>arch_state := x\<rparr>) = valid_irq_states s"
-  by(auto simp: valid_irq_states_def)
-
 lemma pull_out_P:
   "P s \<and> (\<forall>c. caps_of_state s p = Some c \<longrightarrow> Q s c) \<longrightarrow> (\<forall>c. caps_of_state s p = Some c \<longrightarrow> P s \<and> Q s c)"
   by blast

From 34ad44c0fb725b90a888eed19d2003b0d6c77b56 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Tue, 12 Nov 2024 15:19:51 +1100
Subject: [PATCH 5/7] design+haskell: createNewCaps sets the domain of TCBs as
 they are created

This removes the threadSet loop at the end of the TCB case which previouly
needed due to ekheap in createObject in Haskell/createNewCaps in design spec.
This should simplify the proofs to some extent.

Co-authored-by: Miki Tanaka <miki.tanaka@data61.csiro.au>
Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 spec/design/skel/Intermediate_H.thy         | 3 +--
 spec/haskell/src/SEL4/Object/ObjectType.lhs | 4 +---
 2 files changed, 2 insertions(+), 5 deletions(-)

diff --git a/spec/design/skel/Intermediate_H.thy b/spec/design/skel/Intermediate_H.thy
index 87798e1a8e..0ccefc5090 100644
--- a/spec/design/skel/Intermediate_H.thy
+++ b/spec/design/skel/Intermediate_H.thy
@@ -48,9 +48,8 @@ defs createNewCaps_def:
 "createNewCaps t regionBase numObjects userSize dev \<equiv>
     (case toAPIType t of
           Some TCBObject \<Rightarrow> (do
-            addrs \<leftarrow> createObjects regionBase numObjects (injectKO (makeObject ::tcb)) 0;
             curdom \<leftarrow> curDomain;
-            mapM_x (\<lambda>tptr. threadSet (tcbDomain_update (\<lambda>_. curdom)) tptr) addrs;
+            addrs \<leftarrow> createObjects regionBase numObjects (injectKO ((makeObject ::tcb)\<lparr>tcbDomain := curdom\<rparr>)) 0;
             return $ map (\<lambda> addr. ThreadCap addr) addrs
           od)
         | Some EndpointObject \<Rightarrow> (do
diff --git a/spec/haskell/src/SEL4/Object/ObjectType.lhs b/spec/haskell/src/SEL4/Object/ObjectType.lhs
index 8fc24967ab..995d312765 100644
--- a/spec/haskell/src/SEL4/Object/ObjectType.lhs
+++ b/spec/haskell/src/SEL4/Object/ObjectType.lhs
@@ -357,10 +357,8 @@ New threads are placed in the current security domain, which must be the domain
 >     let funupd = (\f x v y -> if y == x then v else f y) in
 >     case toAPIType t of
 >         Just TCBObject -> do
->             placeNewObject regionBase (makeObject :: TCB) 0
 >             curdom <- curDomain
->             threadSet (\t -> t { tcbDomain = curdom })
->                 (PPtr $ fromPPtr regionBase)
+>             placeNewObject regionBase ((makeObject :: TCB){tcbDomain = curdom}) 0
 >             return $ ThreadCap (PPtr $ fromPPtr regionBase)
 >         Just EndpointObject -> do
 >             placeNewObject regionBase (makeObject :: Endpoint) 0

From 167ad3b59ef1894f9366b1d59ec3380c4d37e165 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Wed, 13 Nov 2024 19:06:03 +1100
Subject: [PATCH 6/7] aarch64 refine: proof update for det_ext refactor

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 proof/refine/AARCH64/ADT_H.thy         |  79 +--
 proof/refine/AARCH64/ArchAcc_R.thy     |   5 -
 proof/refine/AARCH64/Arch_R.thy        |  24 +-
 proof/refine/AARCH64/CSpace1_R.thy     | 120 ++--
 proof/refine/AARCH64/CSpace_R.thy      |  40 +-
 proof/refine/AARCH64/Detype_R.thy      | 281 ++++----
 proof/refine/AARCH64/Finalise_R.thy    |   9 +-
 proof/refine/AARCH64/Init_R.thy        |  16 +-
 proof/refine/AARCH64/Interrupt_R.thy   |  25 +-
 proof/refine/AARCH64/Invariants_H.thy  |   3 -
 proof/refine/AARCH64/IpcCancel_R.thy   |  22 +-
 proof/refine/AARCH64/Ipc_R.thy         |   4 +-
 proof/refine/AARCH64/KHeap_R.thy       |  27 -
 proof/refine/AARCH64/Refine.thy        |  65 +-
 proof/refine/AARCH64/Retype_R.thy      | 882 ++++++++-----------------
 proof/refine/AARCH64/Schedule_R.thy    | 147 ++---
 proof/refine/AARCH64/StateRelation.thy |  52 +-
 proof/refine/AARCH64/Syscall_R.thy     |  26 +-
 proof/refine/AARCH64/TcbAcc_R.thy      | 561 ++++------------
 proof/refine/AARCH64/Tcb_R.thy         | 110 ++-
 proof/refine/AARCH64/Untyped_R.thy     |  72 +-
 proof/refine/AARCH64/VSpace_R.thy      |   9 +-
 proof/refine/Move_R.thy                |   6 -
 23 files changed, 849 insertions(+), 1736 deletions(-)

diff --git a/proof/refine/AARCH64/ADT_H.thy b/proof/refine/AARCH64/ADT_H.thy
index 5f0f9ed3c8..de24d21310 100644
--- a/proof/refine/AARCH64/ADT_H.thy
+++ b/proof/refine/AARCH64/ADT_H.thy
@@ -281,6 +281,9 @@ definition
       tcb_fault = map_option FaultMap (tcbFault tcb),
       tcb_bound_notification = tcbBoundNotification tcb,
       tcb_mcpriority = tcbMCP tcb,
+      tcb_priority = tcbPriority tcb,
+      tcb_time_slice = tcbTimeSlice tcb,
+      tcb_domain = tcbDomain tcb,
       tcb_arch = ArchTcbMap (tcbArch tcb)\<rparr>"
 
 definition
@@ -831,53 +834,6 @@ proof -
     done
 qed
 
-definition
-  "EtcbMap tcb \<equiv>
-     \<lparr>tcb_priority = tcbPriority tcb,
-      time_slice = tcbTimeSlice tcb,
-      tcb_domain = tcbDomain tcb\<rparr>"
-
-definition absEkheap ::
-  "(machine_word \<rightharpoonup> Structures_H.kernel_object) \<Rightarrow> obj_ref \<Rightarrow> etcb option" where
-  "absEkheap h \<equiv> \<lambda>x.
-     case h x of
-       Some (KOTCB tcb) \<Rightarrow> Some (EtcbMap tcb)
-     | _ \<Rightarrow> None"
-
-lemma absEkheap_correct:
-  assumes pspace_relation: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes ekheap_relation: "ekheap_relation (ekheap s) (ksPSpace s')"
-  assumes vetcbs: "valid_etcbs s"
-  shows "absEkheap (ksPSpace s') = ekheap s"
-  apply (rule ext)
-  apply (clarsimp simp: absEkheap_def split: option.splits Structures_H.kernel_object.splits)
-  apply (subgoal_tac "\<forall>x. (\<exists>tcb. kheap s x = Some (TCB tcb)) =
-                          (\<exists>tcb'. ksPSpace s' x = Some (KOTCB tcb'))")
-   using vetcbs ekheap_relation
-   apply (clarsimp simp: valid_etcbs_def is_etcb_at_def dom_def ekheap_relation_def st_tcb_at_def obj_at_def)
-   apply (erule_tac x=x in allE)+
-   apply (rule conjI, force)
-   apply clarsimp
-   apply (rule conjI, clarsimp simp: EtcbMap_def etcb_relation_def)+
-   apply clarsimp
-  using pspace_relation
-  apply (clarsimp simp add: pspace_relation_def pspace_dom_def UNION_eq
-                              dom_def Collect_eq)
-  apply (rule iffI)
-   apply (erule_tac x=x in allE)+
-   apply (case_tac "ksPSpace s' x", clarsimp)
-    apply (erule_tac x=x in allE, clarsimp)
-   apply clarsimp
-   apply (case_tac a, simp_all add: tcb_relation_cut_def other_obj_relation_def)
-  apply (insert pspace_relation)
-  apply (clarsimp simp: obj_at'_def)
-  apply (erule(1) pspace_dom_relatedE)
-  apply (erule(1) obj_relation_cutsE)
-     apply (clarsimp simp: other_obj_relation_def
-                    split: Structures_A.kernel_object.split_asm  if_split_asm
-                           AARCH64_A.arch_kernel_obj.split_asm)+
-  done
-
 text \<open>The following function can be used to reverse cte_map.\<close>
 definition
   "cteMap cns \<equiv> \<lambda>p.
@@ -1645,13 +1601,6 @@ lemma absSchedulerAction_correct:
 definition
   "absExst s \<equiv>
      \<lparr>work_units_completed_internal = ksWorkUnitsCompleted s,
-      scheduler_action_internal = absSchedulerAction (ksSchedulerAction s),
-      ekheap_internal = absEkheap (ksPSpace s),
-      domain_list_internal = ksDomSchedule s,
-      domain_index_internal = ksDomScheduleIdx s,
-      cur_domain_internal = ksCurDomain s,
-      domain_time_internal = ksDomainTime s,
-      ready_queues_internal = (\<lambda>d p. heap_walk (tcbSchedNexts_of s) (tcbQueueHead (ksReadyQueues s (d, p))) []),
       cdt_list_internal = absCDTList (cteMap (gsCNodes s)) (ctes_of s)\<rparr>"
 
 lemma absExst_correct:
@@ -1659,16 +1608,12 @@ lemma absExst_correct:
   assumes rel: "(s, s') \<in> state_relation"
   shows "absExst s' = exst s"
   apply (rule det_ext.equality)
-           using rel invs invs'
-           apply (simp_all add: absExst_def absSchedulerAction_correct absEkheap_correct
-                                absCDTList_correct[THEN fun_cong] state_relation_def invs_def
-                                valid_state_def ready_queues_relation_def ready_queue_relation_def
-                                invs'_def valid_state'_def
-                                valid_pspace_def valid_sched_def valid_pspace'_def curry_def
-                                fun_eq_iff)
-   apply (fastforce simp: absEkheap_correct)
-  apply (fastforce simp: list_queue_relation_def Let_def dest: heap_ls_is_walk)
-  done
+      using rel invs invs'
+      apply (simp_all add: absExst_def absSchedulerAction_correct
+                           absCDTList_correct[THEN fun_cong] state_relation_def invs_def valid_state_def
+                           ready_queues_relation_def invs'_def valid_state'_def
+                           valid_pspace_def valid_sched_def valid_pspace'_def curry_def fun_eq_iff)
+      done
 
 
 definition
@@ -1677,6 +1622,12 @@ definition
     cdt = absCDT (cteMap (gsCNodes s)) (ctes_of s),
     is_original_cap = absIsOriginalCap (cteMap (gsCNodes s)) (ksPSpace s),
     cur_thread = ksCurThread s, idle_thread = ksIdleThread s,
+    scheduler_action = absSchedulerAction (ksSchedulerAction s),
+    domain_list = ksDomSchedule s,
+    domain_index = ksDomScheduleIdx s,
+    cur_domain = ksCurDomain s,
+    domain_time = ksDomainTime s,
+    ready_queues = (\<lambda>d p. heap_walk (tcbSchedNexts_of s) (tcbQueueHead (ksReadyQueues s (d, p))) []),
     machine_state = observable_memory (ksMachineState s) (user_mem' s),
     interrupt_irq_node = absInterruptIRQNode (ksInterruptState s),
     interrupt_states = absInterruptStates (ksInterruptState s),
diff --git a/proof/refine/AARCH64/ArchAcc_R.thy b/proof/refine/AARCH64/ArchAcc_R.thy
index 8b574600a7..670605d67c 100644
--- a/proof/refine/AARCH64/ArchAcc_R.thy
+++ b/proof/refine/AARCH64/ArchAcc_R.thy
@@ -455,11 +455,6 @@ lemma setObject_PT_corres:
     apply ((simp split: if_split_asm)+)[2]
    apply (simp add: other_obj_relation_def
                split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
-  apply (rule conjI)
-   apply (clarsimp simp: ekheap_relation_def pspace_relation_def)
-   apply (drule_tac x=p in bspec, erule domI)
-   apply (simp add: other_obj_relation_def
-           split: Structures_A.kernel_object.splits)
   apply (extract_conjunct \<open>match conclusion in "ghost_relation _ _ _ _" \<Rightarrow> -\<close>)
    apply (clarsimp simp add: ghost_relation_def)
    apply (erule_tac x="p && ~~ mask (pt_bits (pt_type pt))" in allE)+
diff --git a/proof/refine/AARCH64/Arch_R.thy b/proof/refine/AARCH64/Arch_R.thy
index ff4072cd66..7d16e54654 100644
--- a/proof/refine/AARCH64/Arch_R.thy
+++ b/proof/refine/AARCH64/Arch_R.thy
@@ -96,24 +96,6 @@ lemma createObject_typ_at':
   apply (clarsimp simp: is_aligned_no_overflow_mask)
   done
 
-lemma retype_region2_ext_retype_region_ArchObject:
-  "retype_region ptr n us (ArchObject x)=
-  retype_region2 ptr n us (ArchObject x)"
-  apply (rule ext)
-  apply (simp add: retype_region_def retype_region2_def bind_assoc
-                   retype_region2_ext_def retype_region_ext_def default_ext_def)
-  apply (rule ext)
-  apply (intro monad_eq_split_tail ext)+
-     apply simp
-    apply simp
-   apply (simp add:gets_def get_def bind_def return_def simpler_modify_def )
-   apply (rule_tac x = xc in fun_cong)
-   apply (rule_tac f = do_extended_op in arg_cong)
-   apply (rule ext)
-   apply simp
-  apply simp
-  done
-
 lemma set_cap_device_and_range_aligned:
   "is_aligned ptr sz \<Longrightarrow> \<lbrace>\<lambda>_. True\<rbrace>
     set_cap
@@ -165,7 +147,6 @@ lemma performASIDControlInvocation_corres:
             apply (clarsimp simp:is_cap_simps)
            apply (simp add: free_index_of_def)
           apply (rule corres_split)
-             apply (simp add: retype_region2_ext_retype_region_ArchObject )
              apply (rule corres_retype [where ty="Inl (KOArch (KOASIDPool F))" for F,
                                         unfolded APIType_map2_def makeObjectKO_def,
                                         THEN createObjects_corres',simplified,
@@ -315,9 +296,8 @@ lemma performASIDControlInvocation_corres:
    apply (rule conjI, rule pspace_no_overlap_subset,
          rule pspace_no_overlap_detype[OF caps_of_state_valid])
         apply (simp add:invs_psp_aligned invs_valid_objs is_aligned_neg_mask_eq)+
-   apply (clarsimp simp: detype_def clear_um_def detype_ext_def valid_sched_def valid_etcbs_def
-                         st_tcb_at_kh_def obj_at_kh_def st_tcb_at_def obj_at_def is_etcb_at_def
-                         wrap_ext_det_ext_ext_def)
+   apply (clarsimp simp: detype_def clear_um_def valid_sched_def
+                         st_tcb_at_kh_def obj_at_kh_def st_tcb_at_def obj_at_def)
   apply (simp add: detype_def clear_um_def)
   apply (drule_tac x = "cte_map (aa,ba)" in pspace_relation_cte_wp_atI[OF state_relation_pspace_relation])
     apply (simp add:invs_valid_objs)+
diff --git a/proof/refine/AARCH64/CSpace1_R.thy b/proof/refine/AARCH64/CSpace1_R.thy
index 8cff61483d..d10fe77238 100644
--- a/proof/refine/AARCH64/CSpace1_R.thy
+++ b/proof/refine/AARCH64/CSpace1_R.thy
@@ -1733,37 +1733,30 @@ proof -
     done
 qed
 
-definition pspace_relations where
-  "pspace_relations ekh kh kh' \<equiv> pspace_relation kh kh' \<and> ekheap_relation ekh kh'"
-
 lemma set_cap_not_quite_corres_prequel:
   assumes cr:
-  "pspace_relations (ekheap s) (kheap s) (ksPSpace s')"
+  "pspace_relation (kheap s) (ksPSpace s')"
   "(x,t') \<in> fst (setCTE p' c' s')"
   "valid_objs s" "pspace_aligned s" "pspace_distinct s" "cte_at p s"
   "pspace_aligned' s'" "pspace_distinct' s'"
   assumes c: "cap_relation c (cteCap c')"
   assumes p: "p' = cte_map p"
   shows "\<exists>t. ((),t) \<in> fst (set_cap c p s) \<and>
-             pspace_relations (ekheap t) (kheap t) (ksPSpace t')"
+             pspace_relation (kheap t) (ksPSpace t')"
   using cr
   apply (clarsimp simp: setCTE_def setObject_def in_monad split_def)
   apply (drule(1) updateObject_cte_is_tcb_or_cte[OF _ refl, rotated])
   apply (elim disjE exE conjE)
-   apply (clarsimp simp: lookupAround2_char1 pspace_relations_def)
+   apply (clarsimp simp: lookupAround2_char1)
    apply (frule(5) cte_map_pulls_tcb_to_abstract[OF p])
     apply (simp add: domI)
    apply (frule tcb_cases_related2)
    apply (clarsimp simp: set_cap_def2 split_def bind_def get_object_def
                          simpler_gets_def assert_def fail_def return_def
                          set_object_def get_def put_def)
-   apply (rule conjI)
-    apply (erule(2) pspace_relation_update_tcbs)
-    apply (simp add: c)
-   apply (clarsimp simp: ekheap_relation_def pspace_relation_def)
-   apply (drule bspec, erule domI)
-   apply (clarsimp simp: etcb_relation_def tcb_cte_cases_def split: if_split_asm)
-  apply (clarsimp simp: pspace_relations_def)
+   apply (erule(2) pspace_relation_update_tcbs)
+   apply (simp add: c)
+  apply clarsimp
   apply (frule(5) cte_map_pulls_cte_to_abstract[OF p])
   apply (clarsimp simp: set_cap_def split_def bind_def get_object_def
                         simpler_gets_def assert_def a_type_def fail_def return_def
@@ -1771,24 +1764,20 @@ lemma set_cap_not_quite_corres_prequel:
   apply (erule(1) valid_objsE)
   apply (clarsimp simp: valid_obj_def valid_cs_def valid_cs_size_def exI)
   apply (rule conjI, clarsimp)
-   apply (rule conjI)
-    apply (erule(1) pspace_relation_update_ctes[where cap=c])
-     apply clarsimp
-     apply (intro conjI impI)
-      apply (rule ext, clarsimp simp add: domI p)
-      apply (drule cte_map_inj_eq [OF _ _ cr(6) cr(3-5)])
-       apply (simp add: cte_at_cases domI)
-      apply (simp add: prod_eq_iff)
-     apply (insert p)[1]
-     apply (clarsimp split: option.split Structures_A.kernel_object.split
-                    intro!: ext)
+   apply (erule(1) pspace_relation_update_ctes[where cap=c])
+    apply clarsimp
+    apply (intro conjI impI)
+     apply (rule ext, clarsimp simp add: domI p)
      apply (drule cte_map_inj_eq [OF _ _ cr(6) cr(3-5)])
-      apply (simp add: cte_at_cases domI well_formed_cnode_invsI[OF cr(3)])
-     apply clarsimp
-    apply (simp add: c)
-   apply (clarsimp simp: ekheap_relation_def pspace_relation_def)
-   apply (drule bspec, erule domI)
-   apply (clarsimp simp: etcb_relation_def tcb_cte_cases_def split: if_split_asm)
+      apply (simp add: cte_at_cases domI)
+     apply (simp add: prod_eq_iff)
+    apply (insert p)[1]
+    apply (clarsimp split: option.split Structures_A.kernel_object.split
+                   intro!: ext)
+    apply (drule cte_map_inj_eq [OF _ _ cr(6) cr(3-5)])
+     apply (simp add: cte_at_cases domI well_formed_cnode_invsI[OF cr(3)])
+    apply clarsimp
+   apply (simp add: c)
   apply (simp add: wf_cs_insert)
   done
 
@@ -1801,7 +1790,7 @@ lemma setCTE_pspace_only:
 
 lemma set_cap_not_quite_corres:
   assumes cr:
-  "pspace_relations (ekheap s) (kheap s) (ksPSpace s')"
+  "pspace_relation (kheap s) (ksPSpace s')"
   "cur_thread s = ksCurThread s'"
   "idle_thread s = ksIdleThread s'"
   "machine_state s = ksMachineState s'"
@@ -1818,10 +1807,9 @@ lemma set_cap_not_quite_corres:
   assumes c: "cap_relation c c'"
   assumes p: "p' = cte_map p"
   shows "\<exists>t. ((),t) \<in> fst (set_cap c p s) \<and>
-             pspace_relations (ekheap t) (kheap t) (ksPSpace t') \<and>
+             pspace_relation (kheap t) (ksPSpace t') \<and>
              cdt t = cdt s \<and>
              cdt_list t = cdt_list s \<and>
-             ekheap t = ekheap s \<and>
              scheduler_action t = scheduler_action s \<and>
              ready_queues t = ready_queues s \<and>
              is_original_cap t = is_original_cap s \<and>
@@ -2438,10 +2426,6 @@ lemma capClass_ztc_relation:
        cap_relation c c' \<rbrakk> \<Longrightarrow> capClass c' = PhysicalClass"
   by (auto simp: is_cap_simps)
 
-lemma pspace_relationsD:
-  "\<lbrakk>pspace_relation kh kh'; ekheap_relation ekh kh'\<rbrakk> \<Longrightarrow> pspace_relations ekh kh kh'"
-  by (simp add: pspace_relations_def)
-
 lemma updateCap_corres:
   "\<lbrakk>cap_relation cap cap';
     is_zombie cap \<or> is_cnode_cap cap \<or> is_thread_cap cap \<rbrakk>
@@ -2463,14 +2447,13 @@ lemma updateCap_corres:
     apply fastforce
    apply (clarsimp simp: cte_wp_at_ctes_of)
   apply (clarsimp simp add: state_relation_def)
-  apply (drule(1) pspace_relationsD)
   apply (frule (3) set_cap_not_quite_corres; fastforce?)
    apply (erule cte_wp_at_weakenE, rule TrueI)
   apply clarsimp
   apply (rule bexI)
    prefer 2
    apply simp
-  apply (clarsimp simp: in_set_cap_cte_at_swp pspace_relations_def)
+  apply (clarsimp simp: in_set_cap_cte_at_swp)
   apply (drule updateCap_stuff)
   apply simp
   apply (extract_conjunct \<open>match conclusion in "ghost_relation _ _ _ _" \<Rightarrow> -\<close>)
@@ -2592,24 +2575,6 @@ lemma updateMDB_pspace_relation:
   apply fastforce
   done
 
-lemma updateMDB_ekheap_relation:
-  assumes "(x, s'') \<in> fst (updateMDB p f s')"
-  assumes "ekheap_relation (ekheap s) (ksPSpace s')"
-  shows "ekheap_relation (ekheap s) (ksPSpace s'')" using assms
-  apply (clarsimp simp: updateMDB_def Let_def setCTE_def setObject_def in_monad ekheap_relation_def etcb_relation_def split_def split: if_split_asm)
-  apply (drule(1) updateObject_cte_is_tcb_or_cte[OF _ refl, rotated])
-  apply (drule_tac P="(=) s'" in use_valid [OF _ getCTE_sp], rule refl)
-  apply (drule bspec, erule domI)
-  apply (clarsimp simp: tcb_cte_cases_def lookupAround2_char1 split: if_split_asm)
-  done
-
-lemma updateMDB_pspace_relations:
-  assumes "(x, s'') \<in> fst (updateMDB p f s')"
-  assumes "pspace_relations (ekheap s) (kheap s) (ksPSpace s')"
-  assumes "pspace_aligned' s'" "pspace_distinct' s'"
-  shows "pspace_relations (ekheap s) (kheap s) (ksPSpace s'')" using assms
-  by (simp add: pspace_relations_def updateMDB_pspace_relation updateMDB_ekheap_relation)
-
 lemma updateMDB_ctes_of:
   assumes "(x, s') \<in> fst (updateMDB p f s)"
   assumes "no_0 (ctes_of s)"
@@ -2654,7 +2619,7 @@ crunch updateMDB
 
 lemma updateMDB_the_lot:
   assumes "(x, s'') \<in> fst (updateMDB p f s')"
-  assumes "pspace_relations (ekheap s) (kheap s) (ksPSpace s')"
+  assumes "pspace_relation (kheap s) (ksPSpace s')"
   assumes "pspace_aligned' s'" "pspace_distinct' s'" "no_0 (ctes_of s')"
   shows "ctes_of s'' = modify_map (ctes_of s') p (cteMDBNode_update f) \<and>
          ksMachineState s'' = ksMachineState s' \<and>
@@ -2667,7 +2632,7 @@ lemma updateMDB_the_lot:
          ksArchState s'' = ksArchState s' \<and>
          gsUserPages s'' = gsUserPages s' \<and>
          gsCNodes s'' = gsCNodes s' \<and>
-         pspace_relations (ekheap s) (kheap s) (ksPSpace s'') \<and>
+         pspace_relation (kheap s) (ksPSpace s'') \<and>
          pspace_aligned' s'' \<and> pspace_distinct' s'' \<and>
          no_0 (ctes_of s'') \<and>
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
@@ -2679,7 +2644,7 @@ lemma updateMDB_the_lot:
          (\<forall>domain priority.
             (inQ domain priority |< tcbs_of' s'') = (inQ domain priority |< tcbs_of' s'))"
 using assms
-  apply (simp add: updateMDB_eqs updateMDB_pspace_relations split del: if_split)
+  apply (simp add: updateMDB_eqs updateMDB_pspace_relation split del: if_split)
   apply (frule (1) updateMDB_ctes_of)
   apply clarsimp
   apply (rule conjI)
@@ -3869,7 +3834,6 @@ lemma setCTE_UntypedCap_corres:
    apply (clarsimp simp: cte_wp_at_ctes_of)
   apply clarsimp
   apply (clarsimp simp add: state_relation_def split_def)
-  apply (drule (1) pspace_relationsD)
   apply (frule_tac c = "cap.UntypedCap dev r bits idx"
                 in set_cap_not_quite_corres_prequel)
          apply assumption+
@@ -3880,8 +3844,6 @@ lemma setCTE_UntypedCap_corres:
   apply (rule bexI)
    prefer 2
    apply assumption
-  apply (clarsimp simp: pspace_relations_def)
-  apply (subst conj_assoc[symmetric])
   apply clarsimp
   apply (rule conjI)
    apply (frule setCTE_pspace_only)
@@ -3893,7 +3855,7 @@ lemma setCTE_UntypedCap_corres:
    apply (rule use_valid[OF _ setCTE_tcbSchedNexts_of], assumption)
    apply (rule use_valid[OF _ setCTE_ksReadyQueues], assumption)
    apply (rule use_valid[OF _ setCTE_inQ_opt_pred], assumption)
-   apply (rule use_valid[OF _ set_cap_exst], assumption)
+   apply (rule use_valid[OF _ set_cap_rqueues], assumption)
    apply clarsimp
   apply (rule conjI)
    apply (frule setCTE_pspace_only)
@@ -5156,8 +5118,8 @@ crunch set_untyped_cap_as_full
 
 lemma updateMDB_the_lot':
   assumes "(x, s'') \<in> fst (updateMDB p f s')"
-  assumes "pspace_relations (ekheap sa) (kheap s) (ksPSpace s')"
-  assumes "pspace_aligned' s'" "pspace_distinct' s'" "no_0 (ctes_of s')" "ekheap s = ekheap sa"
+  assumes "pspace_relation (kheap s) (ksPSpace s')"
+  assumes "pspace_aligned' s'" "pspace_distinct' s'" "no_0 (ctes_of s')"
   shows "ctes_of s'' = modify_map (ctes_of s') p (cteMDBNode_update f) \<and>
          ksMachineState s'' = ksMachineState s' \<and>
          ksWorkUnitsCompleted s'' = ksWorkUnitsCompleted s' \<and>
@@ -5169,7 +5131,7 @@ lemma updateMDB_the_lot':
          ksArchState s'' = ksArchState s' \<and>
          gsUserPages s'' = gsUserPages s' \<and>
          gsCNodes s'' = gsCNodes s' \<and>
-         pspace_relations (ekheap s) (kheap s) (ksPSpace s'') \<and>
+         pspace_relation (kheap s) (ksPSpace s'') \<and>
          pspace_aligned' s'' \<and> pspace_distinct' s'' \<and>
          no_0 (ctes_of s'') \<and>
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
@@ -5182,7 +5144,7 @@ lemma updateMDB_the_lot':
             (inQ domain priority |< tcbs_of' s'') = (inQ domain priority |< tcbs_of' s'))"
   apply (rule updateMDB_the_lot)
       using assms
-      apply (fastforce simp: pspace_relations_def)+
+      apply fastforce+
    done
 
 lemma cte_map_inj_eq':
@@ -5247,7 +5209,6 @@ lemma cteInsert_corres:
                apply (simp+)[3]
             apply (clarsimp simp: corres_underlying_def state_relation_def
                                   in_monad valid_mdb'_def valid_mdb_ctes_def)
-            apply (drule (1) pspace_relationsD)
             apply (drule (18) set_cap_not_quite_corres)
              apply (rule refl)
             apply (elim conjE exE)
@@ -5286,7 +5247,6 @@ lemma cteInsert_corres:
             apply (thin_tac "ksCurThread t = p" for p t)+
             apply (thin_tac "ksIdleThread t = p" for p t)+
             apply (thin_tac "ksSchedulerAction t = p" for p t)+
-            apply (clarsimp simp: pspace_relations_def)
 
             apply (rule conjI)
              apply (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def)
@@ -6724,7 +6684,6 @@ lemma cteSwap_corres:
   apply (clarsimp simp: corres_underlying_def in_monad
                         state_relation_def)
   apply (clarsimp simp: valid_mdb'_def)
-  apply (drule(1) pspace_relationsD)
   apply (drule (12) set_cap_not_quite_corres)
       apply (erule cte_wp_at_weakenE, rule TrueI)
      apply assumption+
@@ -6760,20 +6719,19 @@ lemma cteSwap_corres:
   apply (simp cong: option.case_cong)
   apply (drule updateCap_stuff, elim conjE, erule(1) impE)
   apply (drule (2) updateMDB_the_lot')
-     apply (erule (1) impE, assumption)
-    apply (fastforce simp only: no_0_modify_map)
-   apply assumption
+    apply (erule (1) impE, assumption)
+   apply (fastforce simp only: no_0_modify_map)
   apply (elim conjE TrueE, simp only:)
-  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map)
   apply (drule in_getCTE, elim conjE, simp only:)
-  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map)
   apply (elim conjE TrueE, simp only:)
-  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map)
   apply (elim conjE TrueE, simp only:)
-  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map)
   apply (elim conjE TrueE, simp only:)
-  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
-  apply (simp only: pspace_relations_def refl)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map)
+  apply (simp only: refl)
   apply (rule conjI, rule TrueI)+
   apply (thin_tac "ksMachineState t = p" for t p)+
   apply (thin_tac "ksCurThread t = p" for t p)+
@@ -6822,7 +6780,6 @@ lemma cteSwap_corres:
   apply (thin_tac "domain_index t = p" for t p)+
   apply (thin_tac "domain_list t = p" for t p)+
   apply (thin_tac "domain_time t = p" for t p)+
-  apply (thin_tac "ekheap t = p" for t p)+
   apply (thin_tac "scheduler_action t = p" for t p)+
   apply (thin_tac "ksArchState t = p" for t p)+
   apply (thin_tac "gsCNodes t = p" for t p)+
@@ -6831,7 +6788,6 @@ lemma cteSwap_corres:
   apply (thin_tac "ksIdleThread t = p" for t p)+
   apply (thin_tac "gsUserPages t = p" for t p)+
   apply (thin_tac "pspace_relation s s'" for s s')+
-  apply (thin_tac "ekheap_relation e p" for e p)+
   apply (thin_tac "interrupt_state_relation n s s'" for n s s')+
   apply (thin_tac "(s,s') \<in> arch_state_relation" for s s')+
   apply (rule conjI)
diff --git a/proof/refine/AARCH64/CSpace_R.thy b/proof/refine/AARCH64/CSpace_R.thy
index acabae6d98..265010391f 100644
--- a/proof/refine/AARCH64/CSpace_R.thy
+++ b/proof/refine/AARCH64/CSpace_R.thy
@@ -694,8 +694,7 @@ lemma next_slot_eq2:
 
 lemma set_cap_not_quite_corres':
   assumes cr:
-  "pspace_relations (ekheap (a)) (kheap s) (ksPSpace s')"
-  "ekheap (s)      = ekheap (a)"
+  "pspace_relation (kheap s) (ksPSpace s')"
   "cur_thread s    = ksCurThread s'"
   "idle_thread s   = ksIdleThread s'"
   "machine_state s = ksMachineState s'"
@@ -712,10 +711,9 @@ lemma set_cap_not_quite_corres':
   assumes c: "cap_relation c c'"
   assumes p: "p' = cte_map p"
   shows "\<exists>t. ((),t) \<in> fst (set_cap c p s) \<and>
-             pspace_relations (ekheap t) (kheap t) (ksPSpace t') \<and>
+             pspace_relation (kheap t) (ksPSpace t') \<and>
              cdt t              = cdt s \<and>
              cdt_list t         = cdt_list (s) \<and>
-             ekheap t           = ekheap (s) \<and>
              scheduler_action t = scheduler_action (s) \<and>
              ready_queues t     = ready_queues (s) \<and>
              is_original_cap t  = is_original_cap s \<and>
@@ -732,7 +730,7 @@ lemma set_cap_not_quite_corres':
              domain_time t   = ksDomainTime t'"
   apply (rule set_cap_not_quite_corres)
                 using cr
-                apply (fastforce simp: c p pspace_relations_def)+
+                apply (fastforce simp: c p)+
                 done
 
 context begin interpretation Arch . (*FIXME: arch-split*)
@@ -804,7 +802,6 @@ lemma cteMove_corres:
      apply fastforce
     apply fastforce
    apply fastforce
-   apply (drule (1) pspace_relationsD)
    apply (drule_tac p=ptr' in set_cap_not_quite_corres, assumption+)
             apply fastforce
            apply fastforce
@@ -864,7 +861,7 @@ lemma cteMove_corres:
   apply (frule(1) use_valid [OF _ updateCap_no_0])
   apply (frule(2) use_valid [OF _ updateCap_no_0, OF _ use_valid [OF _ updateCap_no_0]])
   apply (elim conjE)
-  apply (drule (5) updateMDB_the_lot', elim conjE)
+  apply (drule (4) updateMDB_the_lot', elim conjE)
   apply (drule (4) updateMDB_the_lot, elim conjE)
   apply (drule (4) updateMDB_the_lot, elim conjE)
   apply (drule (4) updateMDB_the_lot, elim conjE)
@@ -892,7 +889,6 @@ lemma cteMove_corres:
      apply fastforce
     apply fastforce
    apply fastforce
-  apply (clarsimp simp: pspace_relations_def)
   apply (rule conjI)
    subgoal by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def)
   apply (thin_tac "gsCNodes t = p" for t p)+
@@ -913,7 +909,6 @@ lemma cteMove_corres:
   apply (thin_tac "ksDomScheduleIdx t = p" for t p)+
   apply (thin_tac "ksDomainTime t = p" for t p)+
   apply (thin_tac "ksDomSchedule t = p" for t p)+
-  apply (thin_tac "ekheap_relation t p" for t p)+
   apply (thin_tac "pspace_relation t p" for t p)+
   apply (thin_tac "interrupt_state_relation s t p" for s t p)+
   apply (thin_tac "ghost_relation s t p q" for s t p q)+
@@ -3538,7 +3533,7 @@ lemma deriveCap_untyped_derived:
 
 lemma setCTE_corres:
   "cap_relation cap (cteCap cte) \<Longrightarrow>
-   corres_underlying {(s, s'). pspace_relations (ekheap (s)) (kheap s) (ksPSpace s')} False True dc
+   corres_underlying {(s, s'). pspace_relation (kheap s) (ksPSpace s')} False True dc
       (pspace_distinct and pspace_aligned and valid_objs and cte_at p)
       (pspace_aligned' and pspace_distinct' and cte_at' (cte_map p))
       (set_cap cap p)
@@ -3604,7 +3599,7 @@ lemma ghost_relation_of_heap:
   done
 
 lemma corres_caps_decomposition:
-  assumes x: "corres_underlying {(s, s'). pspace_relations (ekheap (s)) (kheap s) (ksPSpace s')} False True r P P' f g"
+  assumes x: "corres_underlying {(s, s'). pspace_relation (kheap s) (ksPSpace s')} False True r P P' f g"
   assumes u: "\<And>P. \<lbrace>\<lambda>s. P (new_caps s)\<rbrace> f \<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_mdb s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cdt s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_list s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cdt_list (s))\<rbrace>"
@@ -3717,13 +3712,11 @@ proof -
   note abs_irq_together = abs_irq_together'[simplified]
   show ?thesis
     unfolding state_relation_def swp_cte_at
-    apply (subst conj_assoc[symmetric])
-    apply (subst pspace_relations_def[symmetric])
     apply (rule corres_underlying_decomposition [OF x])
      apply (simp add: ghost_relation_of_heap)
      apply (wpsimp wp: hoare_vcg_conj_lift mdb_wp rvk_wp list_wp u abs_irq_together simp: pt_types_of_heap_eq)+
-    apply (intro z[simplified o_def] conjI | simp add: state_relation_def pspace_relations_def swp_cte_at
-          | (clarsimp, drule (1) z(6), simp add: state_relation_def pspace_relations_def swp_cte_at))+
+    apply (intro z[simplified o_def] conjI | simp add: state_relation_def swp_cte_at
+          | (drule (1) z(6), simp add: state_relation_def swp_cte_at))+
     done
 qed
 
@@ -3735,7 +3728,7 @@ lemma getCTE_symb_exec_r:
   done
 
 lemma updateMDB_symb_exec_r:
-  "corres_underlying {(s, s'). pspace_relations (ekheap s) (kheap s) (ksPSpace s')} False nf' dc
+  "corres_underlying {(s, s'). pspace_relation (kheap s) (ksPSpace s')} False nf' dc
         \<top> (pspace_aligned' and pspace_distinct' and (no_0 \<circ> ctes_of) and (\<lambda>s. p \<noteq> 0 \<longrightarrow> cte_at' p s))
         (return ()) (updateMDB p m)"
   using no_fail_updateMDB [of p m]
@@ -3782,9 +3775,13 @@ crunch setCTE
   (simp: setObject_def wp: updateObject_cte_inv)
 
 lemma set_original_symb_exec_l':
-  "corres_underlying {(s, s'). f (ekheap s) (kheap s) s'} False nf' dc P P' (set_original p b) (return x)"
+  "corres_underlying {(s, s'). f (kheap s) s'} False nf' dc P P' (set_original p b) (return x)"
   by (simp add: corres_underlying_def return_def set_original_def in_monad Bex_def)
 
+crunch set_cap
+  for domain_index[wp]: "\<lambda>s. P (domain_index s)"
+  (wp: set_object_wp)
+
 lemma create_reply_master_corres:
   "\<lbrakk> sl' = cte_map sl ; AllowGrant \<in> rights \<rbrakk> \<Longrightarrow>
    corres dc
@@ -4772,7 +4769,6 @@ lemma cteInsert_simple_corres:
                apply (simp+)[3]
             apply (clarsimp simp: corres_underlying_def state_relation_def
                                   in_monad valid_mdb'_def valid_mdb_ctes_def)
-            apply (drule (1) pspace_relationsD)
             apply (drule (18) set_cap_not_quite_corres)
              apply (rule refl)
             apply (elim conjE exE)
@@ -4799,7 +4795,7 @@ lemma cteInsert_simple_corres:
             apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE)
             apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE)
             apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE)
-            apply (clarsimp simp: pspace_relations_def)
+            apply clarsimp
             apply (rule conjI)
              subgoal by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def)
             apply (thin_tac "gsCNodes t = p" for t p)+
@@ -4826,7 +4822,6 @@ lemma cteInsert_simple_corres:
             apply (thin_tac "ksDomainTime t = p" for t p)+
             apply (thin_tac "ksDomSchedule t = p" for t p)+
             apply (thin_tac "ctes_of t = p" for t p)+
-            apply (thin_tac "ekheap_relation t p" for t p)+
             apply (thin_tac "pspace_relation t p" for t p)+
             apply (thin_tac "interrupt_state_relation s t p" for s t p)+
             apply (thin_tac "sched_act_relation t p" for t p)+
@@ -5990,7 +5985,7 @@ lemma setCTE_set_cap_ready_queues_relation_valid_corres:
   shows "ready_queues_relation t t'"
   apply (clarsimp simp: ready_queues_relation_def)
   apply (insert pre)
-  apply (rule use_valid[OF step_abs set_cap_exst])
+  apply (rule use_valid[OF step_abs set_cap_rqueues])
   apply (rule use_valid[OF step_conc setCTE_ksReadyQueues])
   apply (rule use_valid[OF step_conc setCTE_tcbSchedNexts_of])
   apply (rule use_valid[OF step_conc setCTE_tcbSchedPrevs_of])
@@ -6016,7 +6011,6 @@ lemma updateCap_same_master:
         apply (clarsimp simp: cte_wp_at_ctes_of)
        apply clarsimp
        apply (clarsimp simp add: state_relation_def)
-       apply (drule (1) pspace_relationsD)
        apply (frule (4) set_cap_not_quite_corres_prequel)
             apply (erule cte_wp_at_weakenE, rule TrueI)
            apply assumption
@@ -6027,7 +6021,7 @@ lemma updateCap_same_master:
        apply (rule bexI)
         prefer 2
         apply assumption
-       apply (clarsimp simp: pspace_relations_def)
+       apply clarsimp
        apply (subst conj_assoc[symmetric])
        apply (extract_conjunct \<open>match conclusion in "ready_queues_relation a b" for a b \<Rightarrow> -\<close>)
         subgoal by (erule setCTE_set_cap_ready_queues_relation_valid_corres; assumption)
diff --git a/proof/refine/AARCH64/Detype_R.thy b/proof/refine/AARCH64/Detype_R.thy
index cecc4b5bd0..f997f5f665 100644
--- a/proof/refine/AARCH64/Detype_R.thy
+++ b/proof/refine/AARCH64/Detype_R.thy
@@ -869,11 +869,6 @@ lemma corres_machine_op:
    apply (simp_all add: state_relation_def swp_def)
   done
 
-lemma ekheap_relation_detype:
-  "ekheap_relation ekh kh \<Longrightarrow>
-   ekheap_relation (\<lambda>x. if P x then None else (ekh x)) (\<lambda>x. if P x then None else (kh x))"
-  by (fastforce simp add: ekheap_relation_def split: if_split_asm)
-
 lemma cap_table_at_gsCNodes_eq:
   "(s, s') \<in> state_relation
     \<Longrightarrow> (gsCNodes s' ptr = Some bits) = cap_table_at bits ptr s"
@@ -1017,11 +1012,11 @@ lemma detype_ready_queues_relation:
          tcb_of' |>
          tcbSchedPrev)
         (\<lambda>d p. inQ d p |< ((\<lambda>x. if lower \<le> x \<and> x \<le> upper then None else ksPSpace s' x) |> tcb_of'))"
-  apply (clarsimp simp: detype_ext_def ready_queues_relation_def Let_def)
+  apply (clarsimp simp: ready_queues_relation_def Let_def)
   apply (frule (1) detype_tcbSchedNexts_of[where S="{lower..upper}"]; simp)
   apply (frule (1) detype_tcbSchedPrevs_of[where S="{lower..upper}"]; simp)
   apply (frule (1) detype_inQ[where S="{lower..upper}"]; simp)
-  apply (fastforce simp add: detype_def detype_ext_def wrap_ext_det_ext_ext_def)
+  apply (fastforce simp add: detype_def wrap_ext_det_ext_ext_def)
   done
 
 lemma deleteObjects_corres:
@@ -1084,35 +1079,32 @@ lemma deleteObjects_corres:
         apply (simp add: valid_pspace'_def)
         apply (rule state_relation_null_filterE, assumption,
                simp_all add: pspace_aligned'_cut pspace_distinct'_cut)[1]
-                apply (simp add: detype_def, rule state.equality;
-                       simp add: detype_ext_def wrap_ext_det_ext_ext_def)
-               apply (intro exI, fastforce)
-              apply (rule ext, clarsimp simp add: null_filter_def)
-              apply (rule sym, rule ccontr, clarsimp)
-              apply (drule(4) cte_map_not_null_outside')
-               apply (fastforce simp add: cte_wp_at_caps_of_state)
-              apply simp
-             apply (rule ext, clarsimp simp: null_filter'_def map_to_ctes_delete)
+               apply (simp add: detype_def)
+              apply (intro exI, fastforce)
+             apply (rule ext, clarsimp simp add: null_filter_def)
              apply (rule sym, rule ccontr, clarsimp)
-             apply (frule(2) pspace_relation_cte_wp_atI
-                             [OF state_relation_pspace_relation])
-             apply (elim exE)
-             apply (frule(4) cte_map_not_null_outside')
-              apply (rule cte_wp_at_weakenE, erule conjunct1)
-              apply (case_tac y, clarsimp)
-              apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def
-                                    valid_nullcaps_def)
-             apply clarsimp
-             apply (frule_tac cref="(aa, ba)" in cte_map_untyped_range,
-                    erule cte_wp_at_weakenE[OF _ TrueI], assumption+)
-             apply (simp add: add_mask_fold)
+             apply (drule(4) cte_map_not_null_outside')
+              apply (fastforce simp add: cte_wp_at_caps_of_state)
+             apply simp
+            apply (rule ext, clarsimp simp: null_filter'_def map_to_ctes_delete)
+            apply (rule sym, rule ccontr, clarsimp)
+            apply (frule(2) pspace_relation_cte_wp_atI
+                            [OF state_relation_pspace_relation])
+            apply (elim exE)
+            apply (frule(4) cte_map_not_null_outside')
+             apply (rule cte_wp_at_weakenE, erule conjunct1)
+             apply (case_tac y, clarsimp)
+             apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def
+                                   valid_nullcaps_def)
+            apply clarsimp
+            apply (frule_tac cref="(aa, ba)" in cte_map_untyped_range,
+                   erule cte_wp_at_weakenE[OF _ TrueI], assumption+)
             apply (simp add: add_mask_fold)
-            apply (rule detype_pspace_relation[simplified],
-                   simp_all add: state_relation_pspace_relation valid_pspace_def)[1]
-             apply (simp add: valid_cap'_def capAligned_def)
-            apply (clarsimp simp: valid_cap_def, assumption)
-           apply (fastforce simp: detype_def detype_ext_def add_mask_fold wrap_ext_det_ext_ext_def
-                            intro!: ekheap_relation_detype)
+           apply (simp add: add_mask_fold)
+           apply (rule detype_pspace_relation[simplified],
+                  simp_all add: state_relation_pspace_relation valid_pspace_def)[1]
+            apply (simp add: valid_cap'_def capAligned_def)
+           apply (clarsimp simp: valid_cap_def, assumption)
           apply (rule detype_ready_queues_relation; blast?)
             apply (clarsimp simp: deletionIsSafe_delete_locale_def)
            apply (erule state_relation_ready_queues_relation)
@@ -3232,23 +3224,19 @@ lemma createObject_setCTE_commute:
                        cteSizeBits_def)
             \<comment> \<open>Untyped\<close>
             apply (simp add: monad_commute_guard_imp[OF return_commute])
-           \<comment> \<open>TCB, EP, NTFN\<close>
+           \<comment> \<open>TCB\<close>
            apply (rule monad_commute_guard_imp[OF commute_commute])
-            apply (rule monad_commute_split[OF monad_commute_split])
-                apply (rule monad_commute_split[OF commute_commute[OF return_commute]])
-                 apply (rule setCTE_modify_tcbDomain_commute)
-                apply wp
-               apply (rule curDomain_commute)
-               apply wp+
-             apply (rule setCTE_placeNewObject_commute)
-            apply (wp  placeNewObject_tcb_at' placeNewObject_cte_wp_at'
-              placeNewObject_pspace_distinct'
-              placeNewObject_pspace_aligned'
-              | clarsimp simp: objBits_simps')+
-           apply (rule monad_commute_guard_imp[OF commute_commute]
-            ,rule monad_commute_split[OF commute_commute[OF return_commute]]
-            ,rule setCTE_placeNewObject_commute
-            ,(wp|clarsimp simp: objBits_simps')+)+
+            apply (rule monad_commute_split[OF monad_commute_split[OF commute_commute]])
+                apply (rule return_commute)
+               apply (rule setCTE_placeNewObject_commute)
+              apply wp
+             apply (rule curDomain_commute)
+             apply (wpsimp simp: objBits_simps')+
+          \<comment> \<open>EP, NTFN\<close>
+          apply (rule monad_commute_guard_imp[OF commute_commute],
+                 rule monad_commute_split[OF commute_commute[OF return_commute]],
+                 rule setCTE_placeNewObject_commute,
+                 (wpsimp simp: objBits_simps')+)+
         \<comment> \<open>CNode\<close>
         apply (rule monad_commute_guard_imp[OF commute_commute])
          apply (rule monad_commute_split)+
@@ -4487,6 +4475,34 @@ lemma createTCBs_tcb_at':
   apply (simp add: objBits_simps shiftl_t2n)
   done
 
+lemma curDomain_createObjects'_comm:
+  "do x \<leftarrow> createObjects' ptr n obj us;
+      y \<leftarrow> curDomain;
+      m x y
+   od =
+   do y \<leftarrow> curDomain;
+      x \<leftarrow> createObjects' ptr n obj us;
+      m x y
+   od"
+  apply (rule ext)
+  apply (case_tac x)
+  by (auto simp: createObjects'_def split_def bind_assoc return_def unless_def
+                 when_def simpler_gets_def alignError_def fail_def assert_def
+                 bind_def curDomain_def modify_def get_def put_def
+          split: option.splits)
+
+lemma curDomain_twice_simp:
+  "do x \<leftarrow> curDomain;
+      y \<leftarrow> curDomain;
+      m x y
+   od =
+   do x \<leftarrow> curDomain;
+      m x x
+   od"
+  apply (rule ext)
+  apply (case_tac x)
+  by (auto simp: simpler_gets_def bind_def curDomain_def)
+
 lemma createNewCaps_Cons:
   assumes cover:"range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n))"
   and "valid_pspace' s" "valid_arch_state' s"
@@ -4585,91 +4601,40 @@ proof -
                                apiGetObjectSize_def shiftl_t2n field_simps
                                shiftL_nat mapM_x_def sequence_x_def append
                                fromIntegral_def integral_inv[unfolded Fun.comp_def])
-             \<comment> \<open>TCB, EP, NTFN\<close>
-             apply (simp add: bind_assoc
-                              AARCH64_H.getObjectSize_def
-                              sequence_def Retype_H.createObject_def
-                              AARCH64_H.toAPIType_def
+             \<comment> \<open>TCB\<close>
+             apply (simp add: bind_assoc AARCH64_H.getObjectSize_def
+                              mapM_def sequence_def Retype_H.createObject_def
+                              AARCH64_H.toAPIType_def objBitsKO_def
                               createObjects_def AARCH64_H.createObject_def
-                              Arch_createNewCaps_def comp_def
+                              Arch_createNewCaps_def comp_def append
                               apiGetObjectSize_def shiftl_t2n field_simps
-                              shiftL_nat append mapM_x_append2
-                              fromIntegral_def integral_inv[unfolded Fun.comp_def])+
-             apply (subst monad_eq)
-              apply (rule createObjects_Cons)
-                   apply (simp add: field_simps shiftl_t2n bind_assoc pageBits_def
-                                    objBits_simps placeNewObject_def2)+
-             apply (rule_tac Q = "\<lambda>r s. pspace_aligned' s \<and>
-                 pspace_distinct' s \<and>
-                 pspace_no_overlap' (ptr + (2^tcbBlockSizeBits + of_nat n * 2^tcbBlockSizeBits)) (objBitsKO (KOTCB makeObject)) s \<and>
-                 range_cover (ptr + 2^tcbBlockSizeBits) sz
-                 (objBitsKO (KOTCB makeObject)) (Suc n)
-                 \<and> (\<forall>x\<in>set [0.e.of_nat n]. tcb_at' (ptr + x * 2^tcbBlockSizeBits) s)"
-                 in monad_eq_split2)
-                apply simp
-               apply (subst monad_commute_simple[symmetric])
-                 apply (rule commute_commute[OF curDomain_commute])
-                 apply wpsimp+
-               apply (rule_tac Q = "\<lambda>r s. r = (ksCurDomain s) \<and>
-                 pspace_aligned' s \<and>
-                 pspace_distinct' s \<and>
-                 pspace_no_overlap' (ptr + (2^tcbBlockSizeBits + of_nat n * 2^tcbBlockSizeBits)) (objBitsKO (KOTCB makeObject)) s \<and>
-                 range_cover (ptr + 2^tcbBlockSizeBits) sz
-                 (objBitsKO (KOTCB makeObject)) (Suc n)
-                 \<and> (\<forall>x\<in>set [0.e.of_nat n]. tcb_at' (ptr + x * 2^tcbBlockSizeBits) s)
-               " in  monad_eq_split)
-                 apply (subst monad_commute_simple[symmetric])
-                   apply (rule createObjects_setDomains_commute)
-                  apply (clarsimp simp:objBits_simps)
-                  apply (rule conj_impI)
-                   apply (erule aligned_add_aligned)
-                    apply (rule aligned_add_aligned[where n = tcbBlockSizeBits])
-                      apply (simp add:is_aligned_def objBits_defs)
-                     apply (cut_tac is_aligned_shift[where m = tcbBlockSizeBits and k = "of_nat n",
-                                                     unfolded shiftl_t2n,simplified])
-                     apply (simp add:field_simps)+
-                  apply (erule range_cover_full)
-                  apply (simp add: word_bits_conv objBits_defs)
-                 apply (rule_tac Q = "\<lambda>x s. (ksCurDomain s) = r" in monad_eq_split2)
-                    apply simp
-                   apply (rule_tac Q = "\<lambda>x s. (ksCurDomain s) = r" in monad_eq_split)
-                     apply (subst rewrite_step[where f = curDomain and
-                                               P ="\<lambda>s. ksCurDomain s = r" and f' = "return r"])
-                       apply (simp add:curDomain_def bind_def gets_def get_def)
-                      apply simp
-                     apply (simp add:mapM_x_singleton)
-                    apply wp
-                   apply simp
-                  apply (wp mapM_x_wp')
-                 apply simp
-                apply (simp add:curDomain_def,wp)
-               apply simp
-              apply (wp createObjects'_psp_aligned[where sz = sz]
-                        createObjects'_psp_distinct[where sz = sz])
-              apply (rule hoare_vcg_conj_lift)
-               apply (rule hoare_post_imp[OF _
-                             createObjects'_pspace_no_overlap[unfolded shiftl_t2n,
-                               where gz = tcbBlockSizeBits and sz = sz, simplified]])
-                apply (simp add:objBits_simps field_simps)
-               apply (simp add: objBits_simps)
-              apply (wp createTCBs_tcb_at'[where sz = sz])
-             apply (clarsimp simp:objBits_simps word_bits_def field_simps)
-             apply (frule range_cover_le[where n = "Suc n"],simp+)
-             apply (drule range_cover_offset[where p = 1,rotated])
-              apply simp
-             apply (simp add: objBits_defs)
-            apply (((simp add: bind_assoc
-                        AARCH64_H.getObjectSize_def
-                        mapM_def sequence_def Retype_H.createObject_def
-                        AARCH64_H.toAPIType_def
-                        createObjects_def AARCH64_H.createObject_def
-                        Arch_createNewCaps_def comp_def
-                        apiGetObjectSize_def shiftl_t2n field_simps
-                        shiftL_nat mapM_x_def sequence_x_def append
-                        fromIntegral_def integral_inv[unfolded Fun.comp_def])+
-                     , subst monad_eq, rule createObjects_Cons
-                     , (simp add: field_simps shiftl_t2n bind_assoc pageBits_def
-                                 objBits_simps placeNewObject_def2)+)+)[2]
+                              shiftL_nat fromIntegral_def integral_inv[unfolded Fun.comp_def])
+             apply (subst curDomain_createObjects'_comm)
+             apply (subst curDomain_twice_simp)
+             apply (simp add: monad_eq_simp_state)
+             apply (intro conjI; clarsimp simp: in_monad)
+               apply ((fastforce simp: curDomain_def simpler_gets_def return_def placeNewObject_def2
+                                       field_simps shiftl_t2n bind_assoc objBits_simps in_monad
+                                       createObjects_Cons[where
+                                         val="KOTCB (tcbDomain_update (\<lambda>_. ksCurDomain s) makeObject)"
+                                         and s=s, simplified objBitsKO_def])+)[2]
+             apply ((clarsimp simp: curDomain_def simpler_gets_def return_def split_def bind_def
+                                   field_simps shiftl_t2n bind_assoc objBits_simps placeNewObject_def2
+                                   createObjects_Cons[where
+                                     val="KOTCB (tcbDomain_update (\<lambda>_. ksCurDomain s) makeObject)"
+                                     and s=s, simplified objBitsKO_def])+)[1]
+            \<comment> \<open>EP, NTFN\<close>
+            apply (((simp add: AARCH64_H.getObjectSize_def
+                               mapM_def sequence_def Retype_H.createObject_def
+                               AARCH64_H.toAPIType_def
+                               createObjects_def AARCH64_H.createObject_def
+                               Arch_createNewCaps_def comp_def
+                               apiGetObjectSize_def shiftl_t2n field_simps
+                               shiftL_nat mapM_x_def sequence_x_def append
+                               fromIntegral_def integral_inv[unfolded Fun.comp_def])+,
+                     subst monad_eq, rule createObjects_Cons,
+                     (simp add: field_simps shiftl_t2n bind_assoc pageBits_def
+                                objBits_simps' placeNewObject_def2)+)+)[2]
 
           apply (in_case "CapTableObject")
           apply (simp add: bind_assoc
@@ -4693,6 +4658,7 @@ proof -
           apply (rule arg_cong2[where f=gsCNodes_update, OF ext refl])
           apply (rule ext)
           apply simp
+
          apply (in_case "HugePageObject")
          apply (simp add: Arch_createNewCaps_def
                           Retype_H.createObject_def createObjects_def bind_assoc
@@ -5128,35 +5094,19 @@ lemma createObject_pspace_no_overlap':
    apply wpc
     apply (wp ArchCreateObject_pspace_no_overlap')
    apply wpc
-       apply wp
-      apply (simp add:placeNewObject_def2)
-      apply (wp doMachineOp_psp_no_overlap createObjects'_pspace_no_overlap2
-        | simp add: placeNewObject_def2 curDomain_def word_shiftl_add_distrib
-        field_simps)+
-      apply (simp add:add.assoc[symmetric])
-      apply (wp createObjects'_pspace_no_overlap2
-        [where n =0 and sz = sz,simplified])
-     apply (simp add:placeNewObject_def2)
-     apply (wp doMachineOp_psp_no_overlap createObjects'_pspace_no_overlap2
-        | simp add: placeNewObject_def2 word_shiftl_add_distrib
-        field_simps)+
-     apply (simp add:add.assoc[symmetric])
-     apply (wp createObjects'_pspace_no_overlap2
-        [where n =0 and sz = sz,simplified])
-    apply (simp add:placeNewObject_def2)
-    apply (wp doMachineOp_psp_no_overlap createObjects'_pspace_no_overlap2
-      | simp add: placeNewObject_def2 word_shiftl_add_distrib
-      field_simps)+
-    apply (simp add:add.assoc[symmetric])
-    apply (wp createObjects'_pspace_no_overlap2
-      [where n =0 and sz = sz,simplified])
-   apply (simp add:placeNewObject_def2)
-   apply (wp doMachineOp_psp_no_overlap createObjects'_pspace_no_overlap2
-     | simp add: placeNewObject_def2 word_shiftl_add_distrib
-     field_simps)+
-   apply (simp add:add.assoc[symmetric])
-   apply (wp createObjects'_pspace_no_overlap2
-     [where n =0 and sz = sz,simplified])
+         apply wp
+        \<comment> \<open>TCB\<close>
+        apply (wp createObjects'_pspace_no_overlap2[where n =0 and sz = sz,simplified]
+               | simp add: curDomain_def placeNewObject_def2 word_shiftl_add_distrib field_simps)+
+         apply (simp add:add.assoc[symmetric])
+         apply (wp createObjects'_pspace_no_overlap2[where n =0 and sz = sz,simplified])
+        apply (wpsimp simp: curDomain_def)
+       \<comment> \<open>other objects\<close>
+       apply ((wp createObjects'_pspace_no_overlap2
+               | simp add: placeNewObject_def2 word_shiftl_add_distrib field_simps)+,
+              simp add:add.assoc[symmetric],
+              wp createObjects'_pspace_no_overlap2[where n =0 and sz = sz,simplified])+
+   \<comment> \<open>Cleanup\<close>
   apply clarsimp
   apply (frule(1) range_cover_no_0[where p = n])
    apply simp
@@ -5174,10 +5124,9 @@ lemma createObject_pspace_no_overlap':
    apply (simp add:shiftl_t2n field_simps)
   apply (frule range_cover_offset[rotated,where p = n])
    apply simp+
-  apply (auto simp: word_shiftl_add_distrib field_simps shiftl_t2n elim: range_cover_le,
-    auto simp add: APIType_capBits_def fromAPIType_def objBits_def
-        dest!: to_from_apiTypeD)
-  done
+  by (auto simp: word_shiftl_add_distrib field_simps shiftl_t2n elim: range_cover_le)
+     (auto simp: APIType_capBits_def fromAPIType_def objBits_def objBits_simps
+          dest!: to_from_apiTypeD)
 
 crunch updatePTType
   for aligned'[wp]: pspace_aligned'
diff --git a/proof/refine/AARCH64/Finalise_R.thy b/proof/refine/AARCH64/Finalise_R.thy
index 282c581fc2..43a4298be2 100644
--- a/proof/refine/AARCH64/Finalise_R.thy
+++ b/proof/refine/AARCH64/Finalise_R.thy
@@ -1624,7 +1624,7 @@ lemma emptySlot_corres:
   apply (simp add: put_def)
   apply (simp add: exec_gets exec_get exec_put del: fun_upd_apply | subst bind_def)+
   apply (clarsimp simp: state_relation_def)
-  apply (drule updateMDB_the_lot, fastforce simp: pspace_relations_def, fastforce, fastforce)
+  apply (drule updateMDB_the_lot, fastforce simp: pspace_relation_def, fastforce, fastforce)
    apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
                          valid_mdb'_def valid_mdb_ctes_def)
   apply (elim conjE)
@@ -1653,7 +1653,7 @@ lemma emptySlot_corres:
   apply clarsimp
   apply (drule updateCap_stuff, elim conjE, erule (1) impE)
   apply clarsimp
-  apply (drule updateMDB_the_lot, force simp: pspace_relations_def, assumption+, simp)
+  apply (drule updateMDB_the_lot, force simp: pspace_relation_def, assumption+, simp)
   apply (rule bexI)
    prefer 2
    apply (simp only: trans_state_update[symmetric])
@@ -1681,7 +1681,7 @@ lemma emptySlot_corres:
    apply (rule mdb_ptr_axioms.intro)
    subgoal by simp
   apply (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv)
-  apply (simp add: pspace_relations_def)
+  apply (simp add: pspace_relation_def)
   apply (rule conjI)
    apply (clarsimp simp: data_at_def ghost_relation_typ_at set_cap_a_type_inv)
   apply (rule conjI)
@@ -3819,8 +3819,7 @@ lemma return_NullCap_pair_corres[corres]:
 lemma arch_finaliseCap_corres:
   "\<lbrakk> final_matters' (ArchObjectCap cap') \<Longrightarrow> final = final'; acap_relation cap cap' \<rbrakk>
      \<Longrightarrow> corres (\<lambda>r r'. cap_relation (fst r) (fst r') \<and> cap_relation (snd r) (snd r'))
-           (\<lambda>s. invs s \<and> valid_etcbs s
-                       \<and> s \<turnstile> cap.ArchObjectCap cap
+           (\<lambda>s. invs s \<and> s \<turnstile> cap.ArchObjectCap cap
                        \<and> (final_matters (cap.ArchObjectCap cap)
                             \<longrightarrow> final = is_final_cap' (cap.ArchObjectCap cap) s)
                        \<and> cte_wp_at ((=) (cap.ArchObjectCap cap)) sl s)
diff --git a/proof/refine/AARCH64/Init_R.thy b/proof/refine/AARCH64/Init_R.thy
index b75793a303..edaa9e4808 100644
--- a/proof/refine/AARCH64/Init_R.thy
+++ b/proof/refine/AARCH64/Init_R.thy
@@ -51,6 +51,12 @@ definition zeroed_main_abstract_state ::
     is_original_cap = \<top>,
     cur_thread = 0,
     idle_thread = 0,
+    scheduler_action = resume_cur_thread,
+    domain_list = [],
+    domain_index = 0,
+    cur_domain = 0,
+    domain_time = 0,
+    ready_queues = (\<lambda>_ _. []),
     machine_state = init_machine_state,
     interrupt_irq_node = (\<lambda>irq. ucast irq << cte_level_bits),
     interrupt_states = (K irq_state.IRQInactive),
@@ -62,13 +68,6 @@ definition zeroed_extended_state ::
   where
   "zeroed_extended_state \<equiv> \<lparr>
     work_units_completed_internal = 0,
-    scheduler_action_internal = resume_cur_thread,
-    ekheap_internal = Map.empty,
-    domain_list_internal = [],
-    domain_index_internal = 0,
-    cur_domain_internal = 0,
-    domain_time_internal = 0,
-    ready_queues_internal = (\<lambda>_ _. []),
     cdt_list_internal = K []
   \<rparr>"
 
@@ -119,8 +118,7 @@ lemma non_empty_refine_state_relation:
   "(zeroed_abstract_state, zeroed_intermediate_state) \<in> state_relation"
   apply (clarsimp simp: state_relation_def zeroed_state_defs state.defs)
   apply (intro conjI)
-          apply (clarsimp simp: pspace_relation_def pspace_dom_def)
-         apply (clarsimp simp: ekheap_relation_def)
+         apply (clarsimp simp: pspace_relation_def pspace_dom_def)
         apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def queue_end_valid_def
                               opt_pred_def list_queue_relation_def tcbQueueEmpty_def
                               prev_queue_head_def)
diff --git a/proof/refine/AARCH64/Interrupt_R.thy b/proof/refine/AARCH64/Interrupt_R.thy
index 407e022f64..46231249b9 100644
--- a/proof/refine/AARCH64/Interrupt_R.thy
+++ b/proof/refine/AARCH64/Interrupt_R.thy
@@ -600,7 +600,7 @@ lemma getIRQState_prop:
 lemma decDomainTime_corres:
   "corres dc \<top> \<top> dec_domain_time decDomainTime"
   apply (simp add:dec_domain_time_def corres_underlying_def decDomainTime_def simpler_modify_def)
-  apply (clarsimp simp:state_relation_def)
+  apply (clarsimp simp: state_relation_def cdt_relation_def)
   done
 
 lemma thread_state_case_if:
@@ -634,24 +634,24 @@ lemma timerTick_corres:
           apply (rule corres_split[where r' = dc])
              apply (rule corres_if[where Q = \<top> and Q' = \<top>])
                apply (case_tac state,simp_all)[1]
-              apply (rule_tac r'="(=)" in corres_split[OF ethreadget_corres])
-                 apply (simp add:etcb_relation_def)
+              apply (rule_tac r'="(=)" in corres_split[OF threadGet_corres])
+                 apply (simp add: tcb_relation_def)
                 apply (rename_tac ts ts')
                 apply (rule_tac R="1 < ts" in corres_cases)
                  apply (simp)
                  apply (unfold thread_set_time_slice_def)
-                 apply (rule ethread_set_corres, simp+)
-                 apply (clarsimp simp: etcb_relation_def)
+                 apply (rule threadset_corres; simp add: tcb_relation_def inQ_def)
                 apply simp
-                apply (rule corres_split[OF ethread_set_corres])
-                         apply (simp add: sch_act_wf_weak etcb_relation_def pred_conj_def)+
+                apply (rule corres_split[OF threadset_corres])
+                                apply (simp add: sch_act_wf_weak tcb_relation_def pred_conj_def inQ_def)+
                   apply (rule corres_split[OF tcbSchedAppend_corres], simp)
                     apply (rule rescheduleRequired_corres)
                    apply wp
                   apply ((wpsimp wp: tcbSchedAppend_sym_heap_sched_pointers
                                      tcbSchedAppend_valid_objs'
                           | strengthen valid_objs'_valid_tcbs')+)[1]
-                 apply ((wp thread_set_time_slice_valid_queues
+                 apply ((wpsimp wp: thread_set_valid_queues thread_set_no_change_tcb_state
+                                    thread_set_weak_valid_sched_action
                          | strengthen valid_queues_in_correct_ready_q
                                       valid_queues_ready_qs_distinct)+)[1]
                 apply ((wpsimp wp: threadSet_sched_pointers threadSet_valid_sched_pointers
@@ -671,10 +671,10 @@ lemma timerTick_corres:
                              threadSet_pred_tcb_at_state threadSet_weak_sch_act_wf
                              rescheduleRequired_weak_sch_act_wf)+
               apply (strengthen valid_queues_in_correct_ready_q valid_queues_ready_qs_distinct)
-              apply (wpsimp wp: thread_set_time_slice_valid_queues)
-             apply ((wpsimp wp: thread_set_time_slice_valid_queues
+              apply (wpsimp wp: thread_set_valid_queues thread_set_weak_valid_sched_action)
+             apply ((wpsimp wp: thread_set_valid_queues
                      | strengthen valid_queues_in_correct_ready_q valid_queues_ready_qs_distinct)+)[1]
-            apply wpsimp
+            apply (wpsimp wp: thread_get_wp)
            apply wpsimp
           apply ((wpsimp wp: threadSet_sched_pointers threadSet_valid_sched_pointers
                              threadSet_valid_objs'
@@ -682,11 +682,8 @@ lemma timerTick_corres:
                   | wp (once) hoare_drop_imp)+)[1]
          apply (wpsimp wp: gts_wp gts_wp')+
      apply (clarsimp simp: cur_tcb_def)
-     apply (frule valid_sched_valid_etcbs)
-     apply (frule (1) tcb_at_is_etcb_at)
      apply (frule valid_sched_valid_queues)
      apply (fastforce simp: pred_tcb_at_def obj_at_def valid_sched_weak_strg)
-    apply (clarsimp simp: etcb_at_def split: option.splits)
     apply fastforce
    apply (fastforce simp: valid_state'_def ct_not_inQ_def)
   apply fastforce
diff --git a/proof/refine/AARCH64/Invariants_H.thy b/proof/refine/AARCH64/Invariants_H.thy
index c952717536..090af087fb 100644
--- a/proof/refine/AARCH64/Invariants_H.thy
+++ b/proof/refine/AARCH64/Invariants_H.thy
@@ -3314,9 +3314,6 @@ lemma invs'_invs_no_cicd:
   "invs' s \<Longrightarrow> all_invs_but_ct_idle_or_in_cur_domain' s"
   by (simp add: invs'_to_invs_no_cicd'_def)
 
-lemma einvs_valid_etcbs: "einvs s \<longrightarrow> valid_etcbs s"
-  by (clarsimp simp: valid_sched_def)
-
 lemma invs'_bitmapQ_no_L1_orphans:
   "invs' s \<Longrightarrow> bitmapQ_no_L1_orphans s"
   by (simp add: invs'_def valid_state'_def valid_bitmaps_def)
diff --git a/proof/refine/AARCH64/IpcCancel_R.thy b/proof/refine/AARCH64/IpcCancel_R.thy
index ae185783fc..58b4d61a5d 100644
--- a/proof/refine/AARCH64/IpcCancel_R.thy
+++ b/proof/refine/AARCH64/IpcCancel_R.thy
@@ -525,7 +525,7 @@ lemma (in delete_one) cancelIPC_ReplyCap_corres:
           apply (simp add: tcb_relation_def fault_rel_optionation_def)
          apply (simp add: tcb_cap_cases_def)
         apply (simp add: tcb_cte_cases_def cteSizeBits_def)
-       apply (simp add: exst_same_def)
+       apply (simp add: inQ_def)
       apply (fastforce simp: st_tcb_at_tcb_at)
      apply clarsimp
     defer
@@ -1181,9 +1181,9 @@ crunch asUser
 
 crunch set_thread_state
   for in_correct_ready_q[wp]: in_correct_ready_q
-  (wp: crunch_wps)
+  (wp: set_object_wp)
 
-crunch set_thread_state_ext
+crunch set_thread_state_act
   for ready_qs_distinct[wp]: ready_qs_distinct
   (wp: crunch_wps)
 
@@ -1193,6 +1193,10 @@ lemma set_thread_state_ready_qs_distinct[wp]:
   apply (wpsimp wp: set_object_wp)
   by (clarsimp simp: ready_qs_distinct_def)
 
+crunch as_user
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  (wp: set_object_wp)
+
 lemma as_user_ready_qs_distinct[wp]:
   "as_user tptr f \<lbrace>ready_qs_distinct\<rbrace>"
   unfolding as_user_def
@@ -1298,7 +1302,7 @@ proof -
   unfolding arch_thread_set_def archThreadSet_def
   by (corres' \<open>(rotate_tac, erule tcb_rel) |
                (rule ball_tcb_cte_casesI; simp) |
-               simp add: exst_same_def tcb_cap_cases_def\<close>
+               simp add: tcb_cap_cases_def\<close>
               corres: getObject_TCB_corres setObject_update_TCB_corres')
 qed
 
@@ -1496,7 +1500,7 @@ lemma sts_sch_act_not_ct[wp]:
 text \<open>Cancelling all IPC in an endpoint or notification object\<close>
 
 lemma ep_cancel_corres_helper:
-  "corres dc ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and valid_etcbs and valid_queues
+  "corres dc ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and valid_queues
                                               and pspace_aligned and pspace_distinct)
              (valid_objs' and sym_heap_sched_pointers and valid_sched_pointers)
           (mapM_x (\<lambda>t. do
@@ -1533,7 +1537,7 @@ lemma ep_cancel_corres_helper:
 crunch set_simple_ko
   for ready_qs_distinct[wp]: ready_qs_distinct
   and in_correct_ready_q[wp]: in_correct_ready_q
-  (rule: ready_qs_distinct_lift wp: crunch_wps)
+  (wp: ready_qs_distinct_lift in_correct_ready_q_lift)
 
 lemma ep_cancel_corres:
   "corres dc (invs and valid_sched and ep_at ep) (invs' and ep_at' ep)
@@ -1542,7 +1546,7 @@ proof -
   have P:
     "\<And>list.
      corres dc (\<lambda>s. (\<forall>t \<in> set list. tcb_at t s) \<and> valid_pspace s \<and> ep_at ep s
-                        \<and> valid_etcbs s \<and> weak_valid_sched_action s \<and> valid_queues s)
+                        \<and> weak_valid_sched_action s \<and> valid_queues s)
                (\<lambda>s. (\<forall>t \<in> set list. tcb_at' t s) \<and> valid_pspace' s
                          \<and> ep_at' ep s \<and> weak_sch_act_wf (ksSchedulerAction s) s
                          \<and> valid_objs' s \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s)
@@ -2261,7 +2265,7 @@ lemma cancelBadgedSends_corres:
                                                            and pspace_distinct'"]])
          apply (rule_tac S="(=)"
                      and Q="\<lambda>xs s. (\<forall>x \<in> set xs. (epptr, TCBBlockedSend) \<in> state_refs_of s x) \<and>
-                                   distinct xs \<and> valid_etcbs s \<and>
+                                   distinct xs \<and>
                                    in_correct_ready_q s \<and> ready_qs_distinct s \<and>
                                    pspace_aligned s \<and> pspace_distinct s"
                     and Q'="\<lambda>_ s. valid_objs' s \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s
@@ -2285,7 +2289,7 @@ lemma cancelBadgedSends_corres:
                       | strengthen valid_objs'_valid_tcbs')+
             apply (clarsimp simp: valid_tcb_state_def tcb_at_def st_tcb_def2
                                   st_tcb_at_refs_of_rev
-                           dest!: state_refs_of_elemD elim!: tcb_at_is_etcb_at[rotated])
+                           dest!: state_refs_of_elemD)
            apply (simp add: valid_tcb_state'_def)
           apply (wp hoare_vcg_const_Ball_lift gts_wp | clarsimp)+
             apply (wp hoare_vcg_imp_lift sts_st_tcb' sts_valid_objs'
diff --git a/proof/refine/AARCH64/Ipc_R.thy b/proof/refine/AARCH64/Ipc_R.thy
index 89fe5e8fbe..dd72894b4e 100644
--- a/proof/refine/AARCH64/Ipc_R.thy
+++ b/proof/refine/AARCH64/Ipc_R.thy
@@ -2192,7 +2192,7 @@ lemma doReplyTransfer_corres:
               apply (rule corres_split)
                  apply (rule threadset_corresT;
                         clarsimp simp add: tcb_relation_def fault_rel_optionation_def cteSizeBits_def
-                                           tcb_cap_cases_def tcb_cte_cases_def exst_same_def)
+                                           tcb_cap_cases_def tcb_cte_cases_def inQ_def)
                 apply (rule_tac Q="valid_sched and cur_tcb and tcb_at receiver and pspace_aligned and pspace_distinct"
                             and Q'="tcb_at' receiver and cur_tcb'
                                       and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
@@ -3386,7 +3386,7 @@ lemma sendFaultIPC_corres:
            apply (rule corres_if2 [OF refl])
             apply (simp add: dc_def[symmetric])
             apply (rule corres_split[OF threadset_corres sendIPC_corres], simp_all)[1]
-               apply (simp add: tcb_relation_def fault_rel_optionation_def exst_same_def)+
+               apply (simp add: tcb_relation_def fault_rel_optionation_def inQ_def)+
              apply (wp thread_set_invs_trivial thread_set_no_change_tcb_state
                        thread_set_typ_at ep_at_typ_at ex_nonz_cap_to_pres
                        thread_set_cte_wp_at_trivial thread_set_not_state_valid_sched
diff --git a/proof/refine/AARCH64/KHeap_R.thy b/proof/refine/AARCH64/KHeap_R.thy
index cfc92c72d6..dc30e00899 100644
--- a/proof/refine/AARCH64/KHeap_R.thy
+++ b/proof/refine/AARCH64/KHeap_R.thy
@@ -1015,17 +1015,6 @@ lemma obj_relation_cut_same_type:
                     arch_kernel_obj.split_asm arch_kernel_object.split_asm)
   done
 
-definition exst_same :: "Structures_H.tcb \<Rightarrow> Structures_H.tcb \<Rightarrow> bool"
-where
-  "exst_same tcb tcb' \<equiv> tcbPriority tcb = tcbPriority tcb'
-                      \<and> tcbTimeSlice tcb = tcbTimeSlice tcb'
-                      \<and> tcbDomain tcb = tcbDomain tcb'"
-
-fun exst_same' :: "Structures_H.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
-where
-  "exst_same' (KOTCB tcb) (KOTCB tcb') = exst_same tcb tcb'" |
-  "exst_same' _ _ = True"
-
 lemma tcbs_of'_non_tcb_update:
   "\<lbrakk>typ_at' (koTypeOf ko) ptr s'; koTypeOf ko \<noteq> TCBT\<rbrakk>
    \<Longrightarrow> tcbs_of' (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> ko)\<rparr>) = tcbs_of' s'"
@@ -1043,7 +1032,6 @@ lemma setObject_other_corres:
                \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO ob')) = map_to_ctes (ksPSpace s)"
   assumes t: "is_other_obj_relation_type (a_type ob)"
   assumes b: "\<And>ko. P ko \<Longrightarrow> objBits ko = objBits ob'"
-  assumes e: "\<And>ko. P ko \<Longrightarrow> exst_same' (injectKO ko) (injectKO ob')"
   assumes P: "\<And>v::'a::pspace_storable. (1 :: machine_word) < 2 ^ objBits v"
   shows      "other_obj_relation ob (injectKO (ob' :: 'a :: pspace_storable)) \<Longrightarrow>
   corres dc (obj_at (\<lambda>ko. a_type ko = a_type ob) ptr and obj_at (same_caps ob) ptr)
@@ -1094,21 +1082,6 @@ lemma setObject_other_corres:
    apply (insert t)
    apply ((erule disjE
           | clarsimp simp: is_other_obj_relation_type is_other_obj_relation_type_def a_type_def)+)[1]
-  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
-   apply (simp only: ekheap_relation_def)
-   apply (rule ballI, drule(1) bspec)
-   apply (drule domD)
-   apply (insert e)
-   apply atomize
-   apply (clarsimp simp: obj_at'_def)
-   apply (erule_tac x=obj in allE)
-   apply (clarsimp simp: projectKO_eq project_inject)
-   apply (case_tac ob;
-          simp_all add: a_type_def other_obj_relation_def etcb_relation_def
-                        is_other_obj_relation_type t exst_same_def)[1]
-     apply (clarsimp simp: is_other_obj_relation_type t exst_same_def
-                    split: Structures_A.kernel_object.splits Structures_H.kernel_object.splits
-                           arch_kernel_obj.splits)+
   \<comment> \<open>ready_queues_relation\<close>
   apply (prop_tac "koTypeOf (injectKO ob') \<noteq> TCBT")
    subgoal
diff --git a/proof/refine/AARCH64/Refine.thy b/proof/refine/AARCH64/Refine.thy
index fa4ebe573b..271fe40305 100644
--- a/proof/refine/AARCH64/Refine.thy
+++ b/proof/refine/AARCH64/Refine.thy
@@ -196,18 +196,27 @@ lemma absKState_correct:
   shows "absKState s' = abs_state s"
   using assms
   apply (intro state.equality, simp_all add: absKState_def abs_state_def)
-           apply (rule absHeap_correct, clarsimp+)
-           apply (clarsimp elim!: state_relationE)
-          apply (rule absCDT_correct, clarsimp+)
-         apply (rule absIsOriginalCap_correct, clarsimp+)
+                 apply (rule absHeap_correct; clarsimp)
+                 apply (clarsimp elim!: state_relationE)
+                apply (rule absCDT_correct; clarsimp)
+               apply (rule absIsOriginalCap_correct; clarsimp)
+              apply (simp add: state_relation_def)
+             apply (simp add: state_relation_def)
+            apply (clarsimp simp: state_relation_def)
+            apply (rule absSchedulerAction_correct, simp add: state_relation_def)
+           apply (simp add: state_relation_def)
+          apply (simp add: state_relation_def)
+         apply (simp add: state_relation_def)
         apply (simp add: state_relation_def)
-       apply (simp add: state_relation_def)
+       apply (simp add: state_relation_def ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def)
+       apply (fastforce dest: heap_ls_is_walk)
       apply (clarsimp simp:  user_mem_relation invs_def invs'_def)
       apply (simp add: state_relation_def)
      apply (rule absInterruptIRQNode_correct, simp add: state_relation_def)
     apply (rule absInterruptStates_correct, simp add: state_relation_def)
    apply (rule absArchState_correct, simp)
-  apply (rule absExst_correct, simp+)
+  apply (rule absExst_correct; simp)
   done
 
 text \<open>The top-level invariance\<close>
@@ -218,7 +227,7 @@ lemma set_thread_state_sched_act:
   \<lbrace>\<lambda>rs s. P (scheduler_action (s::det_state))\<rbrace>"
   apply (simp add: set_thread_state_def)
   apply wp
-     apply (simp add: set_thread_state_ext_def)
+     apply (simp add: set_thread_state_act_def)
      apply wp
         apply (rule hoare_pre_cont)
        apply (rule_tac Q'="\<lambda>rv. (\<lambda>s. runnable ts) and (\<lambda>s. P (scheduler_action s))"
@@ -272,7 +281,7 @@ lemma kernel_entry_invs:
    apply clarsimp
   apply (simp add: kernel_entry_def)
   apply (wp akernel_invs_det_ext call_kernel_valid_sched thread_set_invs_trivial
-            thread_set_ct_running thread_set_not_state_valid_sched
+            thread_set_not_state_valid_sched
             hoare_vcg_disj_lift ct_in_state_thread_state_lift thread_set_no_change_tcb_state
             call_kernel_domain_time_inv_det_ext call_kernel_domain_list_inv_det_ext
             hoare_weak_lift_imp
@@ -330,13 +339,13 @@ lemmas valid_list_inits[simp] = valid_list_init[simplified]
 lemma valid_sched_init[simp]:
   "valid_sched init_A_st"
   apply (simp add: valid_sched_def init_A_st_def ext_init_def)
-  apply (clarsimp simp: valid_etcbs_def init_kheap_def st_tcb_at_kh_def obj_at_kh_def
-                    obj_at_def is_etcb_at_def idle_thread_ptr_def
+  apply (clarsimp simp: init_kheap_def st_tcb_at_kh_def obj_at_kh_def
+                    obj_at_def idle_thread_ptr_def
                     valid_queues_2_def ct_not_in_q_def not_queued_def
                     valid_sched_action_def is_activatable_def init_irq_node_ptr_def
                     arm_global_pt_ptr_def
                     ct_in_cur_domain_2_def valid_blocked_2_def valid_idle_etcb_def
-                    etcb_at'_def default_etcb_def)
+                    etcb_at'_def etcbs_of'_def)
   done
 
 lemma valid_domain_list_init[simp]:
@@ -465,27 +474,6 @@ lemma kernelEntry_invs':
                           valid_domain_list'_def)+
   done
 
-lemma absKState_correct':
-  "\<lbrakk>einvs s; invs' s'; (s,s') \<in> state_relation\<rbrakk>
-   \<Longrightarrow> absKState s' = abs_state s"
-  apply (intro state.equality, simp_all add: absKState_def abs_state_def)
-           apply (rule absHeap_correct)
-               apply (clarsimp simp: valid_state_def valid_pspace_def)+
-           apply (clarsimp dest!: state_relationD)
-          apply (rule absCDT_correct)
-                apply (clarsimp simp: valid_state_def valid_pspace_def
-                                      valid_state'_def valid_pspace'_def)+
-         apply (rule absIsOriginalCap_correct, clarsimp+)
-        apply (simp add: state_relation_def)
-       apply (simp add: state_relation_def)
-      apply (clarsimp simp: user_mem_relation invs_def invs'_def)
-      apply (simp add: state_relation_def)
-     apply (rule absInterruptIRQNode_correct, simp add: state_relation_def)
-    apply (rule absInterruptStates_correct, simp add: state_relation_def)
-   apply (erule absArchState_correct)
-  apply (rule absExst_correct, simp, assumption+)
-  done
-
 lemma ptable_lift_abs_state[simp]:
   "ptable_lift t (abs_state s) = ptable_lift t s"
   by (simp add: ptable_lift_def abs_state_def)
@@ -503,7 +491,7 @@ lemma ptable_rights_imp_UserData:
   shows "pointerInUserData y s' \<or> pointerInDeviceData y s'"
 proof -
   from invs invs' rel have [simp]: "absKState s' = abs_state s"
-    by - (rule absKState_correct', simp_all)
+    by - (rule absKState_correct, simp_all)
   from invs have valid: "valid_state s" by auto
   from invs' have valid': "valid_state' s'" by auto
   have "in_user_frame y s \<or> in_device_frame y s "
@@ -669,11 +657,10 @@ lemma entry_corres:
       apply (rule corres_split)
          apply simp
          apply (rule threadset_corresT; simp?)
-            apply (simp add: tcb_relation_def arch_tcb_relation_def
-                             arch_tcb_context_set_def atcbContextSet_def)
-           apply (clarsimp simp: tcb_cap_cases_def cteSizeBits_def)
-          apply (clarsimp simp: tcb_cte_cases_def cteSizeBits_def)
-         apply (simp add: exst_same_def)
+           apply (simp add: tcb_relation_def arch_tcb_relation_def
+                            arch_tcb_context_set_def atcbContextSet_def)
+          apply (clarsimp simp: tcb_cap_cases_def cteSizeBits_def)
+         apply (clarsimp simp: tcb_cte_cases_def cteSizeBits_def)
         apply (rule corres_split[OF kernel_corres])
           apply (rule corres_split_eqr[OF getCurThread_corres])
             apply (rule threadGet_corres)
@@ -683,7 +670,7 @@ lemma entry_corres:
          apply (rule hoare_strengthen_post, rule akernel_invs_det_ext,
                 simp add: invs_def valid_state_def valid_pspace_def cur_tcb_def)
         apply (rule hoare_strengthen_post, rule ckernel_invs, simp add: invs'_def cur_tcb'_def)
-       apply (wp thread_set_invs_trivial thread_set_ct_running
+       apply (wp thread_set_invs_trivial
                  threadSet_invs_trivial threadSet_ct_running'
                  thread_set_not_state_valid_sched hoare_weak_lift_imp
                  hoare_vcg_disj_lift ct_in_state_thread_state_lift
diff --git a/proof/refine/AARCH64/Retype_R.thy b/proof/refine/AARCH64/Retype_R.thy
index 6625f1857f..13c7c3faf9 100644
--- a/proof/refine/AARCH64/Retype_R.thy
+++ b/proof/refine/AARCH64/Retype_R.thy
@@ -77,14 +77,14 @@ where
     | VCPUObject \<Rightarrow> vcpuBits"
 
 definition
-  makeObjectKO :: "bool \<Rightarrow> (kernel_object + AARCH64_H.object_type) \<rightharpoonup> kernel_object"
+  makeObjectKO :: "bool \<Rightarrow> domain \<Rightarrow> (kernel_object + AARCH64_H.object_type) \<rightharpoonup> kernel_object"
 where
-  "makeObjectKO dev ty \<equiv> case ty of
+  "makeObjectKO dev d ty \<equiv> case ty of
       Inl KOUserData \<Rightarrow> Some KOUserData
     | Inl (KOArch (KOASIDPool _)) \<Rightarrow> Some (KOArch (KOASIDPool makeObject))
     | Inl (KOArch (KOVCPU _)) \<Rightarrow> Some (KOArch (KOVCPU makeObject))
     | Inr VCPUObject \<Rightarrow> Some (KOArch (KOVCPU makeObject))
-    | Inr (APIObjectType ArchTypes_H.TCBObject) \<Rightarrow> Some (KOTCB makeObject)
+    | Inr (APIObjectType ArchTypes_H.TCBObject) \<Rightarrow> Some (KOTCB (tcbDomain_update (\<lambda>_. d) makeObject))
     | Inr (APIObjectType ArchTypes_H.EndpointObject) \<Rightarrow> Some (KOEndpoint makeObject)
     | Inr (APIObjectType ArchTypes_H.NotificationObject) \<Rightarrow> Some (KONotification makeObject)
     | Inr (APIObjectType ArchTypes_H.CapTableObject) \<Rightarrow> Some (KOCTE makeObject)
@@ -111,6 +111,12 @@ lemma valid_obj_makeObject_tcb [simp]:
   by (clarsimp simp: makeObject_tcb makeObject_cte tcb_cte_cases_def minBound_word newArchTCB_def
                      cteSizeBits_def)
 
+lemma valid_obj_makeObject_tcb_tcbDomain_update [simp]:
+  "d \<le> maxDomain \<Longrightarrow> valid_obj' (KOTCB (tcbDomain_update (\<lambda>_. d) makeObject)) s"
+  unfolding valid_obj'_def valid_tcb'_def  valid_tcb_state'_def valid_arch_tcb'_def
+  by (clarsimp simp: makeObject_tcb makeObject_cte objBits_simps' newArchTCB_def
+                     tcb_cte_cases_def maxDomain_def maxPriority_def numPriorities_def minBound_word)
+
 lemma valid_obj_makeObject_endpoint [simp]:
   "valid_obj' (KOEndpoint makeObject) s"
   unfolding valid_obj'_def valid_ep'_def
@@ -301,15 +307,14 @@ lemma cte_at_next_slot'':
 
 
 lemma state_relation_null_filterE:
-  "\<lbrakk> (s, s') \<in> state_relation; t = kheap_update f (ekheap_update ef s);
+  "\<lbrakk> (s, s') \<in> state_relation; t = kheap_update f s;
      \<exists>f' g' h' pt_fn'.
      t' = s'\<lparr>ksPSpace := f' (ksPSpace s'), gsUserPages := g' (gsUserPages s'),
              gsCNodes := h' (gsCNodes s'),
              ksArchState := (ksArchState s') \<lparr>gsPTTypes := pt_fn' (gsPTTypes (ksArchState s'))\<rparr>\<rparr>;
      null_filter (caps_of_state t) = null_filter (caps_of_state s);
      null_filter' (ctes_of t') = null_filter' (ctes_of s');
-     pspace_relation (kheap t) (ksPSpace t');
-     ekheap_relation (ekheap t) (ksPSpace t'); ready_queues_relation t t';
+     pspace_relation (kheap t) (ksPSpace t'); ready_queues_relation t t';
      ghost_relation (kheap t) (gsUserPages t') (gsCNodes t') (gsPTTypes (ksArchState t'));
      valid_list s;
      pspace_aligned' s'; pspace_distinct' s'; valid_objs s; valid_mdb s;
@@ -328,13 +333,12 @@ lemma state_relation_null_filterE:
      apply (case_tac "cdt s (a, b)")
       apply (subst mdb_cte_at_no_descendants, assumption)
        apply (simp add: cte_wp_at_caps_of_state swp_def)
-      apply (cut_tac s="kheap_update f (ekheap_update ef s)"  and
+      apply (cut_tac s="kheap_update f s"  and
                      s'="s'\<lparr>ksPSpace := f' (ksPSpace s'),
                             gsUserPages := g' (gsUserPages s'),
                             gsCNodes := h' (gsCNodes s'),
                             ksArchState := ksArchState s' \<lparr>gsPTTypes := pt_fn' (gsPTTypes (ksArchState s'))\<rparr>\<rparr>"
              in pspace_relation_ctes_ofI, simp_all)[1]
-       apply (simp add: trans_state_update[symmetric] del: trans_state_update)
        apply (erule caps_of_state_cteD)
       apply (clarsimp simp: descendants_of'_def)
       apply (case_tac cte)
@@ -439,12 +443,12 @@ lemma foldr_update_obj_at':
   done
 
 lemma makeObjectKO_eq:
-  assumes x: "makeObjectKO dev tp = Some v"
+  assumes x: "makeObjectKO dev d tp = Some v"
   shows
   "(v = KOCTE cte) =
        (tp = Inr (APIObjectType ArchTypes_H.CapTableObject) \<and> cte = makeObject)"
   "(v = KOTCB tcb) =
-       (tp = Inr (APIObjectType ArchTypes_H.TCBObject) \<and> tcb = makeObject)"
+       (tp = Inr (APIObjectType ArchTypes_H.TCBObject) \<and> tcb = (tcbDomain_update (\<lambda>_. d) makeObject))"
   using x
   by (simp add: makeObjectKO_def eq_commute
          split: apiobject_type.split_asm sum.split_asm kernel_object.split_asm
@@ -499,7 +503,7 @@ lemma ps_clearD:
   done
 
 lemma cte_wp_at_retype':
-  assumes ko: "makeObjectKO dev tp = Some obj"
+  assumes ko: "makeObjectKO dev d tp = Some obj"
       and pv: "pspace_aligned' s" "pspace_distinct' s"
      and pv': "pspace_aligned' (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)"
               "pspace_distinct' (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)"
@@ -518,13 +522,14 @@ lemma cte_wp_at_retype':
     apply (subgoal_tac "(\<exists>P :: cte \<Rightarrow> bool. obj_at' P p ?s')
                           \<longrightarrow> (\<not> (\<exists>P :: tcb \<Rightarrow> bool. obj_at' P (p && ~~ mask tcbBlockSizeBits) ?s'))")
      apply (simp only: cte_wp_at_obj_cases_mask foldr_update_obj_at'[OF pv pv' al])
-     apply (simp add: the_ctes_makeObject makeObjectKO_eq [OF ko] makeObject_cte dom_def
-                 split del: if_split
-                 cong: if_cong)
+     apply (simp    add: the_ctes_makeObject makeObjectKO_eq [OF ko] makeObject_cte
+              split del: if_split
+                   cong: if_cong)
      apply (insert al ko)
-     apply (simp, safe, simp_all)
-      apply fastforce
-     apply fastforce
+     apply simp
+     apply (safe; simp)
+              apply ((fastforce simp: makeObjectKO_def makeObject_cte makeObject_tcb tcb_cte_cases_def
+                               split: if_split_asm)+)[10]
     apply (clarsimp elim!: obj_atE' simp: objBits_simps)
     apply (drule ps_clearD[where y=p and n=tcbBlockSizeBits])
        apply simp
@@ -538,7 +543,7 @@ lemma cte_wp_at_retype':
   done
 
 lemma ctes_of_retype:
-  assumes ko: "makeObjectKO dev tp = Some obj"
+  assumes ko: "makeObjectKO dev d tp = Some obj"
       and pv: "pspace_aligned' s" "pspace_distinct' s"
      and pv': "pspace_aligned' (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)"
               "pspace_distinct' (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)"
@@ -567,7 +572,7 @@ lemma None_ctes_of_cte_at:
   by (fastforce simp add: cte_wp_at_ctes_of)
 
 lemma null_filter_ctes_retype:
-  assumes ko: "makeObjectKO dev tp = Some obj"
+  assumes ko: "makeObjectKO dev d tp = Some obj"
       and pv: "pspace_aligned' s" "pspace_distinct' s"
      and pv': "pspace_aligned' (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)"
               "pspace_distinct' (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)"
@@ -598,7 +603,8 @@ lemma null_filter_ctes_retype:
    apply (insert ko[symmetric], simp add: makeObjectKO_def objBits_simps)
    apply clarsimp
    apply (subst(asm) subtract_mask[symmetric],
-          erule_tac v="if x \<in> set addrs then KOTCB makeObject else KOCTE cte"
+          erule_tac v="if x \<in> set addrs then KOTCB (tcbDomain_update (\<lambda>_. d) makeObject)
+                                        else KOCTE cte"
                 in tcb_space_clear)
        apply (simp add: is_aligned_mask word_bw_assocs)
       apply assumption
@@ -726,13 +732,13 @@ lemma obj_relation_retype_leD:
   by (simp add: obj_relation_retype_def)
 
 lemma obj_relation_retype_default_leD:
-  "\<lbrakk> obj_relation_retype (default_object (APIType_map2 ty) dev us) ko;
+  "\<lbrakk> obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko;
        ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped) \<rbrakk>
       \<Longrightarrow> objBitsKO ko \<le> obj_bits_api (APIType_map2 ty) us"
   by (simp add: obj_relation_retype_def objBits_def obj_bits_dev_irr)
 
 lemma makeObjectKO_Untyped:
-  "makeObjectKO dev ty = Some v \<Longrightarrow> ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped)"
+  "makeObjectKO dev d ty = Some v \<Longrightarrow> ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped)"
   by (clarsimp simp: makeObjectKO_def)
 
 lemma obj_relation_cuts_trivial:
@@ -754,10 +760,10 @@ lemma obj_relation_cuts_trivial:
 lemma obj_relation_retype_addrs_eq:
   assumes not_unt:"ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped)"
   assumes  amp: "m = 2^ ((obj_bits_api (APIType_map2 ty) us) - (objBitsKO ko)) * n"
-  assumes  orr: "obj_relation_retype (default_object (APIType_map2 ty) dev us) ko"
+  assumes  orr: "obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko"
   shows  "\<lbrakk> range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n \<rbrakk> \<Longrightarrow>
    (\<Union>x \<in> set (retype_addrs ptr (APIType_map2 ty) n us).
-            fst ` obj_relation_cuts (default_object (APIType_map2 ty) dev us) x)
+            fst ` obj_relation_cuts (default_object (APIType_map2 ty) dev us d) x)
       = set (new_cap_addrs m ptr ko)"
   apply (rule set_eqI, rule iffI)
    apply (clarsimp simp: retype_addrs_def)
@@ -817,7 +823,7 @@ lemma obj_relation_retype_addrs_eq:
 done
 
 lemma objBits_le_obj_bits_api:
-  "makeObjectKO dev ty = Some ko \<Longrightarrow>
+  "makeObjectKO dev d ty = Some ko \<Longrightarrow>
    objBitsKO ko \<le> obj_bits_api (APIType_map2 ty) us"
   apply (case_tac ty)
     apply (auto simp: default_arch_object_def bit_simps
@@ -846,12 +852,12 @@ lemma retype_pspace_relation:
       and vs': "pspace_aligned' s'" "pspace_distinct' s'"
       and  pn: "pspace_no_overlap_range_cover ptr sz s"
       and pn': "pspace_no_overlap' ptr sz s'"
-      and  ko: "makeObjectKO dev ty = Some ko"
+      and  ko: "makeObjectKO dev d ty = Some ko"
       and cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
-      and orr: "obj_relation_retype (default_object (APIType_map2 ty) dev us) ko"
+      and orr: "obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko"
       and num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
   shows
-  "pspace_relation (foldr (\<lambda>p ps. ps(p \<mapsto> default_object (APIType_map2 ty) dev us))
+  "pspace_relation (foldr (\<lambda>p ps. ps(p \<mapsto> default_object (APIType_map2 ty) dev us d))
                               (retype_addrs ptr (APIType_map2 ty) n us) (kheap s))
             (foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s'))"
   (is "pspace_relation ?ps ?ps'")
@@ -870,7 +876,7 @@ proof
     "set (retype_addrs ptr (APIType_map2 ty) n us) \<inter> dom (kheap s) = {}"
     by auto
 
-  note pdom = pspace_dom_upd [OF dom_Int_ra, where ko="default_object (APIType_map2 ty) dev us"]
+  note pdom = pspace_dom_upd [OF dom_Int_ra, where ko="default_object (APIType_map2 ty) dev us d"]
 
   have pdom': "dom ?ps' = dom (ksPSpace s') \<union> set (new_cap_addrs m ptr ko)"
     by (clarsimp simp add: foldr_upd_app_if[folded data_map_insert_def]
@@ -942,79 +948,6 @@ lemma foldr_upd_app_if': "foldr (\<lambda>p ps. ps(p := f p)) as g = (\<lambda>x
   apply simp
   done
 
-lemma etcb_rel_makeObject: "etcb_relation default_etcb makeObject"
-  apply (simp add: etcb_relation_def default_etcb_def)
-  apply (simp add: makeObject_tcb default_priority_def default_domain_def)
-  done
-
-
-lemma ekh_at_tcb_at: "valid_etcbs_2 ekh kh \<Longrightarrow> ekh x = Some y  \<Longrightarrow> \<exists>tcb. kh x = Some (TCB tcb)"
-  apply (simp add: valid_etcbs_2_def
-                   st_tcb_at_kh_def obj_at_kh_def
-                   is_etcb_at'_def obj_at_def)
-  apply force
-  done
-
-lemma default_etcb_default_domain_futz [simp]:
-  "default_etcb\<lparr>tcb_domain := default_domain\<rparr> = default_etcb"
-unfolding default_etcb_def by simp
-
-lemma retype_ekheap_relation:
-  assumes  sr: "ekheap_relation (ekheap s) (ksPSpace s')"
-      and  sr': "pspace_relation (kheap s) (ksPSpace s')"
-      and  vs: "valid_pspace s" "valid_mdb s"
-      and et: "valid_etcbs s"
-      and vs': "pspace_aligned' s'" "pspace_distinct' s'"
-      and  pn: "pspace_no_overlap_range_cover ptr sz s"
-      and pn': "pspace_no_overlap' ptr sz s'"
-      and  ko: "makeObjectKO dev ty = Some ko"
-      and cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
-      and orr: "obj_relation_retype (default_object (APIType_map2 ty) dev us) ko"
-      and num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
-  shows
-  "ekheap_relation (foldr (\<lambda>p ps. ps(p := default_ext (APIType_map2 ty) default_domain))
-                              (retype_addrs ptr (APIType_map2 ty) n us) (ekheap s))
-            (foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s'))"
-  (is "ekheap_relation ?ps ?ps'")
-  proof -
-  have not_unt: "ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped)"
-     by (rule makeObjectKO_Untyped[OF ko])
-  show ?thesis
-    apply (case_tac "ty \<noteq> Inr (APIObjectType apiobject_type.TCBObject)")
-     apply (insert ko)
-     apply (cut_tac retype_pspace_relation[OF sr' vs vs' pn pn' ko cover orr num_r])
-     apply (simp add: foldr_upd_app_if' foldr_upd_app_if[folded data_map_insert_def])
-     apply (simp add: obj_relation_retype_addrs_eq[OF not_unt num_r orr cover,symmetric])
-     apply (insert sr)
-     apply (clarsimp simp add: ekheap_relation_def
-                      pspace_relation_def default_ext_def cong: if_cong
-                      split: if_split_asm)
-      subgoal by (clarsimp simp add: makeObjectKO_def APIType_map2_def cong: if_cong
-                              split: sum.splits Structures_H.kernel_object.splits
-                                     arch_kernel_object.splits AARCH64_H.object_type.splits apiobject_type.splits)
-
-     apply (frule ekh_at_tcb_at[OF et])
-     apply (intro impI conjI)
-      apply clarsimp
-      apply (drule_tac x=a in bspec,force)
-      apply (clarsimp simp: tcb_relation_cut_def split: if_split_asm)
-       apply (case_tac ko,simp_all)
-       apply (clarsimp simp add: makeObjectKO_def cong: if_cong split: sum.splits Structures_H.kernel_object.splits
-                                 arch_kernel_object.splits AARCH64_H.object_type.splits
-                                 apiobject_type.splits if_split_asm)
-      apply (drule_tac x=xa in bspec,simp)
-      subgoal by force
-     subgoal by force
-    apply (simp add: foldr_upd_app_if' foldr_upd_app_if[folded data_map_insert_def])
-    apply (simp add: obj_relation_retype_addrs_eq[OF not_unt num_r orr cover,symmetric])
-    apply (clarsimp simp add: APIType_map2_def default_ext_def ekheap_relation_def
-           default_object_def makeObjectKO_def etcb_rel_makeObject
-           cong: if_cong
-           split: if_split_asm)
-    apply force
-  done
-qed
-
 lemma pspace_no_overlapD':
   "\<lbrakk> ksPSpace s x = Some ko; pspace_no_overlap' p bits s \<rbrakk>
        \<Longrightarrow> {x .. x + 2 ^ objBitsKO ko - 1} \<inter> {p .. (p && ~~ mask bits) + 2 ^ bits - 1} = {}"
@@ -1214,7 +1147,7 @@ lemma retype_ksPSpace_dom_same:
   fixes x v
   assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
   assumes   pn': "pspace_no_overlap' ptr sz s'"
-  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes    ko: "makeObjectKO dev d ty = Some ko"
   assumes cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
   assumes num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
   shows
@@ -1253,7 +1186,7 @@ qed
 lemma retype_tcbSchedPrevs_of:
   assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
   assumes   pn': "pspace_no_overlap' ptr sz s'"
-  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes    ko: "makeObjectKO dev d ty = Some ko"
   assumes cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
   assumes num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
   shows
@@ -1279,7 +1212,7 @@ qed
 lemma retype_tcbSchedNexts_of:
   assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
   assumes   pn': "pspace_no_overlap' ptr sz s'"
-  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes    ko: "makeObjectKO dev d ty = Some ko"
   assumes cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
   assumes num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
   shows
@@ -1305,7 +1238,7 @@ qed
 lemma retype_inQ:
   assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
   assumes   pn': "pspace_no_overlap' ptr sz s'"
-  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes    ko: "makeObjectKO dev d ty = Some ko"
   assumes cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
   assumes num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
   shows
@@ -1334,12 +1267,12 @@ lemma retype_ready_queues_relation:
   assumes  rlqr: "ready_queues_relation s s'"
   assumes   vs': "pspace_aligned' s'" "pspace_distinct' s'"
   assumes   pn': "pspace_no_overlap' ptr sz s'"
-  assumes    ko: "makeObjectKO dev ty = Some ko"
+  assumes    ko: "makeObjectKO dev d ty = Some ko"
   assumes cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
   assumes num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
   shows
     "ready_queues_relation
-       (s \<lparr>kheap := foldr (\<lambda>p. data_map_insert p (default_object (APIType_map2 ty) dev us))
+       (s \<lparr>kheap := foldr (\<lambda>p. data_map_insert p (default_object (APIType_map2 ty) dev us d))
                                              (retype_addrs ptr (APIType_map2 ty) n us) (kheap s)\<rparr>)
        (s'\<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s')\<rparr>)"
   using rlqr
@@ -1352,31 +1285,28 @@ lemma retype_state_relation:
   notes data_map_insert_def[simp del]
   assumes  sr:   "(s, s') \<in> state_relation"
       and  vs:   "valid_pspace s" "valid_mdb s"
-      and  et:   "valid_etcbs s" "valid_list s"
+      and  et:   "valid_list s"
       and vs':   "pspace_aligned' s'" "pspace_distinct' s'"
       and  pn:   "pspace_no_overlap_range_cover ptr sz s"
       and pn':   "pspace_no_overlap' ptr sz s'"
       and cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
-      and  ko:   "makeObjectKO dev ty = Some ko"
+      and  ko:   "makeObjectKO dev d ty = Some ko"
       and api:   "obj_bits_api (APIType_map2 ty) us \<le> sz"
-      and orr:   "obj_relation_retype (default_object (APIType_map2 ty) dev us) ko"
+      and orr:   "obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko"
       and num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
   shows
-  "(ekheap_update
-              (\<lambda>_. foldr (\<lambda>p ekh a. if a = p then default_ext (APIType_map2 ty) default_domain else ekh a)
-                    (retype_addrs ptr (APIType_map2 ty) n us) (ekheap s))
-            s
-           \<lparr>kheap :=
-              foldr (\<lambda>p. data_map_insert p (default_object (APIType_map2 ty) dev us))
+  "(s \<lparr>kheap :=
+              foldr (\<lambda>p. data_map_insert p (default_object (APIType_map2 ty) dev us d))
                (retype_addrs ptr (APIType_map2 ty) n us) (kheap s)\<rparr>,
            update_gs (APIType_map2 ty) us (set (retype_addrs ptr (APIType_map2 ty) n us))
             (s'\<lparr>ksPSpace :=
                   foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko)
                    (ksPSpace s')\<rparr>))
           \<in> state_relation"
-  (is "(ekheap_update (\<lambda>_. ?eps) s\<lparr>kheap := ?ps\<rparr>, update_gs _ _ _ (s'\<lparr>ksPSpace := ?ps'\<rparr>))
+  (is "(s\<lparr>kheap := ?ps\<rparr>, update_gs _ _ _ (s'\<lparr>ksPSpace := ?ps'\<rparr>))
        \<in> state_relation")
-  proof (rule state_relation_null_filterE[OF sr refl _ _ _ _ _ _ _ _ vs'], simp_all add: trans_state_update[symmetric] del: trans_state_update)
+  proof (rule state_relation_null_filterE[OF sr refl _ _ _ _ _ _ _ vs'],
+         simp_all add: trans_state_update[symmetric] del: trans_state_update)
 
   have cover':"range_cover ptr sz (objBitsKO ko) m"
     by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF ko] num_r])
@@ -1442,12 +1372,6 @@ lemma retype_state_relation:
     by (rule retype_pspace_relation [OF _ vs vs' pn pn' ko cover orr num_r,
         folded data_map_insert_def])
 
-  have "ekheap_relation (ekheap (s)) (ksPSpace s')"
-  using sr by (simp add: state_relation_def)
-
-  thus "ekheap_relation ?eps ?ps'"
-    by (fold fun_upd_apply) (rule retype_ekheap_relation[OF _ pspr vs et(1) vs' pn pn' ko cover orr num_r])
-
   have pn2: "\<forall>a\<in>set ?al. kheap s a = None"
     by (rule ccontr) (clarsimp simp: pspace_no_overlapD1[OF pn _ cover vs(1)])
 
@@ -1642,208 +1566,6 @@ lemma objBitsKO_gt_0: "0 < objBitsKO ko"
     apply (simp_all add:archObjSize_def bit_simps)
   done
 
-lemma kheap_ekheap_double_gets:
-  "(\<And>rv erv rv'. \<lbrakk>pspace_relation rv rv'; ekheap_relation erv rv'\<rbrakk>
-                 \<Longrightarrow> corres r (R rv erv) (R' rv') (b rv erv) (d rv')) \<Longrightarrow>
-   corres r (\<lambda>s. R (kheap s) (ekheap s) s) (\<lambda>s. R' (ksPSpace s) s)
-          (do x \<leftarrow> gets kheap; xa \<leftarrow> gets ekheap; b x xa od) (gets ksPSpace >>= d)"
-  apply (rule corres_symb_exec_l)
-     apply (rule corres_guard_imp)
-       apply (rule_tac r'= "\<lambda>erv rv'. ekheap_relation erv rv' \<and> pspace_relation x rv'"
-               in corres_split)
-          apply (subst corres_gets[where P="\<lambda>s. x = kheap s" and P'=\<top>])
-          apply clarsimp
-          apply (simp add: state_relation_def)
-         apply clarsimp
-         apply assumption
-        apply (wp gets_exs_valid | simp)+
-  done
-
-(*
-
-Split out the extended operation that sets the etcb domains.
-
-This allows the existing corres proofs in this file to more-or-less go
-through as they stand.
-
-A more principled fix would be to change the abstract spec and
-generalise init_arch_objects to initialise other object types.
-
-*)
-
-definition retype_region2_ext :: "obj_ref list \<Rightarrow> Structures_A.apiobject_type \<Rightarrow> unit det_ext_monad" where
-  "retype_region2_ext ptrs type \<equiv> modify (\<lambda>s. ekheap_update (foldr (\<lambda>p ekh. (ekh(p := default_ext type default_domain))) ptrs) s)"
-
-crunch retype_region2_ext
-  for all_but_exst[wp]: "all_but_exst P"
-crunch retype_region2_ext
-  for (empty_fail) empty_fail[wp]
-
-end
-
-interpretation retype_region2_ext_extended: is_extended "retype_region2_ext ptrs type"
-  by (unfold_locales; wp)
-
-context begin interpretation Arch . (*FIXME: arch-split*)
-
-definition
- "retype_region2_extra_ext ptrs type \<equiv>
-     when (type = Structures_A.TCBObject) (do
-       cdom \<leftarrow> gets cur_domain;
-       mapM_x (ethread_set (\<lambda>tcb. tcb\<lparr>tcb_domain := cdom\<rparr>)) ptrs
-      od)"
-
-crunch retype_region2_extra_ext
-  for all_but_exst[wp]: "all_but_exst P" (wp: mapM_x_wp)
-crunch retype_region2_extra_ext
-  for (empty_fail) empty_fail[wp] (wp: mapM_x_wp)
-
-end
-
-interpretation retype_region2_extra_ext_extended: is_extended "retype_region2_extra_ext ptrs type"
-  by (unfold_locales; wp)
-
-context begin interpretation Arch . (*FIXME: arch-split*)
-
-definition
-  retype_region2 :: "obj_ref \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> Structures_A.apiobject_type \<Rightarrow> bool \<Rightarrow> (obj_ref list,'z::state_ext) s_monad"
-where
-  "retype_region2 ptr numObjects o_bits type dev \<equiv> do
-    obj_size \<leftarrow> return $ 2 ^ obj_bits_api type o_bits;
-    ptrs \<leftarrow> return $ map (\<lambda>p. ptr_add ptr (p * obj_size)) [0..< numObjects];
-    when (type \<noteq> Structures_A.Untyped) (do
-      kh \<leftarrow> gets kheap;
-      kh' \<leftarrow> return $ foldr (\<lambda>p kh. kh(p \<mapsto> default_object type dev o_bits)) ptrs kh;
-      do_extended_op (retype_region2_ext ptrs type);
-      modify $ kheap_update (K kh')
-    od);
-    return $ ptrs
-  od"
-
-lemma retype_region_ext_modify_kheap_futz:
-  "(retype_region2_extra_ext ptrs type :: (unit, det_ext) s_monad) >>= (\<lambda>_. modify (kheap_update f))
- = (modify (kheap_update f) >>= (\<lambda>_. retype_region2_extra_ext ptrs type))"
-  apply (clarsimp simp: retype_region_ext_def retype_region2_ext_def retype_region2_extra_ext_def when_def bind_assoc)
-  apply (subst oblivious_modify_swap)
-   defer
-   apply (simp add: bind_assoc)
-  apply (rule oblivious_bind)
-  apply simp
-  apply (rule oblivious_mapM_x)
-  apply (clarsimp simp: ethread_set_def set_eobject_def)
-  apply (rule oblivious_bind)
-   apply (simp add: gets_the_def)
-   apply (rule oblivious_bind)
-    apply (clarsimp simp: get_etcb_def)
-    apply simp
-   apply (simp add: modify_def[symmetric])
-done
-
-lemmas retype_region_ext_modify_kheap_futz' = fun_cong[OF arg_cong[where f=Nondet_Monad.bind, OF retype_region_ext_modify_kheap_futz[symmetric]], simplified bind_assoc]
-
-lemma foldr_upd_app_if_eta_futz:
-  "foldr (\<lambda>p ps. ps(p \<mapsto> f p)) as = (\<lambda>g x. if x \<in> set as then Some (f x) else g x)"
-apply (rule ext)
-apply (rule foldr_upd_app_if)
-done
-
-lemma modify_ekheap_update_comp_futz:
-  "modify (ekheap_update (f \<circ> g)) = modify (ekheap_update g) >>= (K (modify (ekheap_update f)))"
-by (simp add: o_def modify_def bind_def gets_def get_def put_def)
-
-lemma mapM_x_modify_futz:
-  assumes "\<forall>ptr\<in>set ptrs. ekheap s ptr \<noteq> None"
-  shows "mapM_x (ethread_set F) (rev ptrs) s
-       = modify (ekheap_update (foldr (\<lambda>p ekh. ekh(p := Some (F (the (ekh p))))) ptrs)) s" (is "?lhs ptrs s = ?rhs ptrs s")
-using assms
-proof(induct ptrs arbitrary: s)
-  case Nil thus ?case by (simp add: mapM_x_Nil return_def simpler_modify_def)
-next
-  case (Cons ptr ptrs s)
-  have "?rhs (ptr # ptrs) s
-      = (do modify (ekheap_update (foldr (\<lambda>p ekh. ekh(p \<mapsto> F (the (ekh p)))) ptrs));
-            modify (ekheap_update (\<lambda>ekh. ekh(ptr \<mapsto> F (the (ekh ptr)))))
-        od) s"
-    by (simp only: foldr_Cons modify_ekheap_update_comp_futz) simp
-  also have "... = (do ?lhs ptrs;
-                      modify (ekheap_update (\<lambda>ekh. ekh(ptr \<mapsto> F (the (ekh ptr)))))
-                    od) s"
-    apply (rule monad_eq_split_tail)
-     apply simp
-    apply (rule Cons.hyps[symmetric])
-    using Cons.prems
-    apply force
-    done
-  also have "... = ?lhs (ptr # ptrs) s"
-    apply (simp add: mapM_x_append mapM_x_singleton)
-    apply (rule monad_eq_split2[OF refl, where
-                 P="\<lambda>s. \<forall>ptr\<in>set (ptr # ptrs). ekheap s ptr \<noteq> None"
-             and Q="\<lambda>_ s. ekheap s ptr \<noteq> None"])
-      apply (simp add: ethread_set_def
-                       assert_opt_def get_etcb_def gets_the_def gets_def get_def modify_def put_def set_eobject_def
-                       bind_def fail_def return_def split_def
-                split: option.splits)
-     apply ((wp mapM_x_wp[OF _ subset_refl] | simp add: ethread_set_def set_eobject_def)+)[1]
-    using Cons.prems
-    apply force
-    done
-  finally show ?case by (rule sym)
-qed
-
-lemma awkward_fold_futz:
-  "fold (\<lambda>p ekh. ekh(p \<mapsto> the (ekh p)\<lparr>tcb_domain := cur_domain s\<rparr>)) ptrs ekh
- = (\<lambda>x. if x \<in> set ptrs then Some ((the (ekh x))\<lparr>tcb_domain := cur_domain s\<rparr>) else ekh x)"
-by (induct ptrs arbitrary: ekh) (simp_all add: fun_eq_iff)
-
-lemma retype_region2_ext_retype_region_ext_futz:
-  "retype_region2_ext ptrs type >>= (\<lambda>_. retype_region2_extra_ext ptrs type)
- = retype_region_ext ptrs type"
-proof(cases type)
-  case TCBObject
-  have complete_futz:
-    "\<And>F x. modify (ekheap_update (\<lambda>_. F (cur_domain x) (ekheap x))) x = modify (ekheap_update (\<lambda>ekh. F (cur_domain x) ekh)) x"
-    by (simp add: modify_def get_def get_etcb_def put_def bind_def return_def)
-  have second_futz:
-  "\<And>f G.
-   do modify (ekheap_update f);
-      cdom \<leftarrow> gets (\<lambda>s. cur_domain s);
-      G cdom
-   od =
-   do cdom \<leftarrow> gets (\<lambda>s. cur_domain s);
-      modify (ekheap_update f);
-      G cdom
-   od"
-    by (simp add: bind_def gets_def get_def return_def simpler_modify_def)
-  from TCBObject show ?thesis
-    apply (clarsimp simp: retype_region_ext_def retype_region2_ext_def retype_region2_extra_ext_def when_def bind_assoc)
-    apply (clarsimp simp: exec_gets fun_eq_iff)
-    apply (subst complete_futz)
-    apply (simp add: second_futz[simplified] exec_gets)
-    apply (simp add: default_ext_def exec_modify)
-    apply (subst mapM_x_modify_futz[where ptrs="rev ptrs", simplified])
-     apply (simp add: foldr_upd_app_if_eta_futz)
-    apply (simp add: modify_def exec_get put_def o_def)
-    apply (simp add: foldr_upd_app_if_eta_futz foldr_conv_fold awkward_fold_futz)
-    apply (simp cong: if_cong)
-    done
-qed (auto simp: fun_eq_iff retype_region_ext_def retype_region2_ext_def retype_region2_extra_ext_def
-                put_def gets_def get_def bind_def return_def mk_ef_def modify_def foldr_upd_app_if' when_def default_ext_def)
-
-lemma retype_region2_ext_retype_region:
-  "(retype_region ptr numObjects o_bits type dev :: (obj_ref list, det_ext) s_monad)
- = (do ptrs \<leftarrow> retype_region2 ptr numObjects o_bits type dev;
-       retype_region2_extra_ext ptrs type;
-       return ptrs
-    od)"
-apply (clarsimp simp: retype_region_def retype_region2_def when_def bind_assoc)
- apply safe
- defer
- apply (simp add: retype_region2_extra_ext_def)
-apply (subst retype_region_ext_modify_kheap_futz'[simplified bind_assoc])
-apply (subst retype_region2_ext_retype_region_ext_futz[symmetric])
-apply (simp add: bind_assoc)
-done
-
 lemma getObject_tcb_gets:
   "getObject addr >>= (\<lambda>x::tcb. gets proj >>= (\<lambda>y. G x y))
  = gets proj >>= (\<lambda>y. getObject addr >>= (\<lambda>x. G x y))"
@@ -1886,37 +1608,26 @@ next
     done
 qed
 
-(*
-
-The existing proof continues below.
-
-*)
-
-lemma modify_ekheap_update_ekheap:
-  "modify (\<lambda>s. ekheap_update f s) = do s \<leftarrow> gets ekheap; modify (\<lambda>s'. s'\<lparr>ekheap := f s\<rparr>) od"
-by (simp add: modify_def gets_def get_def put_def bind_def return_def split_def fun_eq_iff)
-
 lemma corres_retype':
   assumes    not_zero: "n \<noteq> 0"
   and         aligned: "is_aligned ptr (objBitsKO ko + gbits)"
-  and    obj_bits_api: "obj_bits_api (APIType_map2 ty) us =
-                        objBitsKO ko + gbits"
-  and           check: "(sz < obj_bits_api (APIType_map2 ty)  us)
-                           = (sz < objBitsKO ko + gbits)"
+  and    obj_bits_api: "obj_bits_api (APIType_map2 ty) us = objBitsKO ko + gbits"
+  and           check: "(sz < obj_bits_api (APIType_map2 ty) us) = (sz < objBitsKO ko + gbits)"
   and             usv: "APIType_map2 ty = Structures_A.CapTableObject \<Longrightarrow> 0 < us"
-  and              ko: "makeObjectKO dev ty = Some ko"
+  and              ko: "makeObjectKO dev d ty = Some ko"
   and             orr: "obj_bits_api (APIType_map2 ty) us \<le> sz \<Longrightarrow>
-                        obj_relation_retype
-                          (default_object (APIType_map2 ty) dev us) ko"
+                        obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko"
   and           cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
   shows "corres (\<lambda>rv rv'. rv' = g rv)
-  (\<lambda>s. valid_pspace s \<and> pspace_no_overlap_range_cover ptr sz s
-     \<and> valid_mdb s \<and> valid_etcbs s \<and> valid_list s)
-  (\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s)
-  (retype_region2 ptr n us (APIType_map2 ty) dev)
-  (do addrs \<leftarrow> createObjects ptr n ko gbits;
-      _ \<leftarrow> modify (update_gs (APIType_map2 ty) us (set addrs));
-      return (g addrs) od)"
+                (\<lambda>s. valid_pspace s \<and> pspace_no_overlap_range_cover ptr sz s
+                     \<and> valid_mdb s \<and> valid_list s)
+                (\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s
+                      \<and> (ty = Inr (APIObjectType TCBObject) \<longrightarrow> d = ksCurDomain s))
+                (retype_region ptr n us (APIType_map2 ty) dev)
+                (do addrs \<leftarrow> createObjects ptr n ko gbits;
+                    _ \<leftarrow> modify (update_gs (APIType_map2 ty) us (set addrs));
+                    return (g addrs)
+                 od)"
   (is "corres ?r ?P ?P' ?C ?A")
 proof -
   note data_map_insert_def[simp del]
@@ -1994,7 +1705,7 @@ proof -
   have al': "is_aligned ptr (obj_bits_api (APIType_map2 ty) us)"
      by (simp add: obj_bits_api ko)
   show ?thesis
-  apply (simp add: when_def retype_region2_def createObjects'_def
+  apply (simp add: when_def retype_region_def createObjects'_def
                    createObjects_def aligned obj_bits_api[symmetric]
                    ko[symmetric] al' shiftl_t2n data_map_insert_def[symmetric]
                    is_aligned_mask[symmetric] split_def unless_def
@@ -2002,79 +1713,90 @@ proof -
         split del: if_split)
   apply (subst retype_addrs_fold)+
   apply (subst if_P)
-   using ko
-   apply (clarsimp simp: makeObjectKO_def)
-  apply (simp add: bind_assoc retype_region2_ext_def)
-  apply (rule corres_guard_imp)
-    apply (subst modify_ekheap_update_ekheap)
-    apply (simp only: bind_assoc)
-    apply (rule kheap_ekheap_double_gets)
-    apply (rule corres_symb_exec_r)
-       apply (simp add: not_less modify_modify bind_assoc[symmetric]
-                          obj_bits_api[symmetric] shiftl_t2n upto_enum_red'
+    using ko
+    apply (clarsimp simp: makeObjectKO_def)
+   apply (simp add: bind_assoc)
+   apply (rule corres_guard_imp)
+     apply (rule_tac r'=pspace_relation in corres_underlying_split)
+        apply (clarsimp dest!: state_relation_pspace_relation)
+       apply (simp add: gets_def)
+       apply (rule corres_symb_exec_l[rotated])
+          apply (rule exs_valid_get)
+         apply (rule get_sp)
+        apply (simp add: get_def no_fail_def)
+       apply (rule corres_symb_exec_r)
+          apply (simp add: not_less modify_modify bind_assoc[symmetric]
+                           obj_bits_api[symmetric] shiftl_t2n upto_enum_red'
                            range_cover.unat_of_nat_n[OF cover])
-       apply (rule corres_split_nor[OF _ corres_trivial])
-          apply (rename_tac x eps ps)
-          apply (rule_tac P="\<lambda>s. x = kheap s \<and> eps = ekheap (s) \<and> ?P s" and
-                          P'="\<lambda>s. ps = ksPSpace s \<and> ?P' s" in corres_modify)
-          apply (simp add: set_retype_addrs_fold new_caps_adds_fold)
-          apply (erule retype_state_relation[OF _ _ _ _ _ _ _ _ _ cover _ _ orr],
-                 simp_all add: ko not_zero obj_bits_api
-                               bound[simplified obj_bits_api ko])[1]
-         apply (clarsimp simp: retype_addrs_fold[symmetric] ptr_add_def upto_enum_red' not_zero'
-                               range_cover.unat_of_nat_n[OF cover] word_le_sub1)
-         apply (rule_tac f=g in arg_cong)
-         apply clarsimp
-        apply wp+
-      apply (clarsimp split: option.splits)
-      apply (intro conjI impI)
-       apply (clarsimp|wp)+
-     apply (clarsimp split: option.splits)
-     apply wpsimp
-    apply (clarsimp split: option.splits)
-    apply (intro conjI impI)
-     apply wp
-    apply (clarsimp simp:lookupAround2_char1)
-    apply wp
-    apply (clarsimp simp: obj_bits_api ko)
-    apply (drule(1) pspace_no_overlap_disjoint')
-    apply (rule_tac x1 = a in ccontr[OF in_empty_interE])
-      apply simp
-     apply (clarsimp simp: not_less shiftL_nat)
-     apply (erule order_trans)
-     apply (subst p_assoc_help)
-     apply (subst word_plus_and_or_coroll2[symmetric,where w = "mask sz"])
-     apply (subst add.commute)
-     apply (subst add.assoc)
-     apply (rule word_plus_mono_right)
-      using cover
-      apply -
-      apply (rule iffD2[OF word_le_nat_alt])
-      apply (subst word_of_nat_minus)
-       using not_zero
-       apply simp
-      apply (rule le_trans[OF unat_plus_gt])
-      apply simp
-      apply (subst unat_minus_one)
-       apply (subst mult.commute)
-       apply (rule word_power_nonzero_64)
-         apply (rule of_nat_less_pow_64[OF n_estimate])
-         apply (simp add:word_bits_def objBitsKO_gt_0 ko)
-        apply (simp add:range_cover_def obj_bits_api ko word_bits_def)
-       apply (cut_tac not_zero',clarsimp simp:ko)
-      apply(clarsimp simp:field_simps ko)
-      apply (subst unat_sub[OF word_1_le_power])
-       apply (simp add:range_cover_def)
-      apply (subst diff_add_assoc[symmetric])
-       apply (cut_tac unat_of_nat_n',simp add:ko)
-      apply (clarsimp simp: obj_bits_api ko)
-      apply (rule diff_le_mono)
-      apply (frule range_cover.range_cover_compare_bound)
-      apply (cut_tac obj_bits_api unat_of_nat_shift')
-      apply (clarsimp simp:add.commute range_cover_def ko)
-     apply (rule is_aligned_no_wrap'[OF is_aligned_neg_mask,OF le_refl ])
-     apply (simp add:range_cover_def domI)+
-  done
+          apply (rule corres_guard_imp)
+            apply (rule corres_split_nor[OF _ corres_trivial])
+               apply (rename_tac ps ps' sa)
+               apply (rule_tac P="\<lambda>s. ps = kheap s \<and> sa = s \<and> ?P s" and
+                               P'="\<lambda>s. ps' = ksPSpace s \<and> ?P' s" in corres_modify)
+               apply(frule curdomain_relation[THEN sym])
+               apply (simp add: set_retype_addrs_fold new_caps_adds_fold)
+               apply (drule retype_state_relation[OF _ _ _ _ _ _ _ _ cover _ _ orr],
+                      simp_all add: ko not_zero obj_bits_api
+                                    bound[simplified obj_bits_api ko])[1]
+               apply (cases ty; simp; rename_tac tp; case_tac tp;
+                      clarsimp simp: default_object_def APIType_map2_def
+                              split: arch_kernel_object.splits apiobject_type.splits)
+              apply (clarsimp simp: retype_addrs_fold[symmetric] ptr_add_def upto_enum_red' not_zero'
+                                    range_cover.unat_of_nat_n[OF cover] word_le_sub1)
+              apply (rule_tac f=g in arg_cong)
+              apply clarsimp
+             apply wpsimp+
+           apply simp+
+         apply (clarsimp split: option.splits)
+         apply (intro conjI impI)
+          apply (clarsimp|wp)+
+        apply (clarsimp split: option.splits)
+        apply wpsimp
+       apply (clarsimp split: option.splits)
+       apply (intro conjI impI)
+        apply wp
+       apply (clarsimp simp:lookupAround2_char1)
+       apply wp
+       apply (clarsimp simp: obj_bits_api ko)
+       apply (drule(1) pspace_no_overlap_disjoint')
+       apply (rule_tac x1 = a in ccontr[OF in_empty_interE])
+         apply simp
+        apply (clarsimp simp: not_less shiftL_nat)
+        apply (erule order_trans)
+        apply (subst p_assoc_help)
+        apply (subst word_plus_and_or_coroll2[symmetric,where w = "mask sz"])
+        apply (subst add.commute)
+        apply (subst add.assoc)
+        apply (rule word_plus_mono_right)
+         using cover
+         apply -
+         apply (rule iffD2[OF word_le_nat_alt])
+         apply (subst word_of_nat_minus)
+          using not_zero
+          apply simp
+         apply (rule le_trans[OF unat_plus_gt])
+         apply simp
+         apply (subst unat_minus_one)
+          apply (subst mult.commute)
+          apply (rule word_power_nonzero_64)
+            apply (rule of_nat_less_pow_64[OF n_estimate])
+            apply (simp add:word_bits_def objBitsKO_gt_0 ko)
+           apply (simp add:range_cover_def obj_bits_api ko word_bits_def)
+          apply (cut_tac not_zero',clarsimp simp:ko)
+         apply(clarsimp simp:field_simps ko)
+         apply (subst unat_sub[OF word_1_le_power])
+          apply (simp add:range_cover_def)
+         apply (subst diff_add_assoc[symmetric])
+          apply (cut_tac unat_of_nat_n',simp add:ko)
+         apply (clarsimp simp: obj_bits_api ko)
+         apply (rule diff_le_mono)
+         apply (frule range_cover.range_cover_compare_bound)
+         apply (cut_tac obj_bits_api unat_of_nat_shift')
+         apply (clarsimp simp:add.commute range_cover_def ko)
+        apply (rule is_aligned_no_wrap'[OF is_aligned_neg_mask,OF le_refl ])
+        apply (simp add:range_cover_def domI)+
+      apply wpsimp+
+   done
 qed
 
 lemma createObjects_corres':
@@ -2566,15 +2288,16 @@ proof -
                              fromIntegral_def toInteger_nat fromInteger_nat APIType_capBits_def curDomain_def
                       split: AARCH64_H.object_type.splits)
         apply (wp mapM_x_wp' hoare_vcg_const_Ball_lift)+
-        apply (rule hoare_post_imp)
-         prefer 2
-         apply (rule createObjects_obj_at [where 'a = "tcb",OF _ not_0])
-          using cover
-          apply (clarsimp simp: AARCH64_H.toAPIType_def APIType_capBits_def objBits_simps
-                         split: AARCH64_H.object_type.splits)
-         apply simp
-        apply (clarsimp simp: valid_cap'_def objBits_simps)
-        apply (fastforce intro: capAligned_tcbI)
+         apply (rule hoare_post_imp)
+          prefer 2
+          apply (rule createObjects_obj_at [where 'a = "tcb",OF _ not_0])
+           using cover
+           apply (clarsimp simp: AARCH64_H.toAPIType_def APIType_capBits_def objBits_simps
+                          split: AARCH64_H.object_type.splits)
+           apply simp+
+         apply (clarsimp simp: valid_cap'_def objBits_simps)
+         apply (fastforce intro: capAligned_tcbI)
+        apply wp
         done
     next
       case EndpointObject with Some cover ct show ?thesis
@@ -2655,7 +2378,7 @@ lemma other_objs_default_relation:
   "\<lbrakk> case ty of Structures_A.EndpointObject \<Rightarrow> ko = injectKO (makeObject :: endpoint)
              | Structures_A.NotificationObject \<Rightarrow> ko = injectKO (makeObject :: Structures_H.notification)
              | _ \<Rightarrow> False \<rbrakk> \<Longrightarrow>
-    obj_relation_retype (default_object ty dev n) ko"
+    obj_relation_retype (default_object ty dev n d) ko"
   apply (rule obj_relation_retype_other_obj)
    apply (clarsimp simp: default_object_def
                          is_other_obj_relation_type_def
@@ -2675,7 +2398,8 @@ lemma other_objs_default_relation:
   done
 
 lemma tcb_relation_retype:
-  "obj_relation_retype (default_object Structures_A.TCBObject dev n) (KOTCB makeObject)"
+  "obj_relation_retype (default_object Structures_A.TCBObject dev n d)
+                       (KOTCB (tcbDomain_update (\<lambda>_. d) makeObject))"
   by (clarsimp simp: tcb_relation_cut_def default_object_def obj_relation_retype_def
                      tcb_relation_def default_tcb_def
                      makeObject_tcb makeObject_cte new_context_def newContext_def newFPUState_def
@@ -2684,7 +2408,7 @@ lemma tcb_relation_retype:
 
 lemma captable_relation_retype:
   "n < word_bits \<Longrightarrow>
-   obj_relation_retype (default_object Structures_A.CapTableObject dev n) (KOCTE makeObject)"
+   obj_relation_retype (default_object Structures_A.CapTableObject dev n d) (KOCTE makeObject)"
   apply (clarsimp simp: obj_relation_retype_def default_object_def
                         wf_empty_bits objBits_simps'
                         dom_empty_cnode ex_with_length cte_level_bits_def)
@@ -2702,7 +2426,7 @@ lemma captable_relation_retype:
   done
 
 lemma pagetable_relation_retype:
-  "obj_relation_retype (default_object (ArchObject PageTableObj) dev n)
+  "obj_relation_retype (default_object (ArchObject PageTableObj) dev n d)
                        (KOArch (KOPTE makeObject))"
   apply (simp add: default_object_def default_arch_object_def
                    makeObject_pte obj_relation_retype_def
@@ -2712,7 +2436,7 @@ lemma pagetable_relation_retype:
   done
 
 lemma vsroot_relation_retype:
-  "obj_relation_retype (default_object (ArchObject VSpaceObj) dev n)
+  "obj_relation_retype (default_object (ArchObject VSpaceObj) dev n d)
                        (KOArch (KOPTE makeObject))"
   apply (simp add: default_object_def default_arch_object_def
                    makeObject_pte obj_relation_retype_def
@@ -2725,20 +2449,21 @@ lemmas makeObjectKO_simps = makeObjectKO_def[split_simps AARCH64_H.object_type.s
  apiobject_type.split sum.split kernel_object.split ]
 
 lemma corres_retype:
-  assumes         not_zero: "n \<noteq> 0"
+  assumes    not_zero: "n \<noteq> 0"
   and         aligned: "is_aligned ptr (objBitsKO ko + gbits)"
   and    obj_bits_api: "obj_bits_api (APIType_map2 ty) us = objBitsKO ko + gbits"
   and              tp: "APIType_map2 ty \<in> no_gs_types"
-  and              ko: "makeObjectKO dev ty = Some ko"
+  and              ko: "makeObjectKO dev d ty = Some ko"
   and             orr: "obj_bits_api (APIType_map2 ty) us \<le> sz \<Longrightarrow>
-                        obj_relation_retype (default_object (APIType_map2 ty) dev us) ko"
+                        obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko"
   and           cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
   shows "corres (=)
   (\<lambda>s. valid_pspace s \<and> pspace_no_overlap_range_cover ptr sz s
-     \<and> valid_mdb s \<and> valid_etcbs s \<and> valid_list s)
+     \<and> valid_mdb s \<and> valid_list s)
   (\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s
-       \<and> (\<exists>val. ko = injectKO val))
-  (retype_region2 ptr n us (APIType_map2 ty) dev) (createObjects ptr n ko gbits)"
+       \<and> (\<exists>val. ko = injectKO val)
+       \<and> (ty = Inr (APIObjectType TCBObject) \<longrightarrow> d = ksCurDomain s))
+  (retype_region ptr n us (APIType_map2 ty) dev) (createObjects ptr n ko gbits)"
   apply (rule corres_guard_imp)
     apply (rule_tac F = "(\<exists>val. ko = injectKO val)" in corres_gen_asm2)
     apply (erule exE)
@@ -3227,7 +2952,8 @@ proof -
 qed
 
 lemma createObjects_valid_pspace':
-  assumes  mko: "makeObjectKO dev ty = Some val"
+  assumes  mko: "makeObjectKO dev d ty = Some val"
+  and    max_d: "ty = Inr (APIObjectType TCBObject) \<longrightarrow> d \<le> maxDomain"
   and    not_0: "n \<noteq> 0"
   and    cover: "range_cover ptr sz (objBitsKO val + gbits) n"
   and    sz_limit: "sz \<le> maxUntypedSizeBits"
@@ -3331,7 +3057,7 @@ proof (intro conjI impI)
                    elim!: ranE
                    split: if_split_asm)
      apply (insert sym[OF mko])[1]
-     apply (clarsimp simp: makeObjectKO_def
+     apply (clarsimp simp: makeObjectKO_def max_d
                     split: bool.split_asm sum.split_asm
                            AARCH64_H.object_type.split_asm
                            apiobject_type.split_asm
@@ -3439,7 +3165,8 @@ abbreviation
  "injectKOS \<equiv> (injectKO :: ('a :: pspace_storable) \<Rightarrow> kernel_object)"
 
 lemma createObjects_valid_pspace_untyped':
-  assumes  mko: "makeObjectKO dev ty = Some val"
+  assumes  mko: "makeObjectKO dev d ty = Some val"
+  and    max_d: "ty = Inr (APIObjectType TCBObject) \<longrightarrow> d \<le> maxDomain"
   and    not_0: "n \<noteq> 0"
   and    cover: "range_cover ptr sz (objBitsKO val + gbits) n"
   and    sz_limit: "sz \<le> maxUntypedSizeBits"
@@ -3447,7 +3174,7 @@ lemma createObjects_valid_pspace_untyped':
   shows "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s \<and> ptr \<noteq> 0
             \<and> caps_overlap_reserved' {ptr .. ptr + of_nat (n * 2^gbits * 2 ^ objBitsKO val ) - 1} s \<rbrace>
   createObjects' ptr n val gbits \<lbrace>\<lambda>r. valid_pspace'\<rbrace>"
-  apply (wp createObjects_valid_pspace' [OF mko not_0 cover sz_limit ptr_cn])
+  apply (wp createObjects_valid_pspace' [OF mko max_d not_0 cover sz_limit ptr_cn])
   apply simp
   done
 
@@ -3627,15 +3354,12 @@ lemma createNewCaps_cte_wp_at2:
      createNewCaps ty ptr n objsz dev
    \<lbrace>\<lambda>rv s. P (cte_wp_at' P' p s)\<rbrace>"
   including classic_wp_pre
-  apply (simp add: createNewCaps_def createObjects_def AARCH64_H.toAPIType_def
-              split del: if_split)
-  apply (case_tac ty; simp add: createNewCaps_def createObjects_def Arch_createNewCaps_def
-                           split del: if_split cong: if_cong)
+  unfolding createNewCaps_def Arch_createNewCaps_def createObjects_def AARCH64_H.toAPIType_def
+  apply (case_tac ty; simp split del: if_split cong: if_cong)
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type; simp split del: if_split)
-            apply (wp, simp add:createObjects_def)
-           apply ((wp createObjects_orig_cte_wp_at2'[where sz = sz]
-                     mapM_x_wp' threadSet_cte_wp_at2')+
+            apply (rule hoare_pre, wp, simp add: createObjects_def)
+           apply ((wp createObjects_orig_cte_wp_at2'[where sz = sz] mapM_x_wp')
                    | assumption
                    | clarsimp simp: APIType_capBits_def projectKO_opts_defs
                                     makeObject_tcb tcb_cte_cases_def cteSizeBits_def
@@ -4169,10 +3893,9 @@ lemma createNewCaps_ko_wp_atQ':
        \<and> pspace_no_overlap' ptr sz s)
        and K (\<forall>d (tcb_x :: tcb). \<not>tcbQueued tcb_x \<and> tcbState tcb_x = Inactive
                    \<longrightarrow> P' (injectKO (tcb_x \<lparr> tcbDomain := d \<rparr>)) = P' (injectKO tcb_x))
-       and K (\<forall>v. makeObjectKO d (Inr ty) = Some v
-                   \<longrightarrow> P' v \<longrightarrow> P True)\<rbrace>
-     createNewCaps ty ptr n us d
-   \<lbrace>\<lambda>rv s. P (ko_wp_at' P' p s)\<rbrace>"
+       and (\<lambda>s. \<forall>v. makeObjectKO dev (ksCurDomain s) (Inr ty) = Some v \<longrightarrow> P' v \<longrightarrow> P True)\<rbrace>
+     createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>_ s. P (ko_wp_at' P' p s)\<rbrace>"
   apply (rule hoare_name_pre_state)
   apply (clarsimp simp: createNewCaps_def AARCH64_H.toAPIType_def
              split del: if_split)
@@ -4309,14 +4032,14 @@ lemma createNewCaps_idle'[wp]:
               leads to a failed proof state. If this could be fixed then the inclusion of
               classic_wp_pre could also be removed. *)
            including classic_wp_pre
-           apply (wp mapM_x_wp' createObjects_idle' threadSet_idle'
+           apply (wp mapM_x_wp' createObjects_idle'
+                  | clarsimp simp: curDomain_def
                   | simp add: projectKO_opt_tcb projectKO_opt_cte mult_2
                               makeObject_cte makeObject_tcb archObjSize_def
                               tcb_cte_cases_def objBitsKO_def APIType_capBits_def
                               objBits_def createObjects_def cteSizeBits_def
                   | simp add: field_simps
-                  | intro conjI impI
-                  | clarsimp simp: curDomain_def)+
+                  | intro conjI impI)+
   done
 
 crunch createNewCaps
@@ -4558,9 +4281,12 @@ lemma createNewCaps_valid_pspace:
   and      cover: "range_cover ptr sz (APIType_capBits ty us) n"
   and      sz_limit: "sz \<le> maxUntypedSizeBits"
   and      ptr_cn: "canonical_address (ptr && ~~ mask sz)"
-  shows "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> valid_pspace' s
-  \<and> caps_no_overlap'' ptr sz s \<and> ptr \<noteq> 0 \<and> caps_overlap_reserved' {ptr..ptr + of_nat n * 2^(APIType_capBits ty us) - 1} s \<and> ksCurDomain s \<le> maxDomain\<rbrace>
-  createNewCaps ty ptr n us dev \<lbrace>\<lambda>r. valid_pspace'\<rbrace>"
+  shows
+  "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> valid_pspace' s
+     \<and> caps_no_overlap'' ptr sz s \<and> ptr \<noteq> 0 \<and> caps_overlap_reserved' {ptr..ptr + of_nat n * 2^(APIType_capBits ty us) - 1} s
+     \<and> ksCurDomain s \<le> maxDomain\<rbrace>
+   createNewCaps ty ptr n us dev
+   \<lbrace>\<lambda>r. valid_pspace'\<rbrace>"
   unfolding createNewCaps_def Arch_createNewCaps_def
   using valid_obj_makeObject_rules sz_limit ptr_cn
   apply (clarsimp simp: AARCH64_H.toAPIType_def
@@ -4570,14 +4296,18 @@ lemma createNewCaps_valid_pspace:
         apply (case_tac apiobject_type, simp_all split del: if_split)
             apply (rule hoare_pre, wp, clarsimp)
            apply (insert cover)
-           apply (wp createObjects_valid_pspace_untyped' [OF _ not_0 , where ty="Inr ty" and sz = sz]
-                     mapM_x_threadSet_valid_pspace mapM_x_wp'
-                 | simp add: makeObjectKO_def APIType_capBits_def
-                             objBits_simps not_0 createObjects_def curDomain_def
-                 | intro conjI impI
-                 | simp add: power_add field_simps mult_2_right
-                 | simp add: bit_simps)+
-  done
+           (* for TCBObject, we need to know a bit more about tcbDomain *)
+           apply (simp add: curDomain_def)
+           apply (rule bind_wp[OF _ gets_sp])
+           apply (clarsimp simp: createObjects_def)
+           apply (rule hoare_assume_pre)
+           by (wp createObjects_valid_pspace_untyped' [OF _ _ not_0 , where ty="Inr ty" and sz = sz]
+                  mapM_x_threadSet_valid_pspace mapM_x_wp'
+               | simp add: makeObjectKO_def APIType_capBits_def
+                           objBits_simps not_0 createObjects_def curDomain_def
+               | intro conjI impI
+               | simp add: power_add field_simps mult_2_right
+               | simp add: bit_simps)+
 
 lemma doMachineOp_return_foo:
   "doMachineOp (do x\<leftarrow>a;return () od) = (do (doMachineOp a); return () od)"
@@ -4765,7 +4495,7 @@ crunch createNewCaps
   (wp: mapM_x_wp' simp: crunch_simps)
 
 lemma createObjects_null_filter':
-  "\<lbrace>\<lambda>s. P (null_filter' (ctes_of s)) \<and> makeObjectKO dev ty = Some val \<and>
+  "\<lbrace>\<lambda>s. P (null_filter' (ctes_of s)) \<and> makeObjectKO dev d ty = Some val \<and>
         range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<and>
         pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
    createObjects' ptr n val gbits
@@ -5174,7 +4904,7 @@ lemma untyped_zero_ranges_cte_def:
   done
 
 lemma createObjects_untyped_ranges_zero':
-  assumes moKO: "makeObjectKO dev ty = Some val"
+  assumes moKO: "makeObjectKO dev d ty = Some val"
   shows
   "\<lbrace>ct_active' and valid_pspace' and pspace_no_overlap' ptr sz
        and untyped_ranges_zero'
@@ -5200,9 +4930,10 @@ lemma createObjects_untyped_ranges_zero':
   done
 
 lemma createObjects_no_cte_invs:
-  assumes moKO: "makeObjectKO dev ty = Some val"
+  assumes moKO: "makeObjectKO dev d ty = Some val"
   assumes no_cte: "\<And>c. projectKO_opt val \<noteq> Some (c::cte)"
   assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
+  and     mdom: "ty = Inr (APIObjectType ArchTypes_H.apiobject_type.TCBObject) \<longrightarrow> d \<le> maxDomain"
   shows
   "\<lbrace>\<lambda>s. range_cover ptr sz ((objBitsKO val) + gbits) n \<and> n \<noteq> 0
         \<and> sz \<le> maxUntypedSizeBits \<and> canonical_address (ptr && ~~ mask sz)
@@ -5287,23 +5018,21 @@ qed
 lemma corres_retype_update_gsI:
   assumes not_zero: "n \<noteq> 0"
   and      aligned: "is_aligned ptr (objBitsKO ko + gbits)"
-  and obj_bits_api: "obj_bits_api (APIType_map2 ty) us =
-                     objBitsKO ko + gbits"
-  and        check: "sz < obj_bits_api (APIType_map2 ty) us \<longleftrightarrow>
-                     sz < objBitsKO ko + gbits"
+  and obj_bits_api: "obj_bits_api (APIType_map2 ty) us = objBitsKO ko + gbits"
+  and        check: "sz < obj_bits_api (APIType_map2 ty) us \<longleftrightarrow> sz < objBitsKO ko + gbits"
   and          usv: "APIType_map2 ty = Structures_A.CapTableObject \<Longrightarrow> 0 < us"
-  and           ko: "makeObjectKO dev ty = Some ko"
+  and           ko: "makeObjectKO dev d ty = Some ko"
   and          orr: "obj_bits_api (APIType_map2 ty) us \<le> sz \<Longrightarrow>
-                     obj_relation_retype
-                       (default_object (APIType_map2 ty) dev us) ko"
+                     obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko"
   and        cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
   and            f: "f = update_gs (APIType_map2 ty) us"
   shows "corres (\<lambda>rv rv'. rv' = g rv)
          (\<lambda>s. valid_pspace s \<and> pspace_no_overlap_range_cover ptr sz s
-            \<and> valid_mdb s \<and> valid_etcbs s \<and> valid_list s)
+            \<and> valid_mdb s \<and> valid_list s)
          (\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and>
-              pspace_no_overlap' ptr sz s)
-         (retype_region2 ptr n us (APIType_map2 ty) dev)
+              pspace_no_overlap' ptr sz s \<and>
+              (ty = Inr (APIObjectType TCBObject) \<longrightarrow> d = ksCurDomain s))
+         (retype_region ptr n us (APIType_map2 ty) dev)
          (do addrs \<leftarrow> createObjects ptr n ko gbits;
              _ \<leftarrow> modify (f (set addrs));
              return (g addrs)
@@ -5314,69 +5043,11 @@ lemma corres_retype_update_gsI:
 lemma gcd_corres: "corres (=) \<top> \<top> (gets cur_domain) curDomain"
   by (simp add: curDomain_def state_relation_def)
 
-lemma retype_region2_extra_ext_mapM_x_corres:
-  shows "corres dc
-           (valid_etcbs and (\<lambda>s. \<forall>addr\<in>set addrs. tcb_at addr s))
-           (\<lambda>s. \<forall>addr\<in>set addrs. obj_at' (Not \<circ> tcbQueued) addr s)
-           (retype_region2_extra_ext addrs Structures_A.apiobject_type.TCBObject)
-           (mapM_x (\<lambda>addr. do cdom \<leftarrow> curDomain;
-                              threadSet (tcbDomain_update (\<lambda>_. cdom)) addr
-                           od)
-             addrs)"
-  apply (rule corres_guard_imp)
-    apply (simp add: retype_region2_extra_ext_def curDomain_mapM_x_futz[symmetric] when_def)
-    apply (rule corres_split_eqr[OF gcd_corres])
-      apply (rule_tac S="Id \<inter> {(x, y). x \<in> set addrs}"
-                  and P="\<lambda>s. (\<forall>t \<in> set addrs. tcb_at t s) \<and> valid_etcbs s"
-                  and P'="\<lambda>s. \<forall>t \<in> set addrs. obj_at' (Not \<circ> tcbQueued) t s"
-                   in corres_mapM_x)
-          apply simp
-          apply (rule corres_guard_imp)
-            apply (rule ethread_set_corres, simp_all add: etcb_relation_def non_exst_same_def)[1]
-            apply (case_tac tcb')
-            apply simp
-           apply fastforce
-          apply (fastforce simp: obj_at'_def)
-         apply (wp hoare_vcg_ball_lift | simp)+
-        apply (clarsimp simp: obj_at'_def)
-       apply fastforce
-      apply auto[1]
-     apply (wp | simp add: curDomain_def)+
-  done
-
-lemma retype_region2_extra_ext_trivial:
-  "ty \<noteq> APIType_map2 (Inr (APIObjectType apiobject_type.TCBObject))
-      \<Longrightarrow> retype_region2_extra_ext ptrs ty = return ()"
-by (simp add: retype_region2_extra_ext_def when_def APIType_map2_def)
-
-lemma retype_region2_retype_region_PageTableObject:
-  "retype_region ptr n us (APIType_map2 (Inr PageTableObject)) dev =
-  (retype_region2 ptr n us (APIType_map2 (Inr PageTableObject)) dev :: obj_ref list det_ext_monad)"
-  by (simp add: retype_region2_ext_retype_region retype_region2_extra_ext_def when_def
-                APIType_map2_def)
-
-lemma retype_region2_valid_etcbs[wp]:"\<lbrace>valid_etcbs\<rbrace> retype_region2 a b c d dev \<lbrace>\<lambda>_. valid_etcbs\<rbrace>"
-  apply (simp add: retype_region2_def)
-  apply (simp add: retype_region2_ext_def bind_assoc)
-  apply wp
-  apply (clarsimp simp del: fun_upd_apply)
-  apply (blast intro: valid_etcb_fold_update)
-  done
-
-lemma retype_region2_obj_at:
-  assumes tytcb: "ty = Structures_A.apiobject_type.TCBObject"
-  shows "\<lbrace>\<top>\<rbrace> retype_region2 ptr n us ty dev \<lbrace>\<lambda>rv s. \<forall>x \<in> set rv. tcb_at x s\<rbrace>"
-  using tytcb unfolding retype_region2_def
-  apply (simp only: return_bind bind_return foldr_upd_app_if fun_app_def K_bind_def)
-  apply (wp dxo_wp_weak | simp)+
-  apply (auto simp: obj_at_def default_object_def is_tcb_def)
-  done
-
-lemma createObjects_Not_tcbQueued:
+lemma createObjects_tcb_at':
   "\<lbrakk>range_cover ptr sz (objBitsKO (injectKOS (makeObject::tcb))) n; n \<noteq> 0\<rbrakk> \<Longrightarrow>
    \<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
    createObjects ptr n (KOTCB makeObject) 0
-   \<lbrace>\<lambda>ptrs s. \<forall>addr\<in>set ptrs. obj_at' (Not \<circ> tcbQueued) addr s\<rbrace>"
+   \<lbrace>\<lambda>ptrs s. \<forall>addr\<in>set ptrs. tcb_at' addr s\<rbrace>"
   apply (rule hoare_strengthen_post[OF createObjects_ko_at_strg[where val = "(makeObject :: tcb)"]])
   apply (auto simp: obj_at'_def project_inject objBitsKO_def objBits_def makeObject_tcb)
   done
@@ -5431,7 +5102,7 @@ lemma regroup_createObjects_dmo_gsPTTypes:
 lemma corres_retype_region_createNewCaps:
   "corres ((\<lambda>r r'. length r = length r' \<and> list_all2 cap_relation r r')
                \<circ> map (\<lambda>ref. default_cap (APIType_map2 (Inr ty)) ref us dev))
-            (\<lambda>s. valid_pspace s \<and> valid_mdb s \<and> valid_etcbs s \<and> valid_list s \<and> valid_arch_state s
+            (\<lambda>s. valid_pspace s \<and> valid_mdb s \<and> valid_list s \<and> valid_arch_state s
                    \<and> caps_no_overlap y sz s \<and> pspace_no_overlap_range_cover y sz s
                    \<and> caps_overlap_reserved {y..y + of_nat n * 2 ^ (obj_bits_api (APIType_map2 (Inr ty)) us) - 1} s
                    \<and> (\<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area y sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
@@ -5466,78 +5137,60 @@ lemma corres_retype_region_createNewCaps:
                 apply simp
                apply (clarsimp simp: range_cover_def)
                apply (arith+)[4]
-           \<comment> \<open>TCB, EP, NTFN\<close>
-           apply (simp_all add: retype_region2_ext_retype_region
-                                bind_cong[OF curDomain_mapM_x_futz refl, unfolded bind_assoc]
-                           split del: if_split)[8]
+           \<comment> \<open>TCB\<close>
+           apply (simp_all add: curDomain_def split del: if_split)
+           apply (rule corres_underlying_gets_pre_rhs[rotated])
+            apply (rule gets_sp)
            apply (rule corres_guard_imp)
+             apply (rule corres_bind_return)
              apply (rule corres_split_eqr)
                 apply (rule corres_retype[where 'a = tcb],
                        simp_all add: obj_bits_api_def objBits_simps' pageBits_def
-                                     APIType_map2_def makeObjectKO_def
-                                     tcb_relation_retype)[1]
-                apply (fastforce simp: range_cover_def)
-               apply (simp add: tcb_relation_retype)
-               apply (rule corres_split_nor)
-                  apply (simp add: APIType_map2_def)
-                  apply (rule retype_region2_extra_ext_mapM_x_corres)
-                 apply (rule corres_trivial, simp)
-                 apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2
-                                       objBits_simps APIType_map2_def)
-                apply wp
-               apply wp
-              apply ((wp retype_region2_obj_at | simp add: APIType_map2_def)+)[1]
-             apply ((wp createObjects_Not_tcbQueued[where sz=sz]
-                     | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1]
-            apply simp
-           apply simp
-          apply (subst retype_region2_extra_ext_trivial)
-           apply (simp add: APIType_map2_def)
-          apply (simp add: liftM_def[symmetric] split del: if_split)
-          apply (rule corres_rel_imp)
-           apply (rule corres_guard_imp)
-             apply (rule corres_retype[where 'a = endpoint],
-                    simp_all add: obj_bits_api_def objBits_simps' pageBits_def APIType_map2_def
-                                  makeObjectKO_def other_objs_default_relation)[1]
-             apply (fastforce simp: range_cover_def)
+                                     APIType_map2_def makeObjectKO_def)[1]
+                 apply (fastforce simp: range_cover_def)
+                apply (simp add: tcb_relation_retype)
+               apply (rule corres_returnTT, simp)
+               apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2
+                                     objBits_simps APIType_map2_def)
+              apply ((wp | simp add: APIType_map2_def)+)[1]
+             apply ((wp createObjects_tcb_at'[where sz=sz] | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1]
             apply simp
            apply simp
-          apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2 objBits_simps
-                                APIType_map2_def)
-         apply (subst retype_region2_extra_ext_trivial)
-          apply (simp add: APIType_map2_def)
+         \<comment> \<open>EP, NTFN\<close>
          apply (simp add: liftM_def[symmetric] split del: if_split)
          apply (rule corres_rel_imp)
           apply (rule corres_guard_imp)
-            apply (rule corres_retype[where 'a = notification],
-                   simp_all add: obj_bits_api_def objBits_simps' pageBits_def APIType_map2_def
-                                 makeObjectKO_def other_objs_default_relation)[1]
-            apply (fastforce simp: range_cover_def)
-           apply simp
-          apply simp
-         apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2 objBits_simps
-                               APIType_map2_def)
-      \<comment> \<open>CapTable\<close>
-        apply (subst retype_region2_extra_ext_trivial)
-         apply (simp add: APIType_map2_def)
-        apply (subst bind_assoc_return_reverse[of "createObjects y n (KOCTE makeObject) us"])
-        apply (subst liftM_def[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
-        apply simp
+            apply (rule corres_retype[where 'a = endpoint],
+                   simp_all add: obj_bits_api_def objBits_simps' pageBits_def
+                                 APIType_map2_def makeObjectKO_def
+                                 other_objs_default_relation)[1]
+            apply ((simp add: range_cover_def APIType_map2_def
+                              list_all2_same list_all2_map1 list_all2_map2)+)[4]
+        apply (simp add: liftM_def[symmetric] split del: if_split)
         apply (rule corres_rel_imp)
          apply (rule corres_guard_imp)
-           apply (rule corres_retype_update_gsI,
-                  simp_all add: obj_bits_api_def objBits_simps' pageBits_def APIType_map2_def
-                                makeObjectKO_def slot_bits_def field_simps ext)[1]
-            apply (simp add: range_cover_def)
-           apply (rule captable_relation_retype,simp add: range_cover_def word_bits_def)
+           apply (rule corres_retype[where 'a = notification],
+                  simp_all add: obj_bits_api_def objBits_simps' pageBits_def
+                                APIType_map2_def makeObjectKO_def
+                                other_objs_default_relation)[1]
+           apply ((simp add: range_cover_def APIType_map2_def
+                             list_all2_same list_all2_map1 list_all2_map2)+)[4]
+          \<comment> \<open>CapTable\<close>
+          apply (find_goal \<open>match premises in "_ = ArchTypes_H.apiobject_type.CapTableObject" \<Rightarrow> \<open>-\<close>\<close>)
+          apply (subst bind_assoc_return_reverse[of "createObjects y n (KOCTE makeObject) us"])
+          apply (subst liftM_def [of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
           apply simp
-         apply simp
-        apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2 objBits_simps
-                              allRights_def APIType_map2_def
-                        split del: if_split)
+          apply (rule corres_rel_imp)
+           apply (rule corres_guard_imp)
+             apply (rule corres_retype_update_gsI,
+                    simp_all add: obj_bits_api_def objBits_simps' pageBits_def
+                                  APIType_map2_def makeObjectKO_def slot_bits_def
+                                  field_simps ext)[1]
+              apply ((clarsimp simp : range_cover_def APIType_map2_def word_bits_def
+                                       list_all2_same list_all2_map1 list_all2_map2
+                     | rule captable_relation_retype)+)[5]
+       \<comment> \<open>HugePageObject\<close>
        apply (in_case \<open>HugePageObject\<close>)
-       apply (subst retype_region2_extra_ext_trivial)
-        apply (simp add: APIType_map2_def)
        apply (simp add: corres_liftM2_simp[unfolded liftM_def] split del: if_split)
        apply (simp add: init_arch_objects_def split del: if_split)
        apply (subst regroup_createObjects_dmo_userPages)
@@ -5561,9 +5214,8 @@ lemma corres_retype_region_createNewCaps:
              apply (simp add: APIType_map2_def arch_default_cap_def vm_read_write_def vmrights_map_def
                               list_all2_map1 list_all2_map2 list_all2_same)
             apply ((wpsimp split_del: if_split)+)[6]
+      \<comment> \<open>VSpaceObject\<close>
       apply (in_case \<open>VSpaceObject\<close>)
-      apply (subst retype_region2_extra_ext_trivial)
-       apply (simp add: APIType_map2_def)
       apply (simp add: corres_liftM2_simp[unfolded liftM_def] split del: if_split)
       apply (simp add: init_arch_objects_def split del: if_split)
       apply (subst regroup_createObjects_dmo_gsPTTypes)
@@ -5584,9 +5236,8 @@ lemma corres_retype_region_createNewCaps:
             apply (rule corres_returnTT)
             apply (simp add:  arch_default_cap_def list_all2_map1 list_all2_map2 list_all2_same)
            apply ((wpsimp split_del: if_split)+)[6]
+     \<comment> \<open>SmallPageObject\<close>
      apply (in_case \<open>SmallPageObject\<close>)
-     apply (subst retype_region2_extra_ext_trivial)
-      apply (simp add: APIType_map2_def)
      apply (simp add: corres_liftM2_simp[unfolded liftM_def] split del: if_split)
      apply (simp add: init_arch_objects_def split del: if_split)
      apply (subst regroup_createObjects_dmo_userPages)
@@ -5610,9 +5261,8 @@ lemma corres_retype_region_createNewCaps:
            apply (simp add: APIType_map2_def arch_default_cap_def vm_read_write_def vmrights_map_def
                             list_all2_map1 list_all2_map2 list_all2_same)
           apply ((wpsimp split_del: if_split)+)[6]
+    \<comment> \<open>LargePageObject\<close>
     apply (in_case \<open>LargePageObject\<close>)
-    apply (subst retype_region2_extra_ext_trivial)
-     apply (simp add: APIType_map2_def)
     apply (simp add: corres_liftM2_simp[unfolded liftM_def] split del: if_split)
     apply (simp add: init_arch_objects_def split del: if_split)
     apply (subst regroup_createObjects_dmo_userPages)
@@ -5636,9 +5286,8 @@ lemma corres_retype_region_createNewCaps:
           apply (simp add: APIType_map2_def arch_default_cap_def vm_read_write_def vmrights_map_def
                            list_all2_map1 list_all2_map2 list_all2_same)
          apply ((wpsimp split_del: if_split)+)[6]
+   \<comment> \<open>PageTableObject\<close>
    apply (in_case \<open>PageTableObject\<close>)
-   apply (subst retype_region2_ext_retype_region)
-   apply (subst retype_region2_extra_ext_trivial, simp add: APIType_map2_def)
    apply (simp_all add: corres_liftM2_simp[unfolded liftM_def])
    apply (simp add: init_arch_objects_def split del: if_split)
    apply (subst regroup_createObjects_dmo_gsPTTypes)
@@ -5660,11 +5309,8 @@ lemma corres_retype_region_createNewCaps:
          apply (clarsimp simp: list_all2_map1 list_all2_map2 list_all2_same
                                APIType_map2_def arch_default_cap_def)
         apply ((wpsimp split_del: if_split)+)[6]
+  \<comment> \<open>VCPUObject\<close>
   apply (in_case \<open>VCPUObject\<close>)
-  apply (subst retype_region2_ext_retype_region)
-  apply (subst retype_region2_extra_ext_trivial)
-   apply (simp add: APIType_map2_def)
-  apply (simp add: corres_liftM2_simp[unfolded liftM_def] split del: if_split)
   apply (rule corres_rel_imp)
    apply (simp add: init_arch_objects_APIType_map2_VCPU_noop split del: if_split)
    apply (rule corres_guard_imp)
diff --git a/proof/refine/AARCH64/Schedule_R.thy b/proof/refine/AARCH64/Schedule_R.thy
index 091798dacf..39b341a24c 100644
--- a/proof/refine/AARCH64/Schedule_R.thy
+++ b/proof/refine/AARCH64/Schedule_R.thy
@@ -194,7 +194,7 @@ lemma schedule_choose_new_thread_sched_act_rct[wp]:
 lemma tcbSchedAppend_corres:
   "tcb_ptr = tcbPtr \<Longrightarrow>
    corres dc
-     (in_correct_ready_q and ready_qs_distinct and valid_etcbs and st_tcb_at runnable tcb_ptr
+     (in_correct_ready_q and ready_qs_distinct and st_tcb_at runnable tcb_ptr
       and pspace_aligned and pspace_distinct)
      (sym_heap_sched_pointers and valid_sched_pointers and valid_tcbs')
      (tcb_sched_action tcb_sched_append tcb_ptr) (tcbSchedAppend tcbPtr)"
@@ -210,9 +210,9 @@ lemma tcbSchedAppend_corres:
    apply (fastforce dest: pspace_distinct_cross)
   apply (clarsimp simp: tcb_sched_action_def tcb_sched_append_def get_tcb_queue_def
                         tcbSchedAppend_def getQueue_def unless_def when_def)
-  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ thread_get_sp]; (solves wpsimp)?)
   apply (rename_tac domain)
-  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ thread_get_sp]; (solves wpsimp)?)
   apply (rename_tac priority)
   apply (rule corres_symb_exec_l[OF _ _ gets_sp]; (solves wpsimp)?)
   apply (rule corres_stateAssert_ignore)
@@ -224,12 +224,11 @@ lemma tcbSchedAppend_corres:
   apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
   apply (subst if_distrib[where f="set_tcb_queue domain prio" for domain prio])
   apply (rule corres_if_strong')
-    apply (frule state_relation_ready_queues_relation)
-    apply (frule in_ready_q_tcbQueued_eq[where t=tcbPtr])
     subgoal
-      by (fastforce dest: tcb_at_ekheap_dom pred_tcb_at_tcb_at
-                    simp: obj_at'_def opt_pred_def opt_map_def obj_at_def is_tcb_def
-                          in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+      by (fastforce dest!: state_relation_ready_queues_relation
+                           in_ready_q_tcbQueued_eq[where t=tcbPtr]
+                     simp: obj_at'_def opt_pred_def opt_map_def in_correct_ready_q_def
+                           obj_at_def etcb_at_def etcbs_of'_def)
    apply (find_goal \<open>match conclusion in "corres _ _ _ _ (return ())" \<Rightarrow> \<open>-\<close>\<close>)
    apply (rule monadic_rewrite_corres_l[where P=P and Q=P for P, simplified])
     apply (clarsimp simp: set_tcb_queue_def)
@@ -277,16 +276,15 @@ lemma tcbSchedAppend_corres:
   apply (drule set_tcb_queue_new_state)
   apply (wpsimp wp: threadSet_wp simp: setQueue_def tcbQueueAppend_def)
   apply normalise_obj_at'
-  apply (frule (1) tcb_at_is_etcb_at)
-  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
-  apply (rename_tac s d p s' tcb' tcb etcb)
-  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+  apply (clarsimp simp: obj_at_def)
+  apply (rename_tac s d p s' tcb' tcb)
+  apply (frule_tac t=tcbPtr in pspace_relation_tcb_domain_priority)
     apply (force simp: obj_at_def)
    apply (force simp: obj_at'_def)
   apply (clarsimp split: if_splits)
   apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
    apply (force dest!: spec simp: list_queue_relation_def)
-  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+  apply (cut_tac ts="ready_queues s (tcb_domain tcb) (tcb_priority tcb)"
               in obj_at'_tcbQueueEnd_ksReadyQueues)
       apply fast
      apply fast
@@ -296,8 +294,8 @@ lemma tcbSchedAppend_corres:
    apply (force dest!: spec simp: list_queue_relation_def)
   apply (clarsimp simp: list_queue_relation_def)
 
-  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
-   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+  apply (case_tac "d \<noteq> tcb_domain tcb \<or> p \<noteq> tcb_priority tcb")
+   apply (cut_tac d=d and d'="tcb_domain tcb" and p=p and p'="tcb_priority tcb"
                in ready_queues_disjoint)
       apply force
      apply fastforce
@@ -321,14 +319,14 @@ lemma tcbSchedAppend_corres:
     apply (clarsimp simp: fun_upd_apply split: if_splits)
 
    \<comment> \<open>the ready queue was not originally empty\<close>
-   apply (clarsimp simp: etcb_at_def obj_at'_def)
-   apply (prop_tac "the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))
+   apply (clarsimp simp: obj_at'_def)
+   apply (prop_tac "the (tcbQueueEnd (ksReadyQueues s' (tcb_domain tcb, tcb_priority tcb)))
                     \<notin> set (ready_queues s d p)")
     apply (erule orthD2)
-    apply (drule_tac x="tcb_domain etcb" in spec)
-    apply (drule_tac x="tcb_priority etcb" in spec)
+    apply (drule_tac x="tcb_domain tcb" in spec)
+    apply (drule_tac x="tcb_priority tcb" in spec)
     apply clarsimp
-    apply (drule_tac x="the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))"
+    apply (drule_tac x="the (tcbQueueEnd (ksReadyQueues s' (tcb_domain tcb, tcb_priority tcb)))"
                  in spec)
     subgoal by (auto simp: in_opt_pred opt_map_red)
    apply (intro conjI impI allI)
@@ -345,7 +343,7 @@ lemma tcbSchedAppend_corres:
       apply (case_tac "ready_queues s d p"; force simp: tcbQueueEmpty_def)
      apply (case_tac "t = tcbPtr")
       apply (clarsimp simp: inQ_def fun_upd_apply split: if_splits)
-     apply (case_tac "t = the (tcbQueueEnd (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))")
+     apply (case_tac "t = the (tcbQueueEnd (ksReadyQueues s' (tcb_domain tcb, tcb_priority tcb)))")
       apply (clarsimp simp: inQ_def opt_pred_def fun_upd_apply)
      apply (clarsimp simp: inQ_def in_opt_pred opt_map_def fun_upd_apply)
     apply (clarsimp simp: fun_upd_apply split: if_splits)
@@ -353,9 +351,9 @@ lemma tcbSchedAppend_corres:
 
   \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
   apply clarsimp
-  apply (drule_tac x="tcb_domain etcb" in spec)
-  apply (drule_tac x="tcb_priority etcb" in spec)
-  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+  apply (drule_tac x="tcb_domain tcb" in spec)
+  apply (drule_tac x="tcb_priority tcb" in spec)
+  apply (cut_tac ts="ready_queues s (tcb_domain tcb) (tcb_priority tcb)"
               in tcbQueueHead_iff_tcbQueueEnd)
    apply (force simp: list_queue_relation_def)
   apply (frule valid_tcbs'_maxDomain[where t=tcbPtr], simp add: obj_at'_def)
@@ -797,7 +795,7 @@ defs idleThreadNotQueued_def:
   "idleThreadNotQueued s \<equiv> obj_at' (Not \<circ> tcbQueued) (ksIdleThread s) s"
 
 lemma idle_thread_not_queued:
-  "\<lbrakk>valid_idle s; valid_queues s; valid_etcbs s\<rbrakk>
+  "\<lbrakk>valid_idle s; valid_queues s\<rbrakk>
    \<Longrightarrow> \<not> (\<exists>d p. idle_thread s \<in> set (ready_queues s d p))"
   apply (clarsimp simp: valid_queues_def)
   apply (drule_tac x=d in spec)
@@ -805,7 +803,7 @@ lemma idle_thread_not_queued:
   apply clarsimp
   apply (drule_tac x="idle_thread s" in bspec)
    apply fastforce
-  apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def valid_etcbs_def)
+  apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def)
   done
 
 lemma valid_idle_tcb_at:
@@ -813,12 +811,12 @@ lemma valid_idle_tcb_at:
   by (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def is_tcb_def)
 
 lemma setCurThread_corres:
-  "corres dc (valid_idle and valid_queues and valid_etcbs and pspace_aligned and pspace_distinct) \<top>
+  "corres dc (valid_idle and valid_queues and pspace_aligned and pspace_distinct) \<top>
      (modify (cur_thread_update (\<lambda>_. t))) (setCurThread t)"
   apply (clarsimp simp: setCurThread_def)
   apply (rule corres_stateAssert_add_assertion[rotated])
    apply (clarsimp simp: idleThreadNotQueued_def)
-   apply (frule (2) idle_thread_not_queued)
+   apply (frule (1) idle_thread_not_queued)
    apply (frule state_relation_pspace_relation)
    apply (frule state_relation_ready_queues_relation)
    apply (frule state_relation_idle_thread)
@@ -886,6 +884,7 @@ crunch arch_switch_to_thread, arch_switch_to_idle_thread
   and pspace_distinct[wp]: pspace_distinct
   and ready_qs_distinct[wp]: ready_qs_distinct
   and valid_idle[wp]: valid_idle
+  and ready_queues[wp]: "\<lambda>s. P (ready_queues s)"
   (wp: ready_qs_distinct_lift simp: crunch_simps)
 
 lemma valid_queues_in_correct_ready_q[elim!]:
@@ -901,7 +900,7 @@ lemma switchToThread_corres:
                 and valid_vspace_objs and pspace_aligned and pspace_distinct
                 and valid_vs_lookup and valid_global_objs and pspace_in_kernel_window
                 and unique_table_refs
-                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s))
+                and st_tcb_at runnable t and (\<lambda>s. sym_refs (state_hyp_refs_of s))
                 and valid_queues and valid_idle)
              (no_0_obj' and sym_heap_sched_pointers and valid_objs')
              (switch_to_thread t) (switchToThread t)"
@@ -922,7 +921,7 @@ lemma switchToThread_corres:
     apply (rule corres_guard_imp)
       apply (rule corres_split[OF arch_switchToThread_corres])
         apply (rule corres_split[OF tcbSchedDequeue_corres setCurThread_corres])
-          apply (wpsimp simp: is_tcb_def)+
+          apply (wpsimp simp: is_tcb_def wp: in_correct_ready_q_lift)+
      apply (fastforce intro!: st_tcb_at_tcb_at)
     apply wpsimp
    apply wpsimp
@@ -974,7 +973,7 @@ lemma arch_switchToIdleThread_corres:
 
 lemma switchToIdleThread_corres:
   "corres dc
-     (invs and valid_queues and valid_etcbs)
+     (invs and valid_queues)
      invs_no_cicd'
      switch_to_idle_thread switchToIdleThread"
   apply (simp add: switch_to_idle_thread_def Thread_H.switchToIdleThread_def)
@@ -1612,7 +1611,7 @@ lemma guarded_switch_to_corres:
                 and valid_vspace_objs and pspace_aligned and pspace_distinct
                 and valid_vs_lookup and valid_global_objs and pspace_in_kernel_window
                 and unique_table_refs
-                and st_tcb_at runnable t and valid_etcbs and (\<lambda>s. sym_refs (state_hyp_refs_of s))
+                and st_tcb_at runnable t and (\<lambda>s. sym_refs (state_hyp_refs_of s))
                 and valid_queues and valid_idle)
              (no_0_obj' and sym_heap_sched_pointers and valid_objs')
              (guarded_switch_to t) (switchToThread t)"
@@ -1850,25 +1849,27 @@ lemma schact_bind_inside: "do x \<leftarrow> f; (case act of resume_cur_thread \
   apply (case_tac act,simp_all)
   done
 
-interpretation tcb_sched_action_extended: is_extended' "tcb_sched_action f a"
-  by (unfold_locales)
-
 lemma getDomainTime_corres:
   "corres (=) \<top> \<top> (gets domain_time) getDomainTime"
   by (simp add: getDomainTime_def state_relation_def)
 
+lemma reset_work_units_equiv:
+  "do_extended_op (modify (work_units_completed_update (\<lambda>_. 0)))
+   = (modify (work_units_completed_update (\<lambda>_. 0)))"
+  by (clarsimp simp: reset_work_units_def[symmetric])
+
 lemma nextDomain_corres:
   "corres dc \<top> \<top> next_domain nextDomain"
-  apply (simp add: next_domain_def nextDomain_def)
+  apply (clarsimp simp: next_domain_def nextDomain_def reset_work_units_equiv modify_modify)
   apply (rule corres_modify)
-  apply (simp add: state_relation_def Let_def dschLength_def dschDomain_def)
+  apply (simp add: state_relation_def Let_def dschLength_def dschDomain_def cdt_relation_def)
   done
 
 lemma next_domain_valid_sched[wp]:
   "\<lbrace> valid_sched and (\<lambda>s. scheduler_action s  = choose_new_thread)\<rbrace> next_domain \<lbrace> \<lambda>_. valid_sched \<rbrace>"
   apply (simp add: next_domain_def Let_def)
-  apply (wp, simp add: valid_sched_def valid_sched_action_2_def ct_not_in_q_2_def)
-  apply (simp add:valid_blocked_2_def)
+  apply (wpsimp wp: dxo_wp_weak)
+  apply (clarsimp simp: valid_sched_def)
   done
 
 lemma nextDomain_invs_no_cicd':
@@ -1902,7 +1903,7 @@ lemma scheduleChooseNewThread_fragment_corres:
 
 lemma scheduleSwitchThreadFastfail_corres:
   "\<lbrakk> ct \<noteq> it \<longrightarrow> (tp = tp' \<and> cp = cp') ; ct = ct' ; it = it' \<rbrakk> \<Longrightarrow>
-   corres ((=)) (is_etcb_at ct) (tcb_at' ct)
+   corres ((=)) (is_tcb_at ct) (tcb_at' ct)
      (schedule_switch_thread_fastfail ct it cp tp)
      (scheduleSwitchThreadFastfail ct' it' cp' tp')"
   by (clarsimp simp: schedule_switch_thread_fastfail_def scheduleSwitchThreadFastfail_def)
@@ -1941,9 +1942,6 @@ lemma isHighestPrio_corres:
          apply (wpsimp simp: if_apply_def2 wp: hoare_drop_imps ksReadyQueuesL1Bitmap_return_wp)+
   done
 
-crunch set_scheduler_action
-  for valid_idle_etcb[wp]: valid_idle_etcb
-
 crunch isHighestPrio
   for inv[wp]: P
 crunch curDomain
@@ -1971,13 +1969,13 @@ lemma scheduleChooseNewThread_corres:
    apply auto
   done
 
-lemma ethread_get_when_corres:
-  assumes x: "\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow> r (f etcb) (f' tcb')"
-  shows      "corres (\<lambda>rv rv'. b \<longrightarrow> r rv rv') (is_etcb_at t) (tcb_at' t)
-                (ethread_get_when b f t) (threadGet f' t)"
-  apply (clarsimp simp: ethread_get_when_def)
+lemma thread_get_when_corres:
+  assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow> r (f tcb) (f' tcb')"
+  shows      "corres (\<lambda>rv rv'. b \<longrightarrow> r rv rv') (tcb_at t and pspace_aligned and pspace_distinct) (tcb_at' t)
+                ((if b then thread_get f t else return 0)) (threadGet f' t)"
+  apply clarsimp
   apply (rule conjI; clarsimp)
-  apply (rule corres_guard_imp, rule ethreadget_corres; simp add: x)
+  apply (rule corres_guard_imp, rule threadGet_corres; simp add: x)
   apply (clarsimp simp: threadGet_def)
   apply (rule corres_noop)
   apply wpsimp+
@@ -1986,31 +1984,29 @@ lemma ethread_get_when_corres:
 lemma tcb_sched_enqueue_in_correct_ready_q[wp]:
   "tcb_sched_action tcb_sched_enqueue t \<lbrace>in_correct_ready_q\<rbrace> "
   unfolding tcb_sched_action_def tcb_sched_enqueue_def set_tcb_queue_def
-  apply wpsimp
-  apply (clarsimp simp: in_correct_ready_q_def obj_at_def etcb_at_def is_etcb_at_def
-                 split: option.splits)
+  apply (wpsimp wp: thread_get_wp')
+  apply (clarsimp simp: in_correct_ready_q_def obj_at_def etcb_at_def is_etcb_at_def etcbs_of'_def)
   done
 
 lemma tcb_sched_append_in_correct_ready_q[wp]:
   "tcb_sched_action tcb_sched_append tcb_ptr \<lbrace>in_correct_ready_q\<rbrace> "
   unfolding tcb_sched_action_def tcb_sched_append_def
-  apply wpsimp
-  apply (clarsimp simp: in_correct_ready_q_def obj_at_def etcb_at_def is_etcb_at_def
-                 split: option.splits)
+  apply (wpsimp wp: thread_get_wp')
+  apply (clarsimp simp: in_correct_ready_q_def obj_at_def etcb_at_def is_etcb_at_def etcbs_of'_def)
   done
 
 lemma tcb_sched_enqueue_ready_qs_distinct[wp]:
   "tcb_sched_action tcb_sched_enqueue t \<lbrace>ready_qs_distinct\<rbrace> "
   unfolding tcb_sched_action_def set_tcb_queue_def
   apply (wpsimp wp: thread_get_wp')
-  apply (clarsimp simp: ready_qs_distinct_def etcb_at_def is_etcb_at_def split: option.splits)
+  apply (clarsimp simp: ready_qs_distinct_def etcb_at_def is_etcb_at_def)
   done
 
 lemma tcb_sched_append_ready_qs_distinct[wp]:
   "tcb_sched_action tcb_sched_append t \<lbrace>ready_qs_distinct\<rbrace> "
   unfolding tcb_sched_action_def tcb_sched_append_def set_tcb_queue_def
   apply (wpsimp wp: thread_get_wp')
-  apply (clarsimp simp: ready_qs_distinct_def etcb_at_def is_etcb_at_def split: option.splits)
+  apply (clarsimp simp: ready_qs_distinct_def etcb_at_def is_etcb_at_def)
   done
 
 crunch set_scheduler_action
@@ -2023,9 +2019,11 @@ crunch reschedule_required
   and ready_qs_distinct[wp]: ready_qs_distinct
   (ignore: tcb_sched_action wp: crunch_wps)
 
+crunch tcb_sched_action
+  for valid_vs_lookup[wp]: valid_vs_lookup
+
 lemma schedule_corres:
   "corres dc (invs and valid_sched and valid_list) invs' (Schedule_A.schedule) ThreadDecls_H.schedule"
-  supply ethread_get_wp[wp del]
   supply ssa_wp[wp del]
   supply tcbSchedEnqueue_invs'[wp del]
   supply tcbSchedEnqueue_invs'_not_ResumeCurrentThread[wp del]
@@ -2064,12 +2062,12 @@ lemma schedule_corres:
             apply (rule corres_split[OF getIdleThread_corres], rename_tac it it')
               apply (rule_tac F="was_running \<longrightarrow> ct \<noteq> it" in corres_gen_asm)
               apply (rule corres_split)
-                 apply (rule ethreadget_corres[where r="(=)"])
-                 apply (clarsimp simp: etcb_relation_def)
+                 apply (rule threadGet_corres[where r="(=)"])
+                 apply (clarsimp simp: tcb_relation_def)
                 apply (rename_tac tp tp')
                 apply (rule corres_split)
-                   apply (rule ethread_get_when_corres[where r="(=)"])
-                   apply (clarsimp simp: etcb_relation_def)
+                   apply (rule thread_get_when_corres[where r="(=)"])
+                   apply (clarsimp simp: tcb_relation_def)
                   apply (rename_tac cp cp')
                   apply (rule corres_split)
                      apply (rule scheduleSwitchThreadFastfail_corres; simp)
@@ -2131,7 +2129,7 @@ lemma schedule_corres:
    apply clarsimp
 
    subgoal for s
-     apply (clarsimp split: Deterministic_A.scheduler_action.splits
+     apply (clarsimp split: Structures_A.scheduler_action.splits
                      simp: invs_psp_aligned invs_distinct invs_valid_objs invs_arch_state
                            invs_vspace_objs[simplified] tcb_at_invs)
      apply (rule conjI, clarsimp)
@@ -2143,14 +2141,13 @@ lemma schedule_corres:
       subgoal for candidate
         apply (clarsimp simp: valid_sched_def invs_def valid_state_def cur_tcb_def
                                valid_arch_caps_def valid_sched_action_def
-                               weak_valid_sched_action_def tcb_at_is_etcb_at
-                               tcb_at_is_etcb_at[OF st_tcb_at_tcb_at[rotated]]
+                               weak_valid_sched_action_def
                                valid_blocked_except_def valid_blocked_def invs_hyp_sym_refs)
         apply (fastforce simp add: pred_tcb_at_def obj_at_def is_tcb valid_idle_def)
         done
      (* choose new thread case *)
      apply (intro impI conjI allI tcb_at_invs
-            | fastforce simp: invs_def cur_tcb_def valid_etcbs_def
+            | fastforce simp: invs_def cur_tcb_def
                               valid_sched_def  st_tcb_at_def obj_at_def valid_state_def
                               weak_valid_sched_action_def not_cur_thread_def)+
      done
@@ -2500,7 +2497,7 @@ lemma sbn_sch_act_sane:
 
 lemma possibleSwitchTo_corres:
   "corres dc
-     (valid_etcbs and weak_valid_sched_action and cur_tcb and st_tcb_at runnable t
+     (weak_valid_sched_action and cur_tcb and st_tcb_at runnable t
       and in_correct_ready_q and ready_qs_distinct and pspace_aligned and pspace_distinct)
      ((\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
       and sym_heap_sched_pointers and valid_sched_pointers and valid_objs')
@@ -2509,7 +2506,6 @@ lemma possibleSwitchTo_corres:
    apply (fastforce dest: pspace_aligned_cross)
   apply (rule_tac Q'=pspace_distinct' in corres_cross_add_guard)
    apply (fastforce dest: pspace_distinct_cross)
-  supply ethread_get_wp[wp del]
   apply (rule corres_cross_over_guard[where P'=Q and Q="tcb_at' t and Q" for Q])
    apply (clarsimp simp: state_relation_def)
    apply (rule tcb_at_cross, erule st_tcb_at_tcb_at; assumption)
@@ -2517,8 +2513,8 @@ lemma possibleSwitchTo_corres:
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF curDomain_corres], simp)
       apply (rule corres_split)
-         apply (rule ethreadget_corres[where r="(=)"])
-         apply (clarsimp simp: etcb_relation_def)
+         apply (rule threadGet_corres[where r="(=)"])
+         apply (clarsimp simp: tcb_relation_def)
         apply (rule corres_split[OF getSchedulerAction_corres])
           apply (rule corres_if, simp)
            apply (rule tcbSchedEnqueue_corres, simp)
@@ -2528,14 +2524,9 @@ lemma possibleSwitchTo_corres:
              apply (rule tcbSchedEnqueue_corres, simp)
             apply (wp reschedule_required_valid_queues | strengthen valid_objs'_valid_tcbs')+
           apply (rule setSchedulerAction_corres, simp)
-         apply (wpsimp simp: if_apply_def2
-                       wp: hoare_drop_imp[where f="ethread_get a b" for a b])+
-      apply (wp hoare_drop_imps)[1]
-     apply wp+
-   apply (clarsimp simp: valid_sched_def invs_def valid_state_def cur_tcb_def st_tcb_at_tcb_at
-                          valid_sched_action_def weak_valid_sched_action_def
-                          tcb_at_is_etcb_at[OF st_tcb_at_tcb_at[rotated]])
-  apply (fastforce simp: tcb_at_is_etcb_at)
+         apply (wpsimp wp: hoare_drop_imps)+
+   apply (clarsimp simp: st_tcb_at_tcb_at)
+  apply fastforce
   done
 
 end
diff --git a/proof/refine/AARCH64/StateRelation.thy b/proof/refine/AARCH64/StateRelation.thy
index e8f13fae54..e42e32852a 100644
--- a/proof/refine/AARCH64/StateRelation.thy
+++ b/proof/refine/AARCH64/StateRelation.thy
@@ -182,7 +182,10 @@ definition tcb_relation :: "Structures_A.tcb \<Rightarrow> Structures_H.tcb \<Ri
    \<and> cap_relation (tcb_caller tcb) (cteCap (tcbCaller tcb'))
    \<and> cap_relation (tcb_ipcframe tcb) (cteCap (tcbIPCBufferFrame tcb'))
    \<and> tcb_bound_notification tcb = tcbBoundNotification tcb'
-   \<and> tcb_mcpriority tcb = tcbMCP tcb'"
+   \<and> tcb_mcpriority tcb = tcbMCP tcb'
+   \<and> tcb_priority tcb = tcbPriority tcb'
+   \<and> tcb_time_slice tcb = tcbTimeSlice tcb'
+   \<and> tcb_domain tcb = tcbDomain tcb'"
 
 \<comment> \<open>
   A pair of objects @{term "(obj, obj')"} should satisfy the following relation when, under further
@@ -320,18 +323,7 @@ definition pspace_relation ::
      (pspace_dom ab = dom con) \<and>
      (\<forall>x \<in> dom ab. \<forall>(y, P) \<in> obj_relation_cuts (the (ab x)) x. P (the (ab x)) (the (con y)))"
 
-definition etcb_relation :: "etcb \<Rightarrow> Structures_H.tcb \<Rightarrow> bool" where
-  "etcb_relation \<equiv> \<lambda>etcb tcb'.
-     tcb_priority etcb = tcbPriority tcb'
-     \<and> tcb_time_slice etcb = tcbTimeSlice tcb'
-     \<and> tcb_domain etcb = tcbDomain tcb'"
-
-definition ekheap_relation ::
-  "(obj_ref \<Rightarrow> etcb option) \<Rightarrow> (machine_word \<rightharpoonup> Structures_H.kernel_object) \<Rightarrow> bool" where
-  "ekheap_relation ab con \<equiv>
-     \<forall>x \<in> dom ab. \<exists>tcb'. con x = Some (KOTCB tcb') \<and> etcb_relation (the (ab x)) tcb'"
-
-primrec sched_act_relation :: "Deterministic_A.scheduler_action \<Rightarrow> scheduler_action \<Rightarrow> bool"
+primrec sched_act_relation :: "Structures_A.scheduler_action \<Rightarrow> scheduler_action \<Rightarrow> bool"
   where
   "sched_act_relation resume_cur_thread a' = (a' = ResumeCurrentThread)" |
   "sched_act_relation choose_new_thread a' = (a' = ChooseNewThread)" |
@@ -359,8 +351,8 @@ lemma list_queue_relation_nil:
   by (fastforce dest: heap_path_head simp: tcbQueueEmpty_def list_queue_relation_def)
 
 definition ready_queue_relation ::
-  "Deterministic_A.domain \<Rightarrow> Structures_A.priority
-   \<Rightarrow> Deterministic_A.ready_queue \<Rightarrow> ready_queue
+  "Structures_A.domain \<Rightarrow> Structures_A.priority
+   \<Rightarrow> Structures_A.ready_queue \<Rightarrow> ready_queue
    \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
    \<Rightarrow> (obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
   where
@@ -370,7 +362,7 @@ definition ready_queue_relation ::
      \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> tcbQueueEmpty q')"
 
 definition ready_queues_relation_2 ::
-  "(Deterministic_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Deterministic_A.ready_queue)
+  "(Structures_A.domain \<Rightarrow> Structures_A.priority \<Rightarrow> Structures_A.ready_queue)
    \<Rightarrow> (domain \<times> priority \<Rightarrow> ready_queue)
    \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref)
    \<Rightarrow> (domain \<Rightarrow> priority \<Rightarrow> obj_ref \<Rightarrow> bool) \<Rightarrow> bool"
@@ -525,7 +517,6 @@ definition APIType_map :: "Structures_A.apiobject_type \<Rightarrow> AARCH64_H.o
 definition state_relation :: "(det_state \<times> kernel_state) set" where
   "state_relation \<equiv> {(s, s').
          pspace_relation (kheap s) (ksPSpace s')
-       \<and> ekheap_relation (ekheap s) (ksPSpace s')
        \<and> sched_act_relation (scheduler_action s) (ksSchedulerAction s')
        \<and> ready_queues_relation s s'
        \<and> ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') (gsPTTypes (ksArchState s'))
@@ -557,10 +548,6 @@ lemma state_relation_pspace_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> pspace_relation (kheap s) (ksPSpace s')"
   by (simp add: state_relation_def)
 
-lemma state_relation_ekheap_relation[elim!]:
-  "(s,s') \<in> state_relation \<Longrightarrow> ekheap_relation (ekheap s) (ksPSpace s')"
-  by (simp add: state_relation_def)
-
 lemma state_relation_sched_act_relation[elim!]:
   "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
   by (clarsimp simp: state_relation_def)
@@ -576,7 +563,6 @@ lemma state_relation_idle_thread[elim!]:
 lemma state_relationD:
   "(s, s') \<in> state_relation \<Longrightarrow>
    pspace_relation (kheap s) (ksPSpace s') \<and>
-   ekheap_relation (ekheap s) (ksPSpace s') \<and>
    sched_act_relation (scheduler_action s) (ksSchedulerAction s') \<and>
    ready_queues_relation s s' \<and>
    ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') (gsPTTypes (ksArchState s')) \<and>
@@ -598,7 +584,6 @@ lemma state_relationD:
 lemma state_relationE [elim?]:
   assumes sr:  "(s, s') \<in> state_relation"
   and rl: "\<lbrakk> pspace_relation (kheap s) (ksPSpace s');
-             ekheap_relation (ekheap s) (ksPSpace s');
              sched_act_relation (scheduler_action s) (ksSchedulerAction s');
              ready_queues_relation s s';
              ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') (gsPTTypes (ksArchState s'));
@@ -647,11 +632,6 @@ lemma pspace_relation_absD:
   apply (fastforce simp: image_def intro: rev_bexI)
   done
 
-lemma ekheap_relation_absD:
-  "\<lbrakk> ab x = Some y; ekheap_relation ab con \<rbrakk> \<Longrightarrow>
-   \<exists>tcb'. con x = Some (KOTCB tcb') \<and> etcb_relation y tcb'"
-  by (force simp add: ekheap_relation_def)
-
 lemma in_related_pspace_dom:
   "\<lbrakk> s' x = Some y; pspace_relation s s' \<rbrakk> \<Longrightarrow> x \<in> pspace_dom s"
   by (clarsimp simp add: pspace_relation_def)
@@ -676,6 +656,22 @@ lemma ghost_relation_typ_at:
   apply (clarsimp simp: ghost_relation_def typ_at_eq_kheap_obj data_at_def)
   by (intro conjI impI iffI allI; force)
 
+lemma objBits_less_word_bits:
+  "objBits v < word_bits"
+  unfolding objBits_simps'
+  apply (case_tac "injectKO v"; simp)
+  by (simp add: pageBits_def pteBits_def objBits_simps word_bits_def
+         split: arch_kernel_object.split)+
+
+lemma objBits_pos_power2[simp]:
+  assumes "objBits v < word_bits"
+  shows "(1::machine_word) < (2::machine_word) ^ objBits v"
+  unfolding objBits_simps'
+  apply (insert assms)
+  apply (case_tac "injectKO v"; simp)
+  by (simp add: pageBits_def pteBits_def objBits_simps
+         split: arch_kernel_object.split)+
+
 end
 
 end
diff --git a/proof/refine/AARCH64/Syscall_R.thy b/proof/refine/AARCH64/Syscall_R.thy
index 8a5061f324..9bdb038f64 100644
--- a/proof/refine/AARCH64/Syscall_R.thy
+++ b/proof/refine/AARCH64/Syscall_R.thy
@@ -351,7 +351,7 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]:
 
 lemma setDomain_corres:
   "corres dc
-     (valid_etcbs and valid_sched and tcb_at tptr and pspace_aligned and pspace_distinct)
+     (valid_sched and tcb_at tptr and pspace_aligned and pspace_distinct)
      (invs' and sch_act_simple and tcb_at' tptr and (\<lambda>s. new_dom \<le> maxDomain))
      (set_domain tptr new_dom) (setDomain tptr new_dom)"
   apply (rule corres_gen_asm2)
@@ -360,8 +360,8 @@ lemma setDomain_corres:
     apply (rule corres_split[OF getCurThread_corres])
       apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
         apply (rule corres_split)
-           apply (rule ethread_set_corres; simp)
-           apply (clarsimp simp: etcb_relation_def)
+           apply (rule threadSet_not_queued_corres;
+                  simp add: tcb_relation_def tcb_cap_cases_def tcb_cte_cases_def cteSizeBits_def)
           apply (rule corres_split[OF isRunnable_corres])
             apply simp
             apply (rule corres_split)
@@ -374,9 +374,9 @@ lemma setDomain_corres:
             apply ((wpsimp wp: hoare_drop_imps | strengthen valid_objs'_valid_tcbs')+)[1]
            apply (wpsimp wp: gts_wp)
           apply wpsimp
-         apply ((wpsimp wp: hoare_vcg_imp_lift' ethread_set_not_queued_valid_queues hoare_vcg_all_lift
-                 | strengthen valid_objs'_valid_tcbs' valid_queues_in_correct_ready_q
-                              valid_queues_ready_qs_distinct)+)[1]
+         apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift
+                           thread_set_in_correct_ready_q_not_queued thread_set_no_change_tcb_state
+                           thread_set_no_change_tcb_state_converse thread_set_weak_valid_sched_action)
         apply (rule_tac Q'="\<lambda>_. valid_objs' and sym_heap_sched_pointers and valid_sched_pointers
                                and pspace_aligned' and pspace_distinct'
                                and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr"
@@ -385,7 +385,7 @@ lemma setDomain_corres:
         apply (wpsimp wp: threadSet_valid_objs' threadSet_sched_pointers
                           threadSet_valid_sched_pointers)+
        apply (rule_tac Q'="\<lambda>_ s. valid_queues s \<and> not_queued tptr s
-                                \<and> pspace_aligned s \<and> pspace_distinct s \<and> valid_etcbs s
+                                \<and> pspace_aligned s \<and> pspace_distinct s
                                 \<and> weak_valid_sched_action s"
                     in hoare_post_imp)
         apply (fastforce simp: pred_tcb_at_def obj_at_def)
@@ -399,10 +399,7 @@ lemma setDomain_corres:
        apply (clarsimp simp: tcb_cte_cases_def cteSizeBits_def)
        apply fastforce
       apply (wp hoare_vcg_all_lift tcbSchedDequeue_not_queued)+
-   apply clarsimp
-   apply (frule tcb_at_is_etcb_at)
-    apply simp+
-   apply (auto elim: tcb_at_is_etcb_at valid_objs'_maxDomain valid_objs'_maxPriority pred_tcb'_weakenE
+   apply (auto elim: valid_objs'_maxDomain valid_objs'_maxPriority pred_tcb'_weakenE
                simp: valid_sched_def valid_sched_action_def)
   done
 
@@ -1572,8 +1569,7 @@ lemma handleYield_corres:
                 | strengthen valid_objs'_valid_tcbs' valid_queues_in_correct_ready_q
                   valid_queues_ready_qs_distinct)+
    apply (simp add: invs_def valid_sched_def valid_sched_action_def cur_tcb_def
-                    tcb_at_is_etcb_at valid_state_def valid_pspace_def ct_in_state_def
-                    runnable_eq_active)
+                    valid_state_def valid_pspace_def ct_in_state_def runnable_eq_active)
   apply (fastforce simp: invs'_def valid_state'_def ct_in_state'_def sch_act_wf_weak cur_tcb'_def
                         valid_pspace_valid_objs' valid_objs'_maxDomain tcb_in_cur_domain'_def)
   done
@@ -1821,10 +1817,6 @@ lemma handleReply_nonz_cap_to_ct:
 crunch handleFaultReply
   for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
 
-crunch handle_recv
-  for valid_etcbs[wp]: "valid_etcbs"
-  (wp: crunch_wps simp: crunch_simps)
-
 lemma handleReply_handleRecv_corres:
   "corres dc (einvs and ct_running)
              (invs' and ct_running' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
diff --git a/proof/refine/AARCH64/TcbAcc_R.thy b/proof/refine/AARCH64/TcbAcc_R.thy
index 4520609f36..0f7ebb4d5e 100644
--- a/proof/refine/AARCH64/TcbAcc_R.thy
+++ b/proof/refine/AARCH64/TcbAcc_R.thy
@@ -341,29 +341,27 @@ lemma setObject_update_TCB_corres':
   assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF new_tcb' = getF tcb'"
   assumes sched_pointers: "tcbSchedPrev new_tcb' = tcbSchedPrev tcb'"
                           "tcbSchedNext new_tcb' = tcbSchedNext tcb'"
-  assumes flag: "tcbQueued new_tcb' = tcbQueued tcb'"
+  assumes flag: "\<And>d p. inQ d p new_tcb' = inQ d p tcb'"
   assumes r: "r () ()"
-  assumes exst: "exst_same tcb' new_tcb'"
   shows
     "corres r
        (ko_at (TCB tcb) ptr) (ko_at' tcb' ptr)
        (set_object ptr (TCB new_tcb)) (setObject ptr new_tcb')"
-  apply (rule_tac F="tcb_relation tcb tcb' \<and> exst_same tcb' new_tcb'" in corres_req)
+  apply (rule_tac F="tcb_relation tcb tcb'" in corres_req)
    apply (clarsimp simp: state_relation_def obj_at_def obj_at'_def)
    apply (frule(1) pspace_relation_absD)
-   apply (clarsimp simp: tcb_relation_cut_def exst)
+   apply (clarsimp simp: tcb_relation_cut_def)
   apply (rule corres_no_failI)
-   apply (rule no_fail_pre)
-    apply wp
+   apply wp
    apply (clarsimp simp: obj_at'_def)
   apply (unfold set_object_def setObject_def)
   apply (clarsimp simp: in_monad split_def bind_def gets_def get_def Bex_def
-                        put_def return_def modify_def get_object_def projectKOs obj_at_def
-                        updateObject_default_def in_magnitude_check obj_at'_def)
-  apply (rename_tac s s' t')
-  apply (prop_tac "t' = s'")
-   apply (clarsimp simp: magnitudeCheck_def in_monad split: option.splits)
-  apply (drule singleton_in_magnitude_check)
+                        put_def return_def modify_def get_object_def obj_at_def
+                        updateObject_default_def in_magnitude_check objBits_less_word_bits)
+  apply (rename_tac s s' ko)
+  apply (prop_tac "ko = tcb'")
+   apply (clarsimp simp: obj_at'_def project_inject)
+  apply (clarsimp simp: state_relation_def)
   apply (prop_tac "map_to_ctes ((ksPSpace s') (ptr \<mapsto> injectKO new_tcb'))
                    = map_to_ctes (ksPSpace s')")
    apply (frule_tac tcb=new_tcb' and tcb=tcb' in map_to_ctes_upd_tcb)
@@ -371,72 +369,57 @@ lemma setObject_update_TCB_corres':
     apply (clarsimp simp: objBits_simps ps_clear_def3 field_simps objBits_defs mask_def)
    apply (insert tables')[1]
    apply (rule ext)
-   apply (clarsimp split: if_splits)
-   apply blast
+   subgoal by auto
   apply (prop_tac "obj_at (same_caps (TCB new_tcb)) ptr s")
    using tables
    apply (fastforce simp: obj_at_def)
-  apply (clarsimp simp: caps_of_state_after_update cte_wp_at_after_update swp_def
+  apply (clarsimp simp: caps_of_state_after_update cte_wp_at_after_update swp_def fun_upd_def
                         obj_at_def assms)
-  apply (clarsimp simp add: state_relation_def)
   apply (subst conj_assoc[symmetric])
   apply (extract_conjunct \<open>match conclusion in "ghost_relation _ _ _ _" \<Rightarrow> -\<close>)
-   apply (clarsimp simp add: ghost_relation_def)
+   apply (clarsimp simp: ghost_relation_def)
    apply (erule_tac x=ptr in allE)+
    apply clarsimp
-  apply (simp only: pspace_relation_def pspace_dom_update dom_fun_upd2 simp_thms)
-  apply (elim conjE)
-  apply (frule bspec, erule domI)
-  apply clarsimp
-  apply (rule conjI)
+  apply (extract_conjunct \<open>match conclusion in "pspace_relation _ _" \<Rightarrow> -\<close>)
+   apply (fold fun_upd_def)
    apply (simp only: pspace_relation_def simp_thms
                      pspace_dom_update[where x="kernel_object.TCB _"
                                          and v="kernel_object.TCB _",
                                        simplified a_type_def, simplified])
-  apply (rule conjI)
    using assms
    apply (simp only: dom_fun_upd2 simp_thms)
+   apply (elim conjE)
    apply (frule bspec, erule domI)
    apply (rule ballI, drule(1) bspec)
    apply (drule domD)
-   apply (clarsimp simp: tcb_relation_cut_def project_inject split: if_split_asm kernel_object.split_asm)
+   apply (clarsimp simp: project_inject tcb_relation_cut_def
+                  split: if_split_asm kernel_object.split_asm)
    apply (rename_tac aa ba)
    apply (drule_tac x="(aa, ba)" in bspec, simp)
    apply clarsimp
    apply (frule_tac ko'="kernel_object.TCB tcb" and x'=ptr in obj_relation_cut_same_type)
       apply (simp add: tcb_relation_cut_def)+
    apply clarsimp
-  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
-   apply (simp only: ekheap_relation_def)
-   apply (rule ballI, drule (1) bspec)
-   apply (insert exst)
-   apply (clarsimp simp: etcb_relation_def exst_same_def)
-  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation_2 _ _ _ _ _" \<Rightarrow> -\<close>)
-   apply (insert sched_pointers flag exst)
-   apply (clarsimp simp: ready_queues_relation_def Let_def)
-   apply (prop_tac "(tcbSchedNexts_of s')(ptr := tcbSchedNext new_tcb') = tcbSchedNexts_of s'")
-    apply (fastforce simp: opt_map_def)
-   apply (prop_tac "(tcbSchedPrevs_of s')(ptr := tcbSchedPrev new_tcb') = tcbSchedPrevs_of s'")
-    apply (fastforce simp: opt_map_def)
-   apply (clarsimp simp: ready_queue_relation_def opt_pred_def opt_map_def exst_same_def inQ_def
-                  split: option.splits)
-   apply (metis (mono_tags, opaque_lifting))
-  apply (clarsimp simp: fun_upd_def caps_of_state_after_update cte_wp_at_after_update swp_def
-                        obj_at_def)
-  done
+  apply (insert sched_pointers flag)
+  apply (clarsimp simp: ready_queues_relation_def Let_def)
+  apply (prop_tac "(tcbSchedNexts_of s')(ptr := tcbSchedNext new_tcb') = tcbSchedNexts_of s'")
+   apply (fastforce simp: opt_map_def)
+  apply (prop_tac "(tcbSchedPrevs_of s')(ptr := tcbSchedPrev new_tcb') = tcbSchedPrevs_of s'")
+   apply (fastforce simp: opt_map_def)
+  by (clarsimp simp: ready_queue_relation_def opt_pred_def opt_map_def split: option.splits)
 
 lemma setObject_update_TCB_corres:
   "\<lbrakk>tcb_relation tcb tcb' \<Longrightarrow> tcb_relation new_tcb new_tcb';
      \<forall>(getF, v) \<in> ran tcb_cap_cases. getF new_tcb = getF tcb;
      \<forall>(getF, v) \<in> ran tcb_cte_cases. getF new_tcb' = getF tcb';
      tcbSchedPrev new_tcb' = tcbSchedPrev tcb'; tcbSchedNext new_tcb' = tcbSchedNext tcb';
-     tcbQueued new_tcb' = tcbQueued tcb'; exst_same tcb' new_tcb';
+     \<And>d p. inQ d p new_tcb' = inQ d p tcb';
      r () ()\<rbrakk> \<Longrightarrow>
    corres r
      (\<lambda>s. get_tcb ptr s = Some tcb) (\<lambda>s'. (tcb', s') \<in> fst (getObject ptr s'))
      (set_object ptr (TCB new_tcb)) (setObject ptr new_tcb')"
   apply (rule corres_guard_imp)
-    apply (erule (7) setObject_update_TCB_corres')
+    apply (erule (4) setObject_update_TCB_corres'; fastforce)
    apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
                          loadObject_default_def objBits_simps' in_magnitude_check)+
   done
@@ -490,8 +473,7 @@ lemma threadset_corresT:
                  getF (f' tcb) = getF tcb"
   assumes sched_pointers: "\<And>tcb. tcbSchedPrev (f' tcb) = tcbSchedPrev tcb"
                           "\<And>tcb. tcbSchedNext (f' tcb) = tcbSchedNext tcb"
-  assumes flag: "\<And>tcb. tcbQueued (f' tcb) = tcbQueued tcb"
-  assumes e: "\<And>tcb'. exst_same tcb' (f' tcb')"
+  assumes flag: "\<And>d p tcb'. inQ d p (f' tcb') = inQ d p tcb'"
   shows      "corres dc (tcb_at t and pspace_aligned and pspace_distinct)
                         \<top>
                         (thread_set f t) (threadSet f' t)"
@@ -499,15 +481,14 @@ lemma threadset_corresT:
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getObject_TCB_corres])
       apply (rule setObject_update_TCB_corres')
-             apply (erule x)
-            apply (rule y)
-           apply (clarsimp simp: bspec_split [OF spec [OF z]])
-           apply fastforce
-          apply (rule sched_pointers)
+            apply (erule x)
+           apply (rule y)
+          apply (clarsimp simp: bspec_split [OF spec [OF z]])
+          apply fastforce
          apply (rule sched_pointers)
-        apply (rule flag)
-       apply simp
-      apply (rule e)
+        apply (rule sched_pointers)
+       apply (rule flag)
+      apply simp
      apply wp+
    apply (clarsimp simp add: tcb_at_def obj_at_def)
    apply (drule get_tcb_SomeD)
@@ -537,8 +518,7 @@ lemma threadSet_corres_noopT:
                  getF (fn tcb) = getF tcb"
   assumes s: "\<forall>tcb'. tcbSchedPrev (fn tcb') = tcbSchedPrev tcb'"
              "\<forall>tcb'. tcbSchedNext (fn tcb') = tcbSchedNext tcb'"
-  assumes f: "\<And>tcb'. tcbQueued (fn tcb') = tcbQueued tcb'"
-  assumes e: "\<And>tcb'. exst_same tcb' (fn tcb')"
+  assumes f: "\<And>d p tcb'. inQ d p (fn tcb') = inQ d p tcb'"
   shows      "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
                         (return v) (threadSet fn t)"
 proof -
@@ -556,13 +536,12 @@ proof -
        defer
        apply (subst bind_return [symmetric],
               rule corres_underlying_split [OF threadset_corresT])
-                apply (simp add: x)
-               apply simp
-              apply (rule y)
-             apply (fastforce simp: s)
+               apply (simp add: x)
+              apply simp
+             apply (rule y)
             apply (fastforce simp: s)
-           apply (fastforce simp: f)
-          apply (rule e)
+           apply (fastforce simp: s)
+          apply (fastforce simp: f)
          apply (rule corres_noop [where P=\<top> and P'=\<top>])
           apply simp
          apply (rule no_fail_pre, wpsimp+)[1]
@@ -582,19 +561,17 @@ lemma threadSet_corres_noop_splitT:
   assumes w: "\<lbrace>P'\<rbrace> threadSet fn t \<lbrace>\<lambda>x. Q'\<rbrace>"
   assumes s: "\<forall>tcb'. tcbSchedPrev (fn tcb') = tcbSchedPrev tcb'"
              "\<forall>tcb'. tcbSchedNext (fn tcb') = tcbSchedNext tcb'"
-  assumes f: "\<And>tcb'. tcbQueued (fn tcb') = tcbQueued tcb'"
-  assumes e: "\<And>tcb'. exst_same tcb' (fn tcb')"
+  assumes f: "\<And>d p tcb'. inQ d p (fn tcb') = inQ d p tcb'"
   shows      "corres r (tcb_at t and pspace_aligned and pspace_distinct and P) P'
                            m (threadSet fn t >>= (\<lambda>rv. m'))"
   apply (rule corres_guard_imp)
     apply (subst return_bind[symmetric])
     apply (rule corres_split_nor[OF threadSet_corres_noopT])
-            apply (simp add: x)
-           apply (rule y)
-          apply (fastforce simp: s)
+           apply (simp add: x)
+          apply (rule y)
          apply (fastforce simp: s)
-        apply (fastforce simp: f)
-       apply (rule e)
+        apply (fastforce simp: s)
+       apply (fastforce simp: f)
       apply (rule z)
      apply (wp w)+
    apply simp
@@ -1563,7 +1540,7 @@ proof -
                      (set_object add (TCB (tcb \<lparr> tcb_arch := arch_tcb_context_set con (tcb_arch tcb) \<rparr>)))
                      (setObject add (tcb' \<lparr> tcbArch := atcbContextSet con' (tcbArch tcb') \<rparr>))"
     by (rule setObject_update_TCB_corres [OF L2],
-        (simp add: tcb_cte_cases_def tcb_cap_cases_def cteSizeBits_def exst_same_def)+)
+        (simp add: tcb_cte_cases_def tcb_cap_cases_def cteSizeBits_def)+)
   have L4: "\<And>con con'. con = con' \<Longrightarrow>
             corres (\<lambda>(irv, nc) (irv', nc'). r irv irv' \<and> nc = nc')
                    \<top> \<top> (select_f (f con)) (select_f (g con'))"
@@ -1922,41 +1899,6 @@ lemma fun_if_triv[simp]:
   "(\<lambda>x. if x = y then f y else f x) = f"
   by (force)
 
-lemma corres_get_etcb:
-  "corres (etcb_relation) (is_etcb_at t) (tcb_at' t)
-                    (gets_the (get_etcb t)) (getObject t)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (clarsimp simp add: get_etcb_def gets_the_def gets_def
-                            get_def assert_opt_def bind_def
-                            return_def fail_def
-                            split: option.splits
-                            )
-  apply (frule in_inv_by_hoareD [OF getObject_inv_tcb])
-  apply (clarsimp simp add: is_etcb_at_def obj_at'_def projectKO_def
-                            projectKO_opt_tcb split_def
-                            getObject_def loadObject_default_def in_monad)
-  apply (case_tac bb)
-        apply (simp_all add: fail_def return_def)
-  apply (clarsimp simp add: state_relation_def ekheap_relation_def)
-  apply (drule bspec)
-   apply clarsimp
-   apply blast
-  apply (clarsimp simp add: other_obj_relation_def lookupAround2_known1)
-  done
-
-
-lemma ethreadget_corres:
-  assumes x: "\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow> r (f etcb) (f' tcb')"
-  shows      "corres r (is_etcb_at t) (tcb_at' t) (ethread_get f t) (threadGet f' t)"
-  apply (simp add: ethread_get_def threadGet_def)
-  apply (fold liftM_def)
-  apply simp
-  apply (rule corres_rel_imp)
-   apply (rule corres_get_etcb)
-  apply (simp add: x)
-  done
-
 lemma getQueue_corres:
   "corres (\<lambda>ls q. (ls = [] \<longleftrightarrow> tcbQueueEmpty q) \<and> (ls \<noteq> [] \<longrightarrow> tcbQueueHead q = Some (hd ls))
                   \<and> queue_end_valid ls q)
@@ -2007,13 +1949,14 @@ crunch removeFromBitmap
 lemmas addToBitmap_typ_ats [wp] = typ_at_lifts [OF addToBitmap_typ_at']
 lemmas removeFromBitmap_typ_ats [wp] = typ_at_lifts [OF removeFromBitmap_typ_at']
 
-lemma ekheap_relation_tcb_domain_priority:
-  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s t = Some (tcb);
+lemma pspace_relation_tcb_domain_priority:
+  "\<lbrakk>pspace_relation (kheap s) (ksPSpace s'); kheap s t = Some (TCB tcb);
     ksPSpace s' t = Some (KOTCB tcb')\<rbrakk>
    \<Longrightarrow> tcbDomain tcb' = tcb_domain tcb \<and> tcbPriority tcb' = tcb_priority tcb"
-  apply (clarsimp simp: ekheap_relation_def)
-  apply (drule_tac x=t in bspec, blast)
-  apply (clarsimp simp: other_obj_relation_def etcb_relation_def)
+  apply (clarsimp simp: pspace_relation_def)
+  apply (drule_tac x=t in bspec)
+   apply (fastforce simp: obj_at_def)
+  apply (clarsimp simp: obj_at_def obj_at'_def tcb_relation_cut_def tcb_relation_def)
   done
 
 lemma no_fail_thread_get[wp]:
@@ -2060,86 +2003,17 @@ lemma threadSet_pspace_relation:
   apply (fastforce dest!: tcb_rel)
   done
 
-lemma ekheap_relation_update_tcbs:
-  "\<lbrakk> ekheap_relation (ekheap s) (ksPSpace s'); ekheap s x = Some oetcb;
-     ksPSpace s' x = Some (KOTCB otcb'); etcb_relation etcb tcb' \<rbrakk>
-   \<Longrightarrow> ekheap_relation ((ekheap s)(x \<mapsto> etcb)) ((ksPSpace s')(x \<mapsto> KOTCB tcb'))"
-  by (simp add: ekheap_relation_def)
-
-lemma ekheap_relation_update_concrete_tcb:
-  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s ptr = Some etcb;
-    ksPSpace s' ptr = Some (KOTCB otcb');
-    etcb_relation etcb tcb'\<rbrakk>
-   \<Longrightarrow> ekheap_relation (ekheap s) ((ksPSpace s')(ptr \<mapsto> KOTCB tcb'))"
-  by (fastforce dest: ekheap_relation_update_tcbs simp: map_upd_triv)
-
-lemma ekheap_relation_etcb_relation:
-  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s ptr = Some etcb;
-    ksPSpace s' ptr = Some (KOTCB tcb')\<rbrakk>
-   \<Longrightarrow> etcb_relation etcb tcb'"
-  apply (clarsimp simp: ekheap_relation_def)
-  apply (drule_tac x=ptr in bspec)
-   apply (fastforce simp: obj_at_def)
-  apply (clarsimp simp: obj_at_def obj_at'_def)
-  done
-
-lemma threadSet_ekheap_relation:
-  fixes s :: det_state
-  assumes etcb_rel: "(\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcb (F tcb'))"
-  shows
-    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
-           \<and> valid_etcbs s\<rbrace>
-     threadSet F tcbPtr
-     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
-  supply fun_upd_apply[simp del]
-  unfolding threadSet_def setObject_def updateObject_default_def
-  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
-  apply (frule tcb_at'_cross)
-   apply (fastforce simp: obj_at'_def)
-  apply normalise_obj_at'
-  apply (frule (1) tcb_at_is_etcb_at)
-  apply (clarsimp simp: obj_at_def is_tcb_def is_etcb_at_def)
-  apply (rename_tac ko, case_tac ko; clarsimp)
-  apply (rule ekheap_relation_update_concrete_tcb)
-     apply fastforce
-    apply fastforce
-   apply (fastforce simp: obj_at'_def)
-  apply (frule (1) ekheap_relation_etcb_relation)
-   apply (fastforce simp: obj_at'_def)
-  apply (fastforce dest!: etcb_rel)
-  done
-
 lemma tcbQueued_update_pspace_relation[wp]:
   fixes s :: det_state
   shows "threadSet (tcbQueued_update f) tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
   by (wpsimp wp: threadSet_pspace_relation simp: tcb_relation_def)
 
-lemma tcbQueued_update_ekheap_relation[wp]:
-  fixes s :: det_state
-  shows
-    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
-           \<and> valid_etcbs s\<rbrace>
-     threadSet (tcbQueued_update f) tcbPtr
-     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
-  by (wpsimp wp: threadSet_ekheap_relation simp: etcb_relation_def)
-
 lemma tcbQueueRemove_pspace_relation[wp]:
   fixes s :: det_state
   shows "tcbQueueRemove queue tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
   unfolding tcbQueueRemove_def
   by (wpsimp wp: threadSet_pspace_relation hoare_drop_imps simp: tcb_relation_def)
 
-lemma tcbQueueRemove_ekheap_relation[wp]:
-  fixes s :: det_state
-  shows
-    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
-           \<and> valid_etcbs s\<rbrace>
-     tcbQueueRemove queue tcbPtr
-     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
-  unfolding tcbQueueRemove_def
-  by (wpsimp wp: threadSet_ekheap_relation threadSet_pspace_relation hoare_drop_imps
-           simp: tcb_relation_def etcb_relation_def)
-
 lemma threadSet_ghost_relation[wp]:
   "threadSet f tcbPtr \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') (gsPTTypes (ksArchState s'))\<rbrace>"
   unfolding threadSet_def setObject_def updateObject_default_def
@@ -2178,7 +2052,7 @@ lemma set_tcb_queue_projs:
    \<lbrace>\<lambda>s. P (kheap s) (cdt s) (is_original_cap s) (cur_thread s) (idle_thread s) (scheduler_action s)
           (domain_list s) (domain_index s) (cur_domain s) (domain_time s) (machine_state s)
           (interrupt_irq_node s) (interrupt_states s) (arch_state s) (caps_of_state s)
-          (work_units_completed s) (cdt_list s) (ekheap s)\<rbrace>"
+          (work_units_completed s) (cdt_list s)\<rbrace>"
   by (wpsimp simp: set_tcb_queue_def)
 
 lemma set_tcb_queue_cte_at:
@@ -2191,7 +2065,6 @@ lemma set_tcb_queue_cte_at:
 lemma set_tcb_queue_projs_inv:
   "fst (set_tcb_queue d p queue s) = {(r, s')} \<Longrightarrow>
    kheap s = kheap s'
-   \<and> ekheap s = ekheap s'
    \<and> cdt s = cdt s'
    \<and> is_original_cap s = is_original_cap s'
    \<and> cur_thread s = cur_thread s'
@@ -2224,51 +2097,18 @@ lemma tcbQueuePrepend_pspace_relation[wp]:
   unfolding tcbQueuePrepend_def
   by (wpsimp wp: threadSet_pspace_relation simp: tcb_relation_def)
 
-lemma tcbQueuePrepend_ekheap_relation[wp]:
-  fixes s :: det_state
-  shows
-    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
-           \<and> valid_etcbs s\<rbrace>
-     tcbQueuePrepend queue tcbPtr
-     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
-  unfolding tcbQueuePrepend_def
-  by (wpsimp wp: threadSet_pspace_relation threadSet_ekheap_relation
-           simp: tcb_relation_def etcb_relation_def)
-
 lemma tcbQueueAppend_pspace_relation[wp]:
   fixes s :: det_state
   shows "tcbQueueAppend queue tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
   unfolding tcbQueueAppend_def
   by (wpsimp wp: threadSet_pspace_relation simp: tcb_relation_def)
 
-lemma tcbQueueAppend_ekheap_relation[wp]:
-  fixes s :: det_state
-  shows
-    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
-           \<and> valid_etcbs s\<rbrace>
-     tcbQueueAppend queue tcbPtr
-     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
-  unfolding tcbQueueAppend_def
-  by (wpsimp wp: threadSet_pspace_relation threadSet_ekheap_relation
-           simp: tcb_relation_def etcb_relation_def)
-
 lemma tcbQueueInsert_pspace_relation[wp]:
   fixes s :: det_state
   shows "tcbQueueInsert tcbPtr afterPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
   unfolding tcbQueueInsert_def
   by (wpsimp wp: threadSet_pspace_relation hoare_drop_imps simp: tcb_relation_def)
 
-lemma tcbQueueInsert_ekheap_relation[wp]:
-  fixes s :: det_state
-  shows
-    "\<lbrace>\<lambda>s'. ekheap_relation (ekheap s) (ksPSpace s') \<and> pspace_relation (kheap s) (ksPSpace s')
-           \<and> valid_etcbs s\<rbrace>
-     tcbQueueInsert tcbPtr afterPtr
-     \<lbrace>\<lambda>_ s'. ekheap_relation (ekheap s) (ksPSpace s')\<rbrace>"
-  unfolding tcbQueueInsert_def
-  by (wpsimp wp: threadSet_pspace_relation threadSet_ekheap_relation hoare_drop_imps
-           simp: tcb_relation_def etcb_relation_def)
-
 lemma removeFromBitmap_pspace_relation[wp]:
   fixes s :: det_state
   shows "removeFromBitmap tdom prio \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
@@ -2349,22 +2189,22 @@ lemma threadSet_ready_queues_relation:
 definition in_correct_ready_q_2 where
   "in_correct_ready_q_2 queues ekh \<equiv>
      \<forall>d p. \<forall>t \<in> set (queues d p). is_etcb_at' t ekh
-                                  \<and> etcb_at' (\<lambda>t. tcb_priority t = p \<and> tcb_domain t = d) t ekh"
+                                  \<and> etcb_at' (\<lambda>t. etcb_priority t = p \<and> etcb_domain t = d) t ekh"
 
-abbreviation in_correct_ready_q :: "det_ext state \<Rightarrow> bool" where
-  "in_correct_ready_q s \<equiv> in_correct_ready_q_2 (ready_queues s) (ekheap s)"
+abbreviation in_correct_ready_q :: "'z state \<Rightarrow> bool" where
+  "in_correct_ready_q s \<equiv> in_correct_ready_q_2 (ready_queues s) (etcbs_of s)"
 
 lemmas in_correct_ready_q_def = in_correct_ready_q_2_def
 
 lemma in_correct_ready_q_lift:
-  assumes c: "\<And>P. \<lbrace>\<lambda>s. P (ekheap s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
+  assumes c: "\<And>P. f \<lbrace>\<lambda>s. P (etcbs_of s)\<rbrace>"
   assumes r: "\<And>P. f \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace>"
   shows "f \<lbrace>in_correct_ready_q\<rbrace>"
   apply (rule hoare_pre)
    apply (wps assms | wpsimp)+
   done
 
-definition ready_qs_distinct :: "det_ext state \<Rightarrow> bool" where
+definition ready_qs_distinct :: "'z state \<Rightarrow> bool" where
   "ready_qs_distinct s \<equiv> \<forall>d p. distinct (ready_queues s d p)"
 
 lemma ready_qs_distinct_lift:
@@ -2461,28 +2301,6 @@ lemma thread_get_exs_valid[wp]:
   by (clarsimp simp: thread_get_def get_tcb_def gets_the_def gets_def return_def get_def
                      exs_valid_def tcb_at_def bind_def)
 
-lemma ethread_get_sp:
-  "\<lbrace>P\<rbrace> ethread_get f ptr
-   \<lbrace>\<lambda>rv. etcb_at (\<lambda>tcb. f tcb = rv) ptr and P\<rbrace>"
-  apply wpsimp
-  apply (clarsimp simp: etcb_at_def split: option.splits)
-  done
-
-lemma ethread_get_exs_valid[wp]:
-  "\<lbrakk>tcb_at tcb_ptr s; valid_etcbs s\<rbrakk> \<Longrightarrow> \<lbrace>(=) s\<rbrace> ethread_get f tcb_ptr \<exists>\<lbrace>\<lambda>_. (=) s\<rbrace>"
-  apply (frule (1) tcb_at_is_etcb_at)
-  apply (clarsimp simp: ethread_get_def get_etcb_def gets_the_def gets_def return_def get_def
-                        is_etcb_at_def exs_valid_def bind_def)
-  done
-
-lemma no_fail_ethread_get[wp]:
-  "no_fail (tcb_at tcb_ptr and valid_etcbs) (ethread_get f tcb_ptr)"
-  unfolding ethread_get_def
-  apply wpsimp
-  apply (frule (1) tcb_at_is_etcb_at)
-  apply (clarsimp simp: is_etcb_at_def get_etcb_def)
-  done
-
 lemma threadGet_sp:
   "\<lbrace>P\<rbrace> threadGet f ptr \<lbrace>\<lambda>rv s. \<exists>tcb :: tcb. ko_at' tcb ptr s \<and> f tcb = rv \<and> P s\<rbrace>"
   unfolding threadGet_def setObject_def
@@ -2509,7 +2327,7 @@ lemma in_ready_q_tcbQueued_eq:
 lemma tcbSchedEnqueue_corres:
   "tcb_ptr = tcbPtr \<Longrightarrow>
    corres dc
-     (in_correct_ready_q and ready_qs_distinct and valid_etcbs and st_tcb_at runnable tcb_ptr
+     (in_correct_ready_q and ready_qs_distinct and st_tcb_at runnable tcb_ptr
       and pspace_aligned and pspace_distinct)
      (sym_heap_sched_pointers and valid_sched_pointers and valid_tcbs')
      (tcb_sched_action tcb_sched_enqueue tcb_ptr) (tcbSchedEnqueue tcbPtr)"
@@ -2525,9 +2343,9 @@ lemma tcbSchedEnqueue_corres:
    apply (fastforce dest: pspace_distinct_cross)
   apply (clarsimp simp: tcb_sched_action_def tcb_sched_enqueue_def get_tcb_queue_def
                         tcbSchedEnqueue_def getQueue_def unless_def when_def)
-  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ thread_get_sp]; (solves wpsimp)?)
   apply (rename_tac domain)
-  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_l[OF _ _ thread_get_sp]; (solves wpsimp)?)
   apply (rename_tac priority)
   apply (rule corres_symb_exec_l[OF _ _ gets_sp]; (solves wpsimp)?)
   apply (rule corres_stateAssert_ignore)
@@ -2539,12 +2357,11 @@ lemma tcbSchedEnqueue_corres:
   apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
   apply (subst if_distrib[where f="set_tcb_queue domain prio" for domain prio])
   apply (rule corres_if_strong')
-    apply (frule state_relation_ready_queues_relation)
-    apply (frule in_ready_q_tcbQueued_eq[where t=tcbPtr])
     subgoal
-      by (fastforce dest: tcb_at_ekheap_dom pred_tcb_at_tcb_at
-                    simp: obj_at'_def opt_pred_def opt_map_def obj_at_def is_tcb_def
-                          in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+      by (fastforce dest!: state_relation_ready_queues_relation
+                           in_ready_q_tcbQueued_eq[where t=tcbPtr]
+                     simp: obj_at'_def opt_pred_def opt_map_def in_correct_ready_q_def
+                           obj_at_def etcb_at_def etcbs_of'_def)
    apply (find_goal \<open>match conclusion in "corres _ _ _ _ (return ())" \<Rightarrow> \<open>-\<close>\<close>)
    apply (rule monadic_rewrite_corres_l[where P=P and Q=P for P, simplified])
     apply (clarsimp simp: set_tcb_queue_def)
@@ -2591,19 +2408,18 @@ lemma tcbSchedEnqueue_corres:
   apply (drule set_tcb_queue_new_state)
   apply (wpsimp wp: threadSet_wp getObject_tcb_wp simp: setQueue_def tcbQueuePrepend_def)
   apply normalise_obj_at'
-  apply (frule (1) tcb_at_is_etcb_at)
-  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
-  apply (rename_tac s d p s' tcb' tcb etcb)
-  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+  apply (clarsimp simp: obj_at_def)
+  apply (rename_tac s d p s' tcb' tcb)
+  apply (frule_tac t=tcbPtr in pspace_relation_tcb_domain_priority)
     apply (force simp: obj_at_def)
    apply (force simp: obj_at'_def)
   apply (clarsimp split: if_splits)
   apply (cut_tac ts="ready_queues s d p" in list_queue_relation_nil)
    apply (force dest!: spec simp: list_queue_relation_def)
-  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+  apply (cut_tac ts="ready_queues s (tcb_domain tcb) (tcb_priority tcb)"
               in list_queue_relation_nil)
    apply (force dest!: spec simp: list_queue_relation_def)
-  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)" and s'=s'
+  apply (cut_tac ts="ready_queues s (tcb_domain tcb) (tcb_priority tcb)" and s'=s'
               in obj_at'_tcbQueueEnd_ksReadyQueues)
       apply fast
      apply auto[1]
@@ -2612,14 +2428,14 @@ lemma tcbSchedEnqueue_corres:
   apply (cut_tac xs="ready_queues s d p" and st="tcbQueueHead (ksReadyQueues s' (d, p))"
               in heap_path_head')
    apply (auto dest: spec simp: list_queue_relation_def tcbQueueEmpty_def)[1]
-  apply (cut_tac xs="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
-             and st="tcbQueueHead (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb))"
+  apply (cut_tac xs="ready_queues s (tcb_domain tcb) (tcb_priority tcb)"
+             and st="tcbQueueHead (ksReadyQueues s' (tcb_domain tcb, tcb_priority tcb))"
               in heap_path_head')
    apply (auto dest: spec simp: list_queue_relation_def tcbQueueEmpty_def)[1]
   apply (clarsimp simp: list_queue_relation_def)
 
-  apply (case_tac "\<not> (d = tcb_domain etcb \<and> p = tcb_priority etcb)")
-   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+  apply (case_tac "\<not> (d = tcb_domain tcb \<and> p = tcb_priority tcb)")
+   apply (cut_tac d=d and d'="tcb_domain tcb" and p=p and p'="tcb_priority tcb"
                in ready_queues_disjoint)
       apply force
      apply fastforce
@@ -2643,8 +2459,8 @@ lemma tcbSchedEnqueue_corres:
     apply (clarsimp simp: fun_upd_apply split: if_splits)
 
    \<comment> \<open>the ready queue was not originally empty\<close>
-   apply (clarsimp simp: etcb_at_def obj_at'_def)
-   apply (prop_tac "the (tcbQueueHead (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))
+   apply (clarsimp simp: obj_at'_def)
+   apply (prop_tac "the (tcbQueueHead (ksReadyQueues s' (tcb_domain tcb, tcb_priority tcb)))
                     \<notin> set (ready_queues s d p)")
     apply (erule orthD2)
     apply (clarsimp simp: tcbQueueEmpty_def)
@@ -2662,7 +2478,7 @@ lemma tcbSchedEnqueue_corres:
       apply (case_tac "ready_queues s d p"; force simp: tcbQueueEmpty_def)
      apply (case_tac "t = tcbPtr")
       apply (clarsimp simp: inQ_def fun_upd_apply obj_at'_def split: if_splits)
-     apply (case_tac "t = the (tcbQueueHead (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))")
+     apply (case_tac "t = the (tcbQueueHead (ksReadyQueues s' (tcb_domain tcb, tcb_priority tcb)))")
       apply (clarsimp simp: inQ_def opt_pred_def opt_map_def obj_at'_def fun_upd_apply
                      split: option.splits)
       apply metis
@@ -2670,11 +2486,11 @@ lemma tcbSchedEnqueue_corres:
     apply (clarsimp simp: fun_upd_apply split: if_splits)
    apply (clarsimp simp: fun_upd_apply split: if_splits)
 
-  \<comment> \<open>d = tcb_domain etcb \<and> p = tcb_priority etcb\<close>
+  \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
   apply clarsimp
-  apply (drule_tac x="tcb_domain etcb" in spec)
-  apply (drule_tac x="tcb_priority etcb" in spec)
-  apply (cut_tac ts="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+  apply (drule_tac x="tcb_domain tcb" in spec)
+  apply (drule_tac x="tcb_priority tcb" in spec)
+  apply (cut_tac ts="ready_queues s (tcb_domain tcb) (tcb_priority tcb)"
               in tcbQueueHead_iff_tcbQueueEnd)
    apply (force simp: list_queue_relation_def)
   apply (frule valid_tcbs'_maxDomain[where t=tcbPtr], simp add: obj_at'_def)
@@ -2719,7 +2535,7 @@ lemma setSchedulerAction_corres:
   apply (simp add: setSchedulerAction_def set_scheduler_action_def)
   apply (rule corres_no_failI)
    apply wp
-  apply (clarsimp simp: in_monad simpler_modify_def state_relation_def)
+  apply (clarsimp simp: in_monad simpler_modify_def state_relation_def swp_def)
   done
 
 lemma getSchedulerAction_corres:
@@ -2730,7 +2546,7 @@ lemma getSchedulerAction_corres:
 
 lemma rescheduleRequired_corres:
   "corres dc
-     (weak_valid_sched_action and in_correct_ready_q and ready_qs_distinct and valid_etcbs
+     (weak_valid_sched_action and in_correct_ready_q and ready_qs_distinct
       and pspace_aligned and pspace_distinct)
      (sym_heap_sched_pointers and valid_sched_pointers and valid_tcbs')
      (reschedule_required) rescheduleRequired"
@@ -2748,8 +2564,8 @@ lemma rescheduleRequired_corres:
         apply (rule setSchedulerAction_corres)
         apply simp
        apply (wp | wpc | simp)+
-   apply (force dest: st_tcb_weakenE simp: in_monad weak_valid_sched_action_def valid_etcbs_def st_tcb_at_def obj_at_def is_tcb
-               split: Deterministic_A.scheduler_action.split)
+   apply (force dest: st_tcb_weakenE simp: in_monad weak_valid_sched_action_def st_tcb_at_def obj_at_def is_tcb
+               split: Structures_A.scheduler_action.split)
   apply (clarsimp split: scheduler_action.splits)
   done
 
@@ -2922,8 +2738,8 @@ definition tcb_queue_remove :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list"
 
 definition tcb_sched_dequeue' :: "obj_ref \<Rightarrow> unit det_ext_monad" where
   "tcb_sched_dequeue' tcb_ptr \<equiv> do
-     d \<leftarrow> ethread_get tcb_domain tcb_ptr;
-     prio \<leftarrow> ethread_get tcb_priority tcb_ptr;
+     d \<leftarrow> thread_get tcb_domain tcb_ptr;
+     prio \<leftarrow> thread_get tcb_priority tcb_ptr;
      queue \<leftarrow> get_tcb_queue d prio;
      when (tcb_ptr \<in> set queue) $ set_tcb_queue d prio (tcb_queue_remove tcb_ptr queue)
    od"
@@ -2941,7 +2757,7 @@ lemma filter_tcb_queue_remove:
   done
 
 lemma tcb_sched_dequeue_monadic_rewrite:
-  "monadic_rewrite False True (is_etcb_at t and (\<lambda>s. \<forall>d p. distinct (ready_queues s d p)))
+  "monadic_rewrite False True (tcb_at t and (\<lambda>s. \<forall>d p. distinct (ready_queues s d p)))
      (tcb_sched_action tcb_sched_dequeue t) (tcb_sched_dequeue' t)"
   supply if_split[split del]
   apply (clarsimp simp: tcb_sched_dequeue'_def tcb_sched_dequeue_def tcb_sched_action_def
@@ -2954,9 +2770,9 @@ lemma tcb_sched_dequeue_monadic_rewrite:
       apply (metis (mono_tags, lifting) filter_cong)
      apply (rule monadic_rewrite_modify_noop)
     apply (wpsimp wp: thread_get_wp)+
-  apply (clarsimp simp: etcb_at_def split: option.splits)
-  apply (prop_tac "(\<lambda>d' p. if d' = tcb_domain x2 \<and> p = tcb_priority x2
-                           then filter (\<lambda>x. x \<noteq> t) (ready_queues s (tcb_domain x2) (tcb_priority x2))
+  apply (clarsimp simp: tcb_at_def)
+  apply (prop_tac "(\<lambda>d' p. if d' = tcb_domain tcb \<and> p = tcb_priority tcb
+                           then filter ((\<noteq>) t) (ready_queues s (tcb_domain tcb) (tcb_priority tcb))
                            else ready_queues s d' p)
                    = ready_queues s")
    apply (subst filter_True)
@@ -2989,7 +2805,7 @@ lemma in_queue_not_head_or_not_tail_length_gt_1:
 lemma tcbSchedDequeue_corres:
   "tcb_ptr = tcbPtr \<Longrightarrow>
    corres dc
-     (in_correct_ready_q and ready_qs_distinct and valid_etcbs and tcb_at tcb_ptr
+     (in_correct_ready_q and ready_qs_distinct and tcb_at tcb_ptr
       and pspace_aligned and pspace_distinct)
      (sym_heap_sched_pointers and valid_objs')
      (tcb_sched_action tcb_sched_dequeue tcb_ptr) (tcbSchedDequeue tcbPtr)"
@@ -3003,22 +2819,22 @@ lemma tcbSchedDequeue_corres:
    apply (fastforce dest: pspace_distinct_cross)
   apply (rule monadic_rewrite_corres_l[where P=P and Q=P for P, simplified])
    apply (rule monadic_rewrite_guard_imp[OF tcb_sched_dequeue_monadic_rewrite])
-   apply (fastforce dest: tcb_at_is_etcb_at simp: in_correct_ready_q_def ready_qs_distinct_def)
+   apply (fastforce simp: in_correct_ready_q_def ready_qs_distinct_def)
   apply (clarsimp simp: tcb_sched_dequeue'_def get_tcb_queue_def tcbSchedDequeue_def  getQueue_def
                         unless_def when_def)
-  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rule corres_symb_exec_l[OF _ _ thread_get_sp]; wpsimp?)
   apply (rename_tac dom)
-  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; wpsimp?)
+  apply (rule corres_symb_exec_l[OF _ _ thread_get_sp]; wpsimp?)
   apply (rename_tac prio)
   apply (rule corres_symb_exec_l[OF _ _ gets_sp]; (solves wpsimp)?)
   apply (rule corres_stateAssert_ignore)
    apply (fastforce intro: ksReadyQueues_asrt_cross)
   apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
   apply (rule corres_if_strong'; fastforce?)
-    apply (frule state_relation_ready_queues_relation)
-    apply (frule in_ready_q_tcbQueued_eq[where t=tcbPtr])
-    apply (fastforce simp: obj_at'_def opt_pred_def opt_map_def obj_at_def is_tcb_def
-                           in_correct_ready_q_def etcb_at_def is_etcb_at_def)
+   apply (fastforce dest!: state_relation_ready_queues_relation
+                           in_ready_q_tcbQueued_eq[where t=tcbPtr]
+                     simp: obj_at'_def opt_pred_def opt_map_def in_correct_ready_q_def
+                           obj_at_def etcb_at_def etcbs_of'_def)
   apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
   apply (rule corres_symb_exec_r[OF _ threadGet_sp]; wpsimp?)
   apply (rule corres_symb_exec_r[OF _ gets_sp]; wpsimp?)
@@ -3040,24 +2856,23 @@ lemma tcbSchedDequeue_corres:
   apply (wpsimp wp: threadSet_wp getObject_tcb_wp
               simp: setQueue_def tcbQueueRemove_def
          split_del: if_split)
-  apply (frule (1) tcb_at_is_etcb_at)
-  apply (clarsimp simp: obj_at_def is_etcb_at_def etcb_at_def)
+  apply (clarsimp simp: obj_at_def)
   apply normalise_obj_at'
-  apply (rename_tac s d p s' tcb' tcb etcb)
-  apply (frule_tac t=tcbPtr in ekheap_relation_tcb_domain_priority)
+  apply (rename_tac s d p s' tcb' tcb)
+  apply (frule_tac t=tcbPtr in pspace_relation_tcb_domain_priority)
     apply (force simp: obj_at_def)
    apply (force simp: obj_at'_def)
 
-  apply (case_tac "d \<noteq> tcb_domain etcb \<or> p \<noteq> tcb_priority etcb")
+  apply (case_tac "d \<noteq> tcb_domain tcb \<or> p \<noteq> tcb_priority tcb")
    apply clarsimp
-   apply (cut_tac p=tcbPtr and ls="ready_queues s (tcb_domain etcb) (tcb_priority etcb)"
+   apply (cut_tac p=tcbPtr and ls="ready_queues s (tcb_domain tcb) (tcb_priority tcb)"
                in list_queue_relation_neighbour_in_set)
       apply (fastforce dest!: spec)
      apply fastforce
     apply fastforce
    apply (cut_tac xs="ready_queues s d p" in heap_path_head')
     apply (force dest!: spec simp: ready_queues_relation_def Let_def list_queue_relation_def)
-   apply (cut_tac d=d and d'="tcb_domain etcb" and p=p and p'="tcb_priority etcb"
+   apply (cut_tac d=d and d'="tcb_domain tcb" and p=p and p'="tcb_priority tcb"
                in ready_queues_disjoint)
       apply force
      apply fastforce
@@ -3081,7 +2896,7 @@ lemma tcbSchedDequeue_corres:
      apply (clarsimp simp: fun_upd_apply)
     apply (clarsimp simp: fun_upd_apply)
 
-   apply (clarsimp simp: etcb_at_def obj_at'_def)
+   apply (clarsimp simp: obj_at'_def)
    apply (intro conjI; clarsimp)
 
     \<comment> \<open>tcbPtr is the head of the ready queue\<close>
@@ -3127,8 +2942,8 @@ lemma tcbSchedDequeue_corres:
 
   \<comment> \<open>d = tcb_domain tcb \<and> p = tcb_priority tcb\<close>
   apply clarsimp
-  apply (drule_tac x="tcb_domain etcb" in spec)
-  apply (drule_tac x="tcb_priority etcb" in spec)
+  apply (drule_tac x="tcb_domain tcb" in spec)
+  apply (drule_tac x="tcb_priority tcb" in spec)
   apply (clarsimp simp: list_queue_relation_def)
   apply (frule heap_path_head')
   apply (frule heap_ls_distinct)
@@ -3141,7 +2956,7 @@ lemma tcbSchedDequeue_corres:
      apply (simp add: fun_upd_apply tcb_queue_remove_def queue_end_valid_def heap_ls_unique
                       heap_path_last_end)
     apply (simp add: fun_upd_apply prev_queue_head_def)
-   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+   apply (case_tac "ready_queues s (tcb_domain tcb) (tcb_priority tcb)";
           clarsimp simp: tcb_queue_remove_def inQ_def opt_pred_def fun_upd_apply)
   apply (intro conjI; clarsimp)
 
@@ -3160,7 +2975,7 @@ lemma tcbSchedDequeue_corres:
       apply (clarsimp simp: opt_map_red opt_map_upd_triv fun_upd_apply)
      apply (clarsimp simp: queue_end_valid_def fun_upd_apply last_tl)
     apply (clarsimp simp: prev_queue_head_def fun_upd_apply)
-   apply (case_tac "ready_queues s (tcb_domain etcb) (tcb_priority etcb)";
+   apply (case_tac "ready_queues s (tcb_domain tcb) (tcb_priority tcb)";
           clarsimp simp: inQ_def opt_pred_def opt_map_def fun_upd_apply split: option.splits)
   apply (intro conjI; clarsimp)
 
@@ -3239,11 +3054,11 @@ lemma setThreadState_corres:
           (set_thread_state t ts) (setThreadState ts' t)"
   (is "?tsr \<Longrightarrow> corres dc ?Pre ?Pre' ?sts ?sts'")
   apply (simp add: set_thread_state_def setThreadState_def)
-  apply (simp add: set_thread_state_ext_def[abs_def])
+  apply (simp add: set_thread_state_act_def[abs_def])
   apply (subst bind_assoc[symmetric], subst thread_set_def[simplified, symmetric])
   apply (rule corres_guard_imp)
     apply (rule corres_split[where r'=dc])
-       apply (rule threadset_corres, (simp add: tcb_relation_def exst_same_def)+)
+       apply (rule threadset_corres, (simp add: tcb_relation_def inQ_def)+)
       apply (subst thread_get_test[where test="runnable"])
       apply (rule corres_split[OF thread_get_isRunnable_corres])
         apply (rule corres_split[OF getCurThread_corres])
@@ -3264,7 +3079,7 @@ lemma setBoundNotification_corres:
           (set_bound_notification t ntfn) (setBoundNotification ntfn t)"
   apply (simp add: set_bound_notification_def setBoundNotification_def)
   apply (subst thread_set_def[simplified, symmetric])
-  apply (rule threadset_corres, simp_all add:tcb_relation_def exst_same_def)
+  apply (rule threadset_corres, simp_all add:tcb_relation_def inQ_def)
   done
 
 crunch rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
@@ -5972,154 +5787,6 @@ lemma asUser_irq_handlers':
   apply (wpsimp wp: threadSet_irq_handlers' [OF all_tcbI, OF ball_tcb_cte_casesI] select_f_inv)
   done
 
-(* the brave can try to move this up to near setObject_update_TCB_corres' *)
-
-definition non_exst_same :: "Structures_H.tcb \<Rightarrow> Structures_H.tcb \<Rightarrow> bool"
-where
-  "non_exst_same tcb tcb' \<equiv> \<exists>d p ts. tcb' = tcb\<lparr>tcbDomain := d, tcbPriority := p, tcbTimeSlice := ts\<rparr>"
-
-fun non_exst_same' :: "Structures_H.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
-where
-  "non_exst_same' (KOTCB tcb) (KOTCB tcb') = non_exst_same tcb tcb'" |
-  "non_exst_same' _ _ = True"
-
-lemma non_exst_same_prio_upd[simp]:
-  "non_exst_same tcb (tcbPriority_update f tcb)"
-  by (cases tcb, simp add: non_exst_same_def)
-
-lemma non_exst_same_timeSlice_upd[simp]:
-  "non_exst_same tcb (tcbTimeSlice_update f tcb)"
-  by (cases tcb, simp add: non_exst_same_def)
-
-lemma non_exst_same_domain_upd[simp]:
-  "non_exst_same tcb (tcbDomain_update f tcb)"
-  by (cases tcb, simp add: non_exst_same_def)
-
-lemma set_eobject_corres':
-  assumes e: "etcb_relation etcb tcb'"
-  assumes z: "\<And>s. obj_at' P ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> KOTCB tcb')) = map_to_ctes (ksPSpace s)"
-  shows
-    "corres dc
-       (tcb_at ptr and is_etcb_at ptr)
-       (obj_at' (\<lambda>ko. non_exst_same ko tcb') ptr and obj_at' P ptr
-        and obj_at' (\<lambda>tcb. (tcbDomain tcb \<noteq> tcbDomain tcb' \<or> tcbPriority tcb \<noteq> tcbPriority tcb')
-                            \<longrightarrow> \<not> tcbQueued tcb) ptr)
-       (set_eobject ptr etcb) (setObject ptr tcb')"
-  apply (rule corres_no_failI)
-   apply (rule no_fail_pre)
-    apply wp
-   apply (clarsimp simp: obj_at'_def)
-  apply (unfold set_eobject_def setObject_def)
-  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def Bex_def
-                        put_def return_def modify_def get_object_def
-                        updateObject_default_def in_magnitude_check objBits_simps')
-  apply (clarsimp simp add: state_relation_def z)
-  apply (clarsimp simp add: obj_at_def is_etcb_at_def)
-  apply (simp only: pspace_relation_def dom_fun_upd2 simp_thms)
-  apply (elim conjE)
-  apply (frule bspec, erule domI)
-  apply (rule conjI)
-   apply (rule ballI, drule(1) bspec)
-   apply (drule domD)
-   apply (clarsimp simp: is_other_obj_relation_type)
-   apply (drule(1) bspec)
-   apply (clarsimp simp: non_exst_same_def)
-   apply (case_tac bb; simp)
-     apply (clarsimp simp: obj_at'_def other_obj_relation_def tcb_relation_cut_def
-                           cte_relation_def tcb_relation_def
-                     split: if_split_asm)+
-   apply (clarsimp simp: aobj_relation_cuts_def split: AARCH64_A.arch_kernel_obj.splits)
-   apply (rename_tac arch_kernel_obj obj d p ts)
-   apply (case_tac arch_kernel_obj; simp)
-     apply (clarsimp simp: pte_relation_def is_tcb_def
-                    split: if_split_asm)+
-  apply (extract_conjunct \<open>match conclusion in "ekheap_relation _ _" \<Rightarrow> -\<close>)
-   apply (simp only: ekheap_relation_def dom_fun_upd2 simp_thms)
-   apply (frule bspec, erule domI)
-   apply (rule ballI, drule(1) bspec)
-   apply (drule domD)
-   apply (clarsimp simp: obj_at'_def)
-   apply (insert e)
-   apply (clarsimp simp: other_obj_relation_def etcb_relation_def is_other_obj_relation_type
-                  split: Structures_A.kernel_object.splits kernel_object.splits arch_kernel_obj.splits)
-   apply (frule in_ready_q_tcbQueued_eq[where t=ptr])
-  apply (rename_tac s' conctcb' abstcb exttcb)
-  apply (clarsimp simp: ready_queues_relation_def Let_def)
-  apply (prop_tac "(tcbSchedNexts_of s')(ptr := tcbSchedNext tcb') = tcbSchedNexts_of s'")
-   apply (fastforce simp: opt_map_def obj_at'_def non_exst_same_def split: option.splits)
-  apply (prop_tac "(tcbSchedPrevs_of s')(ptr := tcbSchedPrev tcb') = tcbSchedPrevs_of s'")
-   apply (fastforce simp: opt_map_def obj_at'_def non_exst_same_def split: option.splits)
-  apply (clarsimp simp: ready_queue_relation_def opt_map_def opt_pred_def obj_at'_def inQ_def
-                        non_exst_same_def
-                 split: option.splits)
-  apply metis
-  done
-
-lemma set_eobject_corres:
-  assumes tcbs: "non_exst_same tcb' tcbu'"
-  assumes e: "etcb_relation etcb tcb' \<Longrightarrow> etcb_relation etcbu tcbu'"
-  assumes tables': "\<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb'"
-  assumes r: "r () ()"
-  shows
-    "corres r
-       (tcb_at add and (\<lambda>s. ekheap s add = Some etcb))
-       (ko_at' tcb' add
-        and obj_at' (\<lambda>tcb. (tcbDomain tcb \<noteq> tcbDomain tcbu' \<or> tcbPriority tcb \<noteq> tcbPriority tcbu')
-                           \<longrightarrow> \<not> tcbQueued tcb) add)
-       (set_eobject add etcbu) (setObject add tcbu')"
-  apply (rule_tac F="non_exst_same tcb' tcbu' \<and> etcb_relation etcbu tcbu'" in corres_req)
-   apply (clarsimp simp: state_relation_def obj_at_def obj_at'_def)
-   apply (frule(1) pspace_relation_absD)
-   apply (clarsimp simp: other_obj_relation_def ekheap_relation_def e tcbs)
-   apply (drule bspec, erule domI)
-   apply (clarsimp simp: e)
-  apply (erule conjE)
-  apply (rule corres_guard_imp)
-    apply (rule corres_rel_imp)
-     apply (rule set_eobject_corres'[where P="(=) tcb'"])
-      apply simp
-     defer
-    apply (simp add: r)
-   apply (fastforce simp: is_etcb_at_def elim!: obj_at_weakenE)
-   apply (subst(asm) eq_commute)
-   apply (clarsimp simp: obj_at'_def)
-  apply (clarsimp simp: obj_at'_def objBits_simps)
-  apply (subst map_to_ctes_upd_tcb, assumption+)
-   apply (simp add: ps_clear_def3 field_simps objBits_defs mask_def)
-  apply (subst if_not_P)
-   apply (fastforce dest: bspec [OF tables', OF ranI])
-  apply simp
-  done
-
-lemma ethread_set_corresT:
-  assumes x: "\<And>tcb'. non_exst_same tcb' (f' tcb')"
-  assumes z: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (f' tcb) = getF tcb"
-  assumes e: "\<And>etcb tcb'. etcb_relation etcb tcb' \<Longrightarrow> etcb_relation (f etcb) (f' tcb')"
-  shows
-    "corres dc
-       (tcb_at t and valid_etcbs)
-       (tcb_at' t
-        and obj_at' (\<lambda>tcb. (tcbDomain tcb \<noteq> tcbDomain (f' tcb)
-                             \<or> tcbPriority tcb \<noteq> tcbPriority (f' tcb))
-                           \<longrightarrow> \<not> tcbQueued tcb) t)
-       (ethread_set f t) (threadSet f' t)"
-  apply (simp add: ethread_set_def threadSet_def bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF corres_get_etcb set_eobject_corres])
-         apply (rule x)
-        apply (erule e)
-       apply (simp add: z)+
-     apply (wp getObject_tcb_wp)+
-   apply clarsimp
-   apply (simp add: valid_etcbs_def tcb_at_st_tcb_at[symmetric])
-   apply (force simp: tcb_at_def get_etcb_def obj_at_def)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemmas ethread_set_corres =
-    ethread_set_corresT [OF _ all_tcbI, OF _ ball_tcb_cte_casesI]
-
 lemma archTcbUpdate_aux2: "(\<lambda>tcb. tcb\<lparr> tcbArch := f (tcbArch tcb)\<rparr>) = tcbArch_update f"
   by (rule ext, case_tac tcb, simp)
 
diff --git a/proof/refine/AARCH64/Tcb_R.thy b/proof/refine/AARCH64/Tcb_R.thy
index d303b7c184..6d6d4411ba 100644
--- a/proof/refine/AARCH64/Tcb_R.thy
+++ b/proof/refine/AARCH64/Tcb_R.thy
@@ -220,7 +220,7 @@ lemma restart_corres:
         apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak valid_pspace'_def
                               valid_tcb_state'_def)
        apply wp+
-   apply (simp add: valid_sched_def invs_def tcb_at_is_etcb_at invs_psp_aligned invs_distinct)
+   apply (simp add: valid_sched_def invs_def invs_psp_aligned invs_distinct)
   apply clarsimp
   done
 
@@ -341,7 +341,7 @@ lemma invokeTCB_WriteRegisters_corres:
                 apply simp
                apply (wp+)[2]
              apply ((wp hoare_weak_lift_imp restart_invs'
-                     | strengthen valid_sched_weak_strg einvs_valid_etcbs
+                     | strengthen valid_sched_weak_strg
                                   invs_weak_sch_act_wf
                                   valid_queues_in_correct_ready_q valid_queues_ready_qs_distinct
                                   valid_sched_valid_queues valid_objs'_valid_tcbs' invs_valid_objs'
@@ -583,9 +583,63 @@ crunch tcbSchedDequeue
 crunch tcbSchedDequeue
   for st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' st tcbPtr s)"
 
+lemma thread_set_ready_qs_distinct[wp]:
+  "thread_set f tcb_ptr \<lbrace>ready_qs_distinct\<rbrace>"
+  apply (wpsimp wp: thread_set_wp)
+  by (clarsimp simp: ready_qs_distinct_def)
+
+lemma thread_set_in_correct_ready_q_not_queued:
+  "\<lbrace>in_correct_ready_q and not_queued t\<rbrace>
+   thread_set f t
+   \<lbrace>\<lambda>_. in_correct_ready_q\<rbrace>"
+  unfolding thread_set_priority_def
+  apply (wpsimp wp: thread_set_wp)
+  apply (clarsimp simp: in_correct_ready_q_def not_queued_def is_etcb_at'_def etcb_at_def etcbs_of'_def)
+  done
+
+lemma tcb_sched_dequeue_in_correct_ready_q[wp]:
+  "tcb_sched_action tcb_sched_dequeue t \<lbrace>in_correct_ready_q\<rbrace> "
+  unfolding tcb_sched_action_def set_tcb_queue_def
+  apply (wpsimp wp: thread_get_wp')
+  apply (clarsimp simp: in_correct_ready_q_def tcb_sched_dequeue_def)
+  done
+
+lemma tcb_sched_dequeue_ready_qs_distinct[wp]:
+  "tcb_sched_action tcb_sched_dequeue t \<lbrace>ready_qs_distinct\<rbrace> "
+  unfolding tcb_sched_action_def set_tcb_queue_def
+  apply (wpsimp wp: thread_get_wp')
+  apply (clarsimp simp: ready_qs_distinct_def tcb_sched_dequeue_def)
+  done
+
+\<comment> \<open>For updating the domain and the priority fields of a TCB that is not in a ready queue\<close>
+lemma threadSet_not_queued_corres:
+  "\<lbrakk>\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow> tcb_relation (f tcb) (F tcb');
+    \<And>tcb'. tcbSchedNext (F tcb') = tcbSchedNext tcb';
+    \<And>tcb'. tcbSchedPrev (F tcb') = tcbSchedPrev tcb';
+    \<And>tcb'. tcbQueued (F tcb') = tcbQueued tcb';
+    \<And>tcb. \<forall>(getF, v) \<in> ran tcb_cap_cases. getF (f tcb) = getF tcb;
+    \<And>tcb'. \<forall>(getF, v)\<in>ran tcb_cte_cases. getF (F tcb') = getF tcb'\<rbrakk>
+   \<Longrightarrow> corres dc (tcb_at t and not_queued t and pspace_aligned and pspace_distinct) \<top>
+         (thread_set f t) (threadSet F t)"
+  apply (rule_tac Q'="tcb_at' t" in corres_cross_add_guard)
+   apply (fastforce dest!: state_relationD elim!: tcb_at_cross)
+  apply (simp add: thread_set_def threadSet_def)
+  apply (rule corres_symb_exec_l[OF _ _ gets_the_sp]; wpsimp simp: tcb_at_def)
+  apply (rule corres_symb_exec_r[OF _ getObject_tcb_sp]; wpsimp?)
+  apply (rename_tac tcb tcb')
+  apply (rule stronger_corres_guard_imp)
+    apply (rule_tac F="\<not> tcbQueued tcb'" in corres_gen_asm)
+    apply (rule_tac tcb=tcb and tcb'=tcb' in setObject_update_TCB_corres';
+           fastforce simp: inQ_def)
+   apply (frule state_relation_ready_queues_relation)
+   apply (frule in_ready_q_tcbQueued_eq[where t=t])
+   apply (clarsimp simp: opt_pred_def opt_map_def obj_at'_def not_queued_def)
+  apply clarsimp
+  done
+
 lemma sp_corres2:
   "corres dc
-     (valid_etcbs and weak_valid_sched_action and cur_tcb and tcb_at t
+     (weak_valid_sched_action and cur_tcb and tcb_at t
       and valid_queues and pspace_aligned and pspace_distinct)
      (tcb_at' t and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
       and valid_objs' and (\<lambda>_. x \<le> maxPriority) and sym_heap_sched_pointers and valid_sched_pointers)
@@ -593,8 +647,9 @@ lemma sp_corres2:
   apply (simp add: setPriority_def set_priority_def thread_set_priority_def)
   apply (rule stronger_corres_guard_imp)
     apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
-      apply (rule corres_split[OF ethread_set_corres], simp_all)[1]
-         apply (simp add: etcb_relation_def)
+      apply (rule corres_split[OF threadSet_not_queued_corres];
+                           simp add: tcb_relation_def tcb_cap_cases_def tcb_cte_cases_def
+                                     cteSizeBits_def)
         apply (rule corres_split[OF isRunnable_corres])
           apply (erule corres_when)
           apply(rule corres_split[OF getCurThread_corres])
@@ -604,19 +659,19 @@ lemma sp_corres2:
            apply ((clarsimp
                    | wp hoare_weak_lift_imp hoare_vcg_if_lift hoare_wp_combs gts_wp
                         isRunnable_wp)+)[4]
-       apply (wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift
-                 ethread_set_not_queued_valid_queues
-              | strengthen valid_queues_in_correct_ready_q valid_queues_ready_qs_distinct)+
+       apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift
+                         thread_set_in_correct_ready_q_not_queued thread_set_no_change_tcb_state
+                         thread_set_no_change_tcb_state_converse thread_set_weak_valid_sched_action)+
       apply ((wp hoare_vcg_imp_lift' hoare_vcg_all_lift
                  isRunnable_wp threadSet_pred_tcb_no_state
                  threadSet_valid_objs_tcbPriority_update threadSet_sched_pointers
                  threadSet_valid_sched_pointers tcb_dequeue_not_queued tcbSchedDequeue_not_queued
                  threadSet_weak_sch_act_wf
-              | simp add: etcb_relation_def
+              | simp add: tcb_relation_def
               | strengthen valid_objs'_valid_tcbs'
                 obj_at'_weakenE[where P="Not \<circ> tcbQueued"]
               | wps)+)
-   apply (force simp: valid_etcbs_def tcb_at_st_tcb_at[symmetric] state_relation_def
+   apply (force simp: tcb_at_st_tcb_at[symmetric] state_relation_def
                 dest: pspace_relation_tcb_at intro: st_tcb_at_opeqI)
   apply clarsimp
   done
@@ -639,7 +694,7 @@ lemma setMCPriority_corres:
     apply (clarsimp simp: setMCPriority_def set_mcpriority_def)
     apply (rule threadset_corresT)
   by (clarsimp simp: tcb_relation_def tcb_cap_cases_tcb_mcpriority
-                     tcb_cte_cases_def cteSizeBits_def exst_same_def)+
+                     tcb_cte_cases_def cteSizeBits_def inQ_def)+
 
 definition
  "out_rel fn fn' v v' \<equiv>
@@ -653,8 +708,7 @@ lemma out_corresT:
   assumes y: "\<And>v. \<forall>tcb. \<forall>(getF, setF)\<in>ran tcb_cte_cases. getF (fn' v tcb) = getF tcb"
   assumes sched_pointers: "\<And>tcb v. tcbSchedPrev (fn' v tcb) = tcbSchedPrev tcb"
                           "\<And>tcb v. tcbSchedNext (fn' v tcb) = tcbSchedNext tcb"
-  assumes flag: "\<And>tcb v. tcbQueued (fn' v tcb) = tcbQueued tcb"
-  assumes e: "\<And>tcb v. exst_same tcb (fn' v tcb)"
+  assumes flag: "\<And>d p tcb' v. inQ d p (fn' v tcb') = inQ d p tcb'"
   shows
   "out_rel fn fn' v v' \<Longrightarrow>
      corres dc (tcb_at t and pspace_aligned and pspace_distinct)
@@ -662,7 +716,7 @@ lemma out_corresT:
        (option_update_thread t fn v)
        (case_option (return ()) (\<lambda>x. threadSet (fn' x) t) v')"
   apply (case_tac v, simp_all add: out_rel_def option_update_thread_def)
-  apply (clarsimp simp: threadset_corresT [OF _ x y sched_pointers flag e])
+  apply (clarsimp simp: threadset_corresT [OF _ x y sched_pointers flag])
   done
 
 lemmas out_corres = out_corresT [OF _ all_tcbI, OF ball_tcb_cap_casesI ball_tcb_cte_casesI]
@@ -990,14 +1044,14 @@ lemma thread_set_ipc_weak_valid_sched_action:
   apply (simp | intro impI | elim exE conjE)+
   apply (frule get_tcb_SomeD)
   apply (erule ssubst)
-  apply (clarsimp simp add: weak_valid_sched_action_def valid_etcbs_2_def st_tcb_at_kh_def
-              get_tcb_def obj_at_kh_def obj_at_def is_etcb_at'_def valid_sched_def valid_sched_action_def)
+  apply (clarsimp simp: weak_valid_sched_action_def st_tcb_at_kh_def obj_at_kh_def valid_sched_def
+                        valid_sched_action_def)
   done
 
 lemma threadcontrol_corres_helper3:
   "\<lbrace>einvs and simple_sched_action\<rbrace>
    check_cap_at cap p (check_cap_at (cap.ThreadCap cap') slot (cap_insert cap p (t, tcb_cnode_index 4)))
-   \<lbrace>\<lambda>_ s. weak_valid_sched_action s \<and> in_correct_ready_q s \<and> ready_qs_distinct s \<and> valid_etcbs s
+   \<lbrace>\<lambda>_ s. weak_valid_sched_action s \<and> in_correct_ready_q s \<and> ready_qs_distinct s
           \<and> pspace_aligned s \<and> pspace_distinct s\<rbrace>"
    apply (wpsimp
           | strengthen valid_sched_valid_queues valid_queues_in_correct_ready_q
@@ -1177,7 +1231,7 @@ proof -
                (option_map to_bl v))
                (case v of None \<Rightarrow> return ()
                  | Some x \<Rightarrow> threadSet (tcbFaultHandler_update (%_. x)) t)"
-    apply (rule out_corres, simp_all add: exst_same_def)
+    apply (rule out_corres, simp_all add: inQ_def)
     apply (case_tac v, simp_all add: out_rel_def)
     apply (safe, case_tac tcb', simp add: tcb_relation_def split: option.split)
     done
@@ -1187,7 +1241,7 @@ proof -
                (option_update_thread t (tcb_ipc_buffer_update o (%x _. x)) v)
                (case v of None \<Rightarrow> return ()
                  | Some x \<Rightarrow> threadSet (tcbIPCBuffer_update (%_. x)) t)"
-    apply (rule out_corres, simp_all add: exst_same_def)
+    apply (rule out_corres, simp_all )
     apply (case_tac v, simp_all add: out_rel_def)
     apply (safe, case_tac tcb', simp add: tcb_relation_def)
     done
@@ -1316,20 +1370,19 @@ proof -
             apply (rule cteDelete_corres)
            apply (rule_tac F="is_aligned aa msg_align_bits" in corres_gen_asm2)
            apply (rule corres_split_nor)
-              apply (rule threadset_corres,
-                      (simp add: tcb_relation_def), (simp add: exst_same_def)+)[1]
+              apply (rule threadset_corres; simp add: tcb_relation_def)
              apply (rule corres_split[OF getCurThread_corres], clarsimp)
                apply (rule corres_when[OF refl rescheduleRequired_corres])
               apply (wpsimp wp: gct_wp)+
             apply (strengthen valid_queues_ready_qs_distinct)
             apply (wpsimp wp: thread_set_ipc_weak_valid_sched_action thread_set_valid_queues
-                              hoare_drop_imp)
+                              hoare_drop_imp in_correct_ready_q_lift thread_set_etcbs)
            apply clarsimp
            apply (strengthen valid_objs'_valid_tcbs' invs_valid_objs')+
            apply (wpsimp wp: threadSet_sched_pointers threadSet_valid_sched_pointers hoare_drop_imp
                              threadSet_invs_tcbIPCBuffer_update)
           apply (clarsimp simp: pred_conj_def)
-          apply (strengthen einvs_valid_etcbs valid_queues_in_correct_ready_q
+          apply (strengthen valid_queues_in_correct_ready_q
                             valid_sched_valid_queues)+
           apply wp
          apply (clarsimp simp: pred_conj_def)
@@ -1345,8 +1398,7 @@ proof -
                         in corres_gen_asm)
           apply (rule_tac F="isArchObjectCap ac" in corres_gen_asm2)
           apply (rule corres_split_nor)
-             apply (rule threadset_corres,
-                    simp add: tcb_relation_def, (simp add: exst_same_def)+)
+             apply (rule threadset_corres; simp add: tcb_relation_def)
             apply (rule corres_split)
                apply (erule checkCapAt_cteInsert_corres)
               apply (rule corres_split[OF getCurThread_corres], clarsimp)
@@ -1724,7 +1776,7 @@ lemma invokeTCB_corres:
            apply (rule TcbAcc_R.rescheduleRequired_corres)
           apply (rule corres_trivial, simp)
          apply (wpsimp wp: hoare_drop_imp)+
-   apply (fastforce dest: valid_sched_valid_queues simp: valid_sched_weak_strg einvs_valid_etcbs)
+   apply (fastforce dest: valid_sched_valid_queues simp: valid_sched_weak_strg)
   apply fastforce
   done
 
@@ -1950,7 +2002,7 @@ lemma decodeSetPriority_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (pspace_aligned and pspace_distinct and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x))))
+       (cur_tcb and (pspace_aligned and pspace_distinct and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x))))
        (invs' and (\<lambda>s. \<forall>x \<in> set extras'. s \<turnstile>' (fst x)))
        (decode_set_priority args cap slot extras)
        (decodeSetPriority args cap' extras')"
@@ -1968,7 +2020,7 @@ lemma decodeSetMCPriority_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and (pspace_aligned and pspace_distinct and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x))))
+       (cur_tcb and (pspace_aligned and pspace_distinct and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x))))
        (invs' and (\<lambda>s. \<forall>x \<in> set extras'. s \<turnstile>' (fst x)))
        (decode_set_mcpriority args cap slot extras)
        (decodeSetMCPriority args cap' extras')"
@@ -2074,7 +2126,7 @@ lemma decodeSetSchedParams_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
      list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<rbrakk> \<Longrightarrow>
    corres (ser \<oplus> tcbinv_relation)
-       (cur_tcb and valid_etcbs and
+       (cur_tcb and
          (pspace_aligned and pspace_distinct and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x))))
        (invs' and (\<lambda>s. \<forall>x \<in> set extras'. s \<turnstile>' (fst x)))
        (decode_set_sched_params args cap slot extras)
diff --git a/proof/refine/AARCH64/Untyped_R.thy b/proof/refine/AARCH64/Untyped_R.thy
index d9966e08cf..157a14ec38 100644
--- a/proof/refine/AARCH64/Untyped_R.thy
+++ b/proof/refine/AARCH64/Untyped_R.thy
@@ -1316,7 +1316,7 @@ lemma in_getCTE2:
 declare wrap_ext_op_det_ext_ext_def[simp]
 
 lemma do_ext_op_update_cdt_list_symb_exec_l':
-  "corres_underlying {(s::det_state, s'). f (kheap s) (ekheap s) s'} nf nf' dc P P' (create_cap_ext p z a) (return x)"
+  "corres_underlying {(s::det_state, s'). f (kheap s) s'} nf nf' dc P P' (create_cap_ext p z a) (return x)"
   apply (simp add: corres_underlying_def create_cap_ext_def
   update_cdt_list_def set_cdt_list_def bind_def put_def get_def gets_def return_def)
   done
@@ -1357,15 +1357,14 @@ lemma set_cdt_symb_exec_l:
   "corres_underlying {(s, s'). f (kheap s) (exst s) s'} nf nf' dc P P' (set_cdt g) (return x)"
   by (simp add: corres_underlying_def return_def set_cdt_def in_monad Bex_def)
 
-crunch create_cap_ext
-  for domain_index[wp]: "\<lambda>s. P (domain_index s)"
 crunch create_cap_ext
   for work_units_completed[wp]: "\<lambda>s. P (work_units_completed s)"
+  (ignore_del: create_cap_ext)
 
 context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma updateNewFreeIndex_noop_psp_corres:
-  "corres_underlying {(s, s'). pspace_relations (ekheap s) (kheap s) (ksPSpace s')} False True
+  "corres_underlying {(s, s'). pspace_relation (kheap s) (ksPSpace s')} False True
     dc \<top> (cte_at' slot)
     (return ()) (updateNewFreeIndex slot)"
   apply (simp add: updateNewFreeIndex_def)
@@ -1377,6 +1376,10 @@ lemma updateNewFreeIndex_noop_psp_corres:
         | simp add: updateTrackedFreeIndex_def getSlotCap_def)+
   done
 
+crunch set_cap, set_cdt
+  for domain_index[wp]: "\<lambda>s. P (domain_index s)"
+  (wp: crunch_wps)
+
 crunch updateMDB, updateNewFreeIndex, setCTE
   for rdyq_projs[wp]:
     "\<lambda>s. P (ksReadyQueues s) (tcbSchedNexts_of s) (tcbSchedPrevs_of s) (\<lambda>d p. inQ d p |< tcbs_of' s)"
@@ -2981,35 +2984,31 @@ lemma createNewCaps_range_helper:
   apply (frule range_cover.range_cover_n_less)
   apply (frule range_cover.unat_of_nat_n)
   apply (cases tp, simp_all split del: if_split)
-          apply (rename_tac apiobject_type)
-          apply (case_tac apiobject_type, simp_all split del: if_split)
-              apply (rule hoare_pre, wp)
-              apply (frule range_cover_not_zero[rotated -1],simp)
-              apply (clarsimp simp: APIType_capBits_def objBits_simps ptr_add_def o_def)
-              apply (subst upto_enum_red')
-               apply unat_arith
-              apply (clarsimp simp: o_def fromIntegral_def toInteger_nat fromInteger_nat)
-              apply fastforce
-             apply (rule hoare_pre,wp createObjects_ret2)
-             apply (clarsimp simp: APIType_capBits_def word_bits_def bit_simps
-                                   objBits_simps ptr_add_def o_def)
-             apply (fastforce simp: objBitsKO_def objBits_def)
-            apply (rule hoare_pre,wp createObjects_ret2)
-            apply (clarsimp simp: APIType_capBits_def word_bits_def
-                                  objBits_simps ptr_add_def o_def)
-            apply (fastforce simp: objBitsKO_def  objBits_def)
-           apply (rule hoare_pre,wp createObjects_ret2)
-           apply (clarsimp simp:  APIType_capBits_def word_bits_def objBits_simps ptr_add_def o_def)
-           apply (fastforce simp: objBitsKO_def  objBits_def)
-          apply (rule hoare_pre,wp createObjects_ret2)
-          apply (clarsimp simp: APIType_capBits_def word_bits_def objBits_simps ptr_add_def o_def)
-          apply (fastforce simp: objBitsKO_def  objBits_def)
-        apply (wp createObjects_ret2
-                | clarsimp simp: APIType_capBits_def objBits_if_dev archObjSize_def word_bits_def
-                           split del: if_split
-                | simp add: objBits_simps
-                | (rule exI, (fastforce simp: bit_simps)))+
-  done
+        apply (rename_tac apiobject_type)
+        apply (case_tac apiobject_type, simp_all split del: if_split)
+            \<comment>\<open>Untyped\<close>
+            apply (rule hoare_pre, wp)
+            apply (frule range_cover_not_zero[rotated -1],simp)
+            apply (clarsimp simp: APIType_capBits_def objBits_simps ptr_add_def o_def)
+            apply (subst upto_enum_red')
+             apply unat_arith
+            apply (clarsimp simp: o_def fromIntegral_def toInteger_nat fromInteger_nat)
+            apply fastforce
+           \<comment>\<open>TCB\<close>
+           apply (rule hoare_pre, wp createObjects_ret2)
+            apply (wpsimp simp: curDomain_def)
+           apply (clarsimp simp: APIType_capBits_def word_bits_def objBits_simps ptr_add_def o_def)
+           apply (fastforce simp: objBitsKO_def objBits_def)
+           \<comment>\<open>other APIObjectType\<close>
+          apply ((rule hoare_pre, wp createObjects_ret2,
+                  clarsimp simp: APIType_capBits_def word_bits_def objBits_simps ptr_add_def o_def,
+                  fastforce simp: objBitsKO_def objBits_def)+)[3]
+       \<comment>\<open>Arch objects\<close>
+       by (wp createObjects_ret2
+           | clarsimp simp: APIType_capBits_def objBits_if_dev word_bits_def
+                 split del: if_split
+           | simp add: objBits_simps
+           | (rule exI, (fastforce simp: bit_simps)))+
 
 lemma createNewCaps_range_helper2:
   "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n\<rbrace>
@@ -4037,9 +4036,6 @@ end
 
 context begin interpretation Arch . (*FIXME: arch-split*)
 
-lemma valid_sched_etcbs[elim!]: "valid_sched_2 queues ekh sa cdom kh ct it \<Longrightarrow> valid_etcbs_2 ekh kh"
-  by (simp add: valid_sched_def)
-
 crunch deleteObjects
   for ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
   (simp: crunch_simps wp: hoare_drop_imps unless_wp)
@@ -4996,7 +4992,7 @@ lemma inv_untyped_corres':
                 invs_distinct)
          apply (clarsimp simp:conj_comms ball_conj_distrib ex_in_conv)
          apply ((rule validE_R_validE)?,
-          rule_tac Q'="\<lambda>_ s. valid_etcbs s \<and> valid_list s \<and> invs s \<and> ct_active s
+          rule_tac Q'="\<lambda>_ s. valid_list s \<and> invs s \<and> ct_active s
           \<and> valid_untyped_inv_wcap ui
             (Some (cap.UntypedCap dev (ptr && ~~ mask sz) sz (if reset then 0 else idx))) s
           \<and> (reset \<longrightarrow> pspace_no_overlap {ptr && ~~ mask sz..(ptr && ~~ mask sz) + 2 ^ sz - 1} s)
@@ -5084,7 +5080,7 @@ lemma inv_untyped_corres':
       apply (clarsimp simp only: pred_conj_def invs ui)
       apply (strengthen vui)
       apply (cut_tac vui invs invs')
-      apply (clarsimp simp: cte_wp_at_caps_of_state valid_sched_etcbs schact_is_rct_def)
+      apply (clarsimp simp: cte_wp_at_caps_of_state schact_is_rct_def)
      apply (cut_tac vui' invs')
      apply (clarsimp simp: ui cte_wp_at_ctes_of if_apply_def2 ui')
      done
diff --git a/proof/refine/AARCH64/VSpace_R.thy b/proof/refine/AARCH64/VSpace_R.thy
index 5d955a122c..08130a0f10 100644
--- a/proof/refine/AARCH64/VSpace_R.thy
+++ b/proof/refine/AARCH64/VSpace_R.thy
@@ -350,11 +350,10 @@ lemma setObject_VCPU_corres:
   apply (simp add: set_vcpu_def)
   apply (rule corres_guard_imp)
     apply (rule setObject_other_corres [where P="\<lambda>ko::vcpu. True"], simp)
-         apply (clarsimp simp: obj_at'_def)
-         apply (erule map_to_ctes_upd_other, simp, simp)
-        apply (simp add: a_type_def is_other_obj_relation_type_def)
-       apply (simp add: objBits_simps)
-      apply simp
+        apply (clarsimp simp: obj_at'_def)
+        apply (erule map_to_ctes_upd_other, simp, simp)
+       apply (simp add: a_type_def is_other_obj_relation_type_def)
+      apply (simp add: objBits_simps)
      apply (simp add: objBits_simps vcpuBits_def pageBits_def)
     apply (simp add: other_obj_relation_def asid_pool_relation_def)
    apply (clarsimp simp: typ_at_to_obj_at'[symmetric] obj_at_def exs_valid_def
diff --git a/proof/refine/Move_R.thy b/proof/refine/Move_R.thy
index 5fe79b1b0a..543c1392ed 100644
--- a/proof/refine/Move_R.thy
+++ b/proof/refine/Move_R.thy
@@ -250,10 +250,4 @@ lemma check_active_irq_invs_just_idle:
         and (\<lambda>s. 0 < domain_time s) and valid_domain_list \<rbrace>"
   by (wpsimp simp: check_active_irq_def ct_in_state_def)
 
-lemma caps_of_state_kheap_ekheap[simp]:
-  "caps_of_state (kheap_update f (ekheap_update ef s))
-     = caps_of_state (kheap_update f s)"
-  apply (simp add: trans_state_update[symmetric] del: trans_state_update)
-  done
-
 end

From 5f1e4113ad2cf2396f4426cb3461ecacd233e790 Mon Sep 17 00:00:00 2001
From: Corey Lewis <corey.lewis@proofcraft.systems>
Date: Wed, 13 Nov 2024 19:07:32 +1100
Subject: [PATCH 7/7] aarch64 crefine: proof update for det_ext refactor

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
---
 proof/crefine/AARCH64/Arch_C.thy   |  2 +-
 proof/crefine/AARCH64/Refine_C.thy | 15 +++--
 proof/crefine/AARCH64/Retype_C.thy | 90 +++++++++++++++++-------------
 3 files changed, 58 insertions(+), 49 deletions(-)

diff --git a/proof/crefine/AARCH64/Arch_C.thy b/proof/crefine/AARCH64/Arch_C.thy
index 8b7b1c02da..a63584fa3d 100644
--- a/proof/crefine/AARCH64/Arch_C.thy
+++ b/proof/crefine/AARCH64/Arch_C.thy
@@ -323,7 +323,7 @@ proof -
      simplified, OF empty[folded szko] szo[symmetric], unfolded szko]
 
   have szb: "pageBits < word_bits" by simp
-  have mko: "\<And>dev. makeObjectKO dev (Inl (KOArch (KOASIDPool f))) = Some ko"
+  have mko: "\<And>dev d f. makeObjectKO dev d (Inl (KOArch (KOASIDPool f))) = Some ko"
     by (simp add: ko_def makeObjectKO_def)
 
 
diff --git a/proof/crefine/AARCH64/Refine_C.thy b/proof/crefine/AARCH64/Refine_C.thy
index aadd023227..5ee758dc91 100644
--- a/proof/crefine/AARCH64/Refine_C.thy
+++ b/proof/crefine/AARCH64/Refine_C.thy
@@ -876,18 +876,17 @@ lemma threadSet_all_invs_triv':
   unfolding all_invs'_def
   apply (rule hoare_pre)
    apply (rule wp_from_corres_unit)
-     apply (rule threadset_corresT [where f="tcb_arch_update (arch_tcb_context_set f)"])
+      apply (rule threadset_corresT [where f="tcb_arch_update (arch_tcb_context_set f)"]; simp?)
         apply (simp add: tcb_relation_def arch_tcb_context_set_def
                          atcbContextSet_def arch_tcb_relation_def)
        apply (simp add: tcb_cap_cases_def)
       apply (simp add: tcb_cte_cases_def cteSizeBits_def)
-     apply (simp add: exst_same_def)
-    apply (wp thread_set_invs_trivial thread_set_ct_running thread_set_not_state_valid_sched
-              threadSet_invs_trivial threadSet_ct_running' hoare_weak_lift_imp
-              thread_set_ct_in_state
-           | simp add: tcb_cap_cases_def tcb_arch_ref_def exst_same_def
-           | rule threadSet_ct_in_state'
-           | wp (once) hoare_vcg_disj_lift)+
+     apply (wp thread_set_invs_trivial thread_set_not_state_valid_sched
+               threadSet_invs_trivial threadSet_ct_running' hoare_weak_lift_imp
+               thread_set_ct_in_state
+            | simp add: tcb_cap_cases_def tcb_arch_ref_def
+            | rule threadSet_ct_in_state'
+            | wp (once) hoare_vcg_disj_lift)+
   apply clarsimp
   apply (rename_tac s s')
   apply (rule exI, rule conjI, assumption)
diff --git a/proof/crefine/AARCH64/Retype_C.thy b/proof/crefine/AARCH64/Retype_C.thy
index 0916051c60..d533fb7c6b 100644
--- a/proof/crefine/AARCH64/Retype_C.thy
+++ b/proof/crefine/AARCH64/Retype_C.thy
@@ -1201,7 +1201,7 @@ lemma retype_ctes_helper:
   and      al: "is_aligned ptr (objBitsKO ko)"
   and      sz: "objBitsKO ko \<le> sz"
   and     szb: "sz < word_bits"
-  and     mko: "makeObjectKO dev tp' = Some ko"
+  and     mko: "makeObjectKO dev d tp' = Some ko"
   and      rc: "range_cover ptr sz (objBitsKO ko) n"
   shows  "map_to_ctes (\<lambda>xa. if xa \<in> set (new_cap_addrs n ptr ko) then Some ko else ksPSpace s xa) =
    (\<lambda>x. if tp' = Inr (APIObjectType ArchTypes_H.apiobject_type.CapTableObject) \<and> x \<in> set (new_cap_addrs n ptr ko) \<or>
@@ -1482,7 +1482,7 @@ proof (intro impI allI)
     by (clarsimp simp:range_cover_def[where 'a=machine_word_len, folded word_bits_def])+
 
   (* obj specific *)
-  have mko: "\<And>dev. makeObjectKO dev (Inr (APIObjectType ArchTypes_H.apiobject_type.EndpointObject)) = Some ko"
+  have mko: "\<And>dev d. makeObjectKO dev d (Inr (APIObjectType ArchTypes_H.apiobject_type.EndpointObject)) = Some ko"
     by (simp add: ko_def makeObjectKO_def)
 
   have relrl:
@@ -1596,7 +1596,7 @@ proof (intro impI allI)
     by (clarsimp simp:range_cover_def[where 'a=machine_word_len, folded word_bits_def])+
 
   (* obj specific *)
-  have mko: "\<And> dev. makeObjectKO dev (Inr (APIObjectType ArchTypes_H.apiobject_type.NotificationObject)) = Some ko" by (simp add: ko_def makeObjectKO_def)
+  have mko: "\<And> dev d. makeObjectKO dev d (Inr (APIObjectType ArchTypes_H.apiobject_type.NotificationObject)) = Some ko" by (simp add: ko_def makeObjectKO_def)
 
   have relrl:
     "cnotification_relation (cslift x) makeObject (from_bytes (replicate (size_of TYPE(notification_C)) 0))"
@@ -1748,7 +1748,7 @@ proof (intro impI allI)
     by (clarsimp simp:range_cover_def[where 'a=machine_word_len, folded word_bits_def])+
 
   (* obj specific *)
-  have mko: "\<And>dev. makeObjectKO dev (Inr (APIObjectType  ArchTypes_H.apiobject_type.CapTableObject)) = Some ko"
+  have mko: "\<And>dev d. makeObjectKO dev d (Inr (APIObjectType  ArchTypes_H.apiobject_type.CapTableObject)) = Some ko"
     by (simp add: ko_def makeObjectKO_def)
 
   note relrl = ccte_relation_makeObject
@@ -1988,7 +1988,7 @@ proof (intro impI allI)
           Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
 
   (* obj specific *)
-  have mko: "\<And>dev. makeObjectKO dev (Inr AARCH64_H.PageTableObject) = Some ko"
+  have mko: "\<And>dev d. makeObjectKO dev d (Inr AARCH64_H.PageTableObject) = Some ko"
     by (simp add: ko_def makeObjectKO_def)
 
   have relrl:
@@ -2157,7 +2157,7 @@ proof (intro impI allI)
           Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
 
   (* obj specific *)
-  have mko: "\<And>dev. makeObjectKO dev (Inr AARCH64_H.PageTableObject) = Some ko"
+  have mko: "\<And>dev d. makeObjectKO dev d (Inr AARCH64_H.PageTableObject) = Some ko"
     by (simp add: ko_def makeObjectKO_def)
 
   have relrl:
@@ -3114,7 +3114,8 @@ end
 
 lemma cnc_tcb_helper:
   fixes p :: "tcb_C ptr"
-  defines "kotcb \<equiv> (KOTCB (makeObject :: tcb))"
+    and d :: domain
+  defines "kotcb \<equiv> KOTCB (tcbDomain_update (\<lambda>_. d) (makeObject :: tcb))"
   assumes rfsr: "(\<sigma>\<lparr>ksPSpace := ks\<rparr>, x) \<in> rf_sr"
   assumes al: "is_aligned (ctcb_ptr_to_tcb_ptr p) (objBitsKO kotcb)"
   assumes ptr0: "ctcb_ptr_to_tcb_ptr p \<noteq> 0"
@@ -3127,6 +3128,7 @@ lemma cnc_tcb_helper:
   assumes empty: "region_is_bytes (ctcb_ptr_to_tcb_ptr p) (2 ^ tcbBlockSizeBits) x"
   assumes rep0: "heap_list (fst (t_hrs_' (globals x))) (2 ^ tcbBlockSizeBits) (ctcb_ptr_to_tcb_ptr p) = replicate (2 ^ tcbBlockSizeBits) 0"
   assumes kdr: "{ctcb_ptr_to_tcb_ptr p..+2 ^ tcbBlockSizeBits} \<inter> kernel_data_refs = {}"
+  assumes domrel: "ucast d = d'"
   shows "(\<sigma>\<lparr>ksPSpace := ks(ctcb_ptr_to_tcb_ptr p \<mapsto> kotcb)\<rparr>,
             globals_update
               (t_hrs_'_update
@@ -3135,7 +3137,8 @@ lemma cnc_tcb_helper:
                                      [heap_update (registers_of_tcb_Ptr p)
                                                   (array_updates (h_val (hrs_mem hrs) (registers_of_tcb_Ptr p))
                                                                  initContext_registers),
-                                      heap_update (machine_word_Ptr &(p\<rightarrow>[''tcbTimeSlice_C''])) 5])
+                                      heap_update (machine_word_Ptr &(p\<rightarrow>[''tcbTimeSlice_C''])) 5,
+                                      heap_update (machine_word_Ptr &(p\<rightarrow>[''tcbDomain_C''])) (d' :: machine_word)])
                        )) x)
            \<in> rf_sr"
   (is "(\<sigma>\<lparr>ksPSpace := ?ks\<rparr>, globals_update ?gs' x) \<in> rf_sr")
@@ -3307,7 +3310,8 @@ proof -
                          \<lparr>registers_C := array_updates (registers_C (tcbContext_C ?tcbArch_C))
                                                        initContext_registers
                             \<rparr>\<rparr>,
-                        tcbTimeSlice_C := 5\<rparr>)"
+                        tcbTimeSlice_C := 5,
+                        tcbDomain_C := d'\<rparr>)"
 
   have tdisj':
     "\<And>y. hrs_htd (t_hrs_' (globals x)) \<Turnstile>\<^sub>t y \<Longrightarrow> ptr_span p \<inter> ptr_span y \<noteq> {} \<Longrightarrow> y = p"
@@ -3358,7 +3362,7 @@ proof -
 
   have rl:
     "(\<forall>v :: 'a :: pre_storable. projectKO_opt kotcb \<noteq> Some v) \<Longrightarrow>
-    (projectKO_opt \<circ>\<^sub>m (ks(ctcb_ptr_to_tcb_ptr p \<mapsto> KOTCB makeObject)) :: machine_word \<Rightarrow> 'a option)
+    (projectKO_opt \<circ>\<^sub>m (ks(ctcb_ptr_to_tcb_ptr p \<mapsto> KOTCB (tcbDomain_update (\<lambda>_. d) makeObject))) :: machine_word \<Rightarrow> 'a option)
     = projectKO_opt \<circ>\<^sub>m ks" using pno al
     apply -
     apply (drule(2) projectKO_opt_retyp_other'[OF _ _ pal])
@@ -3371,8 +3375,9 @@ proof -
     apply (clarsimp simp: projectKOs map_comp_def split: if_split)
     done
 
-  have mko: "\<And>dev. makeObjectKO dev (Inr (APIObjectType ArchTypes_H.apiobject_type.TCBObject)) = Some kotcb"
+  have mko: "\<And>dev. makeObjectKO dev d (Inr (APIObjectType ArchTypes_H.apiobject_type.TCBObject)) = Some kotcb"
     by (simp add: makeObjectKO_def kotcb_def)
+
   note hacky_cte = retype_ctes_helper [where sz = "objBitsKO kotcb" and ko = kotcb and ptr = "ctcb_ptr_to_tcb_ptr p",
     OF pal pds pno al _ _ mko, simplified new_cap_addrs_def, simplified]
 
@@ -3413,7 +3418,7 @@ proof -
       done
   qed
 
-  ultimately have rl_cte: "(map_to_ctes (ks(ctcb_ptr_to_tcb_ptr p \<mapsto> KOTCB makeObject)) :: machine_word \<Rightarrow> cte option)
+  ultimately have rl_cte: "(map_to_ctes (ks(ctcb_ptr_to_tcb_ptr p \<mapsto> KOTCB (tcbDomain_update (\<lambda>_. d) makeObject))) :: machine_word \<Rightarrow> cte option)
     = (\<lambda>x. if x \<in> ptr_val ` (CTypesDefs.ptr_add (cte_Ptr (ctcb_ptr_to_tcb_ptr p)) \<circ> of_nat) ` {k. k < 5}
          then Some (CTE NullCap nullMDBNode)
          else map_to_ctes ks x)"
@@ -3483,19 +3488,20 @@ proof -
     done
 
   have tcb_rel:
-    "ctcb_relation makeObject ?new_tcb"
+    "ctcb_relation (tcbDomain_update (\<lambda>_. d) makeObject) ?new_tcb"
     unfolding ctcb_relation_def makeObject_tcb heap_updates_defs initContext_registers_def
     apply (simp add: fbtcb minBound_word)
     apply (intro conjI)
-         apply (simp add: cthread_state_relation_def thread_state_lift_def
-                          eval_nat_numeral ThreadState_defs)
-        apply (clarsimp simp: ccontext_relation_def newContext_def2 carch_tcb_relation_def
-                              newArchTCB_def fpu_relation_def cregs_relation_def atcbContextGet_def
-                              index_foldr_update)
-        apply (case_tac r; simp add: C_register_defs index_foldr_update
-                                     atcbContext_def newArchTCB_def newContext_def
-                                     initContext_def)
-       apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
+          apply (simp add: cthread_state_relation_def thread_state_lift_def
+                           eval_nat_numeral ThreadState_defs)
+         apply (clarsimp simp: ccontext_relation_def newContext_def2 carch_tcb_relation_def
+                               newArchTCB_def fpu_relation_def cregs_relation_def atcbContextGet_def
+                               index_foldr_update)
+         apply (case_tac r; simp add: C_register_defs index_foldr_update
+                                      atcbContext_def newArchTCB_def newContext_def
+                                      initContext_def)
+        apply (simp add: thread_state_lift_def index_foldr_update atcbContextGet_def)
+       apply (fastforce intro: domrel)
       apply (simp add: Kernel_Config.timeSlice_def)
      apply (simp add: cfault_rel_def seL4_Fault_lift_def seL4_Fault_get_tag_def Let_def
                       lookup_fault_lift_def lookup_fault_get_tag_def lookup_fault_invalid_root_def
@@ -3628,6 +3634,7 @@ proof -
      apply (erule cmap_relation_retype2)
      apply (simp add:ccte_relation_nullCap nullMDBNode_def nullPointer_def)
     \<comment> \<open>tcb\<close>
+     apply (clarsimp simp: map_comp_update)
      apply (erule cmap_relation_updI2 [where dest = "ctcb_ptr_to_tcb_ptr p" and f = "tcb_ptr_to_ctcb_ptr", simplified])
      apply (rule map_comp_simps)
      apply (rule pks)
@@ -4137,7 +4144,7 @@ proof (intro impI allI)
     by (clarsimp dest!: is_aligned_weaken range_cover.aligned)
 
   (* This is a hack *)
-  have mko: "\<And>dev. makeObjectKO False (Inr object_type.SmallPageObject) = Some ko"
+  have mko: "\<And>dev d. makeObjectKO False d (Inr object_type.SmallPageObject) = Some ko"
     by (simp add: makeObjectKO_def ko_def)
 
   from sz have "3 \<le> sz" by (simp add: objBits_simps pageBits_def ko_def)
@@ -4694,16 +4701,22 @@ lemma ccorres_placeNewObject_tcb:
       and ret_zero regionBase (2 ^ tcbBlockSizeBits)
       and K (regionBase \<noteq> 0 \<and> range_cover regionBase tcbBlockSizeBits tcbBlockSizeBits 1
       \<and>  {regionBase..+2^tcbBlockSizeBits} \<inter> kernel_data_refs = {}))
-   ({s. region_actually_is_zero_bytes regionBase (2^tcbBlockSizeBits) s})
-    hs
-   (placeNewObject regionBase (makeObject :: tcb) 0)
+   ({s. region_actually_is_zero_bytes regionBase (2^tcbBlockSizeBits) s
+        \<and> ksCurDomain_' (globals s) = ucast d}) hs
+   (placeNewObject regionBase (tcbDomain_update (\<lambda>_. d) makeObject) 0)
    (\<acute>tcb :== tcb_Ptr (regionBase + 0x400);;
         (global_htd_update (\<lambda>s. ptr_retyp (Ptr (ptr_val (tcb_' s) - ctcb_offset) :: (cte_C[5]) ptr)
             \<circ> ptr_retyp (tcb_' s)));;
         (Guard C_Guard \<lbrace>hrs_htd \<acute>t_hrs \<Turnstile>\<^sub>t \<acute>tcb\<rbrace>
-           (call (\<lambda>s. s\<lparr>context_' := Ptr &((Ptr &(tcb_' s\<rightarrow>[''tcbArch_C'']) :: arch_tcb_C ptr)\<rightarrow>[''tcbContext_C''])\<rparr>) Arch_initContext_'proc (\<lambda>s t. s\<lparr>globals := globals t\<rparr>) (\<lambda>s' s''. Basic (\<lambda>s. s))));;
+           (call (\<lambda>s. s\<lparr>context_' := Ptr &((Ptr &(tcb_' s\<rightarrow>[''tcbArch_C'']) :: arch_tcb_C ptr)\<rightarrow>[''tcbContext_C''])\<rparr>)
+                 Arch_initContext_'proc (\<lambda>s t. s\<lparr>globals := globals t\<rparr>) (\<lambda>s' s''. Basic (\<lambda>s. s))));;
         (Guard C_Guard \<lbrace>hrs_htd \<acute>t_hrs \<Turnstile>\<^sub>t \<acute>tcb\<rbrace>
-           (Basic (\<lambda>s. globals_update (t_hrs_'_update (hrs_mem_update (heap_update (Ptr &((tcb_' s)\<rightarrow>[''tcbTimeSlice_C''])) (5::machine_word)))) s))))"
+           (Basic (\<lambda>s. globals_update (t_hrs_'_update (hrs_mem_update (heap_update (Ptr &((tcb_' s)\<rightarrow>[''tcbTimeSlice_C''])) (5::machine_word)))) s)));;
+        (Guard C_Guard {s. s \<Turnstile>\<^sub>c tcb_' s}
+          (Basic (\<lambda>s. globals_update
+                       (t_hrs_'_update
+                        (hrs_mem_update (heap_update (Ptr &(tcb_' s\<rightarrow>[''tcbDomain_C'']))
+                                        (ksCurDomain_' (globals s) :: machine_word)))) s))))"
 proof -
   let ?offs = "0x400" \<comment> \<open>2 ^ (tcbBlockSizeBits - 1)\<close>
 
@@ -4743,6 +4756,7 @@ proof -
          clarsimp simp: hrs_htd_update word_bits_def no_fail_def objBitsKO_def
                         range_cover.aligned new_cap_addrs_def tcbBlockSizeBits_def)
   apply (cut_tac \<sigma>=\<sigma> and x=x and ks="ksPSpace \<sigma>" and p="tcb_Ptr (regionBase + ctcb_offset)"
+             and d=d and d'="ucast d"
            in cnc_tcb_helper;
          clarsimp simp: ctcb_ptr_to_tcb_ptr_def objBitsKO_def range_cover.aligned tcbBlockSizeBits_def)
     apply (frule region_actually_is_bytes; clarsimp simp: region_is_bytes'_def)
@@ -4902,7 +4916,7 @@ proof (intro impI allI)
       by (simp add:word_bits_def objBits_simps ko_def pageBits_def)
 
   (* This is a hack *)
-  have mko: "\<And>dev. makeObjectKO True (Inr object_type.SmallPageObject) = Some ko"
+  have mko: "\<And>dev d. makeObjectKO True d (Inr object_type.SmallPageObject) = Some ko"
     by (simp add: makeObjectKO_def ko_def)
 
   from sz have "3 \<le> sz" by (simp add: objBits_simps pageBits_def ko_def)
@@ -6354,18 +6368,14 @@ proof -
           apply (rule ccorres_symb_exec_r)
             apply (ccorres_remove_UNIV_guard)
             apply (simp add: hrs_htd_update)
-            apply (ctac (c_lines 4) add: ccorres_placeNewObject_tcb[simplified])
+            apply (rule ccorres_pre_curDomain)
+            apply (ctac (c_lines 5) add: ccorres_placeNewObject_tcb[simplified])
               apply simp
-              apply (rule ccorres_pre_curDomain)
-              apply ctac
-                apply (rule ccorres_symb_exec_r)
-                  apply (rule ccorres_return_C, simp, simp, simp)
-                 apply vcg
-                apply (rule conseqPre, vcg, clarsimp)
-               apply wp
-              apply vcg
-             apply (simp add: obj_at'_real_def)
-             apply (wp placeNewObject_ko_wp_at')
+              apply (rule ccorres_symb_exec_r)
+                apply (rule ccorres_return_C, simp, simp, simp)
+               apply vcg
+              apply (rule conseqPre, vcg, clarsimp)
+             apply wp
             apply (vcg exspec=Arch_initContext_modifies)
            apply clarsimp
            apply vcg