diff --git a/proof/refine/ARM/ADT_H.thy b/proof/refine/ARM/ADT_H.thy
index e73d29034d..1d3060c9db 100644
--- a/proof/refine/ARM/ADT_H.thy
+++ b/proof/refine/ARM/ADT_H.thy
@@ -12,11 +12,6 @@ imports
   Syscall_R
 begin
 
-(* FIXME: many of the naming conventions in this file are wrong. Definitions should start with
-          lower case letters, and should be under_score, not camelCase. Some, possibly many of
-          the functions here can benefit from projections that have been developed since this
-          was originally written *)
-
 text \<open>
   The general refinement calculus (see theory Simulation) requires
   the definition of a so-called ``abstract datatype'' for each refinement layer.
@@ -33,7 +28,7 @@ consts
   initBootFrames :: "word32 list"
   initDataStart :: word32
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 text \<open>
   The construction of the abstract data type
@@ -284,13 +279,12 @@ definition
                    | Structures_H.RecvEP q \<Rightarrow> Structures_A.RecvEP q"
 
 definition
-  "NtfnMap ntfn \<equiv>
+  "AEndpointMap ntfn \<equiv>
       \<lparr> ntfn_obj = case ntfnObj ntfn of
                        Structures_H.IdleNtfn \<Rightarrow> Structures_A.IdleNtfn
                      | Structures_H.WaitingNtfn q \<Rightarrow> Structures_A.WaitingNtfn q
                      | Structures_H.ActiveNtfn b \<Rightarrow> Structures_A.ActiveNtfn b
-      , ntfn_bound_tcb = ntfnBoundTCB ntfn
-      , ntfn_sc = ntfnSc ntfn \<rparr>"
+      , ntfn_bound_tcb = ntfnBoundTCB ntfn \<rparr>"
 
 fun
   CapabilityMap :: "capability \<Rightarrow> cap"
@@ -306,10 +300,8 @@ fun
    cap.CNodeCap ref n (bin_to_bl l (uint L))"
 | "CapabilityMap (capability.ThreadCap ref) = cap.ThreadCap ref"
 | "CapabilityMap capability.DomainCap = cap.DomainCap"
-| "CapabilityMap (capability.ReplyCap ref gr) =
-   cap.ReplyCap ref {x. gr \<and> x = AllowGrant \<or> x = AllowWrite}"
-| "CapabilityMap (SchedContextCap sc n) = cap.SchedContextCap sc (n - min_sched_context_bits)"
-| "CapabilityMap SchedControlCap = cap.SchedControlCap"
+| "CapabilityMap (capability.ReplyCap ref master gr) =
+   cap.ReplyCap ref master {x. gr \<and> x = AllowGrant \<or> x = AllowWrite}"
 | "CapabilityMap capability.IRQControlCap = cap.IRQControlCap"
 | "CapabilityMap (capability.IRQHandlerCap irq) = cap.IRQHandlerCap irq"
 | "CapabilityMap (capability.Zombie p b n) =
@@ -357,10 +349,10 @@ where
               Structures_A.thread_state.Inactive"
 | "ThStateMap Structures_H.thread_state.IdleThreadState =
               Structures_A.thread_state.IdleThreadState"
-| "ThStateMap (Structures_H.thread_state.BlockedOnReply r) =
-              Structures_A.thread_state.BlockedOnReply (the r)"
-| "ThStateMap (Structures_H.thread_state.BlockedOnReceive oref grant r) =
-              Structures_A.thread_state.BlockedOnReceive oref r \<lparr> receiver_can_grant = grant \<rparr>"
+| "ThStateMap Structures_H.thread_state.BlockedOnReply =
+              Structures_A.thread_state.BlockedOnReply"
+| "ThStateMap (Structures_H.thread_state.BlockedOnReceive oref grant) =
+              Structures_A.thread_state.BlockedOnReceive oref \<lparr> receiver_can_grant = grant \<rparr>"
 | "ThStateMap (Structures_H.thread_state.BlockedOnSend oref badge grant grant_reply call) =
               Structures_A.thread_state.BlockedOnSend oref
                 \<lparr> sender_badge = badge,
@@ -404,8 +396,6 @@ primrec
 where
   "FaultMap (Fault_H.fault.CapFault ref b failure) =
      ExceptionTypes_A.fault.CapFault ref b (LookupFailureMap failure)"
-| "FaultMap (Fault_H.fault.Timeout b) =
-     ExceptionTypes_A.fault.Timeout b"
 | "FaultMap (Fault_H.fault.ArchFault fault) =
      ExceptionTypes_A.fault.ArchFault (ArchFaultMap fault)"
 | "FaultMap (Fault_H.fault.UnknownSyscallException n) =
@@ -418,7 +408,7 @@ lemma ArchFaultMap_arch_fault_map: "ArchFaultMap (arch_fault_map f) = f"
 
 lemma FaultMap_fault_map[simp]:
   "valid_fault ft \<Longrightarrow> FaultMap (fault_map ft) = ft"
-  apply (case_tac ft; simp)
+  apply (case_tac ft, simp_all)
    apply (simp add: valid_fault_def LookupFailureMap_lookup_failure_map word_bits_def)
   apply (rule ArchFaultMap_arch_fault_map)
   done
@@ -435,48 +425,23 @@ definition
   "TcbMap tcb \<equiv>
      \<lparr>tcb_ctable = CapabilityMap (cteCap (tcbCTable tcb)),
       tcb_vtable = CapabilityMap (cteCap (tcbVTable tcb)),
+      tcb_reply = CapabilityMap (cteCap (tcbReply tcb)),
+      tcb_caller = CapabilityMap (cteCap (tcbCaller tcb)),
       tcb_ipcframe = CapabilityMap (cteCap (tcbIPCBufferFrame tcb)),
-      tcb_fault_handler = CapabilityMap (cteCap (tcbFaultHandler tcb)),
-      tcb_timeout_handler = CapabilityMap (cteCap (tcbTimeoutHandler tcb)),
       tcb_state = ThStateMap (tcbState tcb),
+      tcb_fault_handler = to_bl (tcbFaultHandler tcb),
       tcb_ipc_buffer = tcbIPCBuffer tcb,
       tcb_fault = map_option FaultMap (tcbFault tcb),
       tcb_bound_notification = tcbBoundNotification tcb,
       tcb_mcpriority = tcbMCP tcb,
-      tcb_sched_context = tcbSchedContext tcb,
-      tcb_yield_to = tcbYieldTo tcb,
-      tcb_priority = tcbPriority tcb,
-      tcb_domain = tcbDomain tcb,
       tcb_arch = ArchTcbMap (tcbArch tcb)\<rparr>"
 
-definition absCNode :: "nat \<Rightarrow> (obj_ref \<rightharpoonup> kernel_object) \<Rightarrow> obj_ref \<Rightarrow> Structures_A.kernel_object"
-  where
-  "absCNode sz h a \<equiv> CNode sz (\<lambda>bl. if length bl = sz
-                                     then Some (CapabilityMap
-                                                  (case (h (a + of_bl bl * 2^cteSizeBits)) of
-                                                     Some (KOCTE cte) \<Rightarrow> cteCap cte))
-                                     else None)"
-
-definition scMap :: "(obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> sched_context \<Rightarrow> Structures_A.sched_context" where
-  "scMap replyPrevs sc = \<lparr>
-     sc_period     = scPeriod sc,
-     sc_budget     = if scRefillMax sc > 0
-                     then refills_sum (refills_map (scRefillHead sc) (scRefillCount sc)
-                                                   (scRefillMax sc) (scRefills sc))
-                     else 0,
-     sc_consumed   = scConsumed sc,
-     sc_tcb        = scTCB sc,
-     sc_ntfn       = scNtfn sc,
-     sc_refills    = refills_map (scRefillHead sc) (scRefillCount sc) (scRefillMax sc) (scRefills sc),
-     sc_refill_max = scRefillMax sc,
-     sc_badge      = scBadge sc,
-     sc_yield_from = scYieldFrom sc,
-     sc_replies    = heap_walk replyPrevs (scReply sc) [],
-     sc_sporadic   = scSporadic sc
-   \<rparr>"
-
-definition replyMap :: "reply \<Rightarrow>  Structures_A.reply" where
-  "replyMap r = \<lparr> reply_tcb = replyTCB r, reply_sc = replySC r \<rparr>"
+definition
+ "absCNode sz h a \<equiv> CNode sz (%bl.
+  if length bl = sz
+    then Some (CapabilityMap (case (h (a + of_bl bl * 2^cteSizeBits)) of
+                                Some (KOCTE cte) \<Rightarrow> cteCap cte))
+  else None)"
 
 definition
   absHeap :: "(word32 \<rightharpoonup> vmpage_size) \<Rightarrow> (word32 \<rightharpoonup> nat) \<Rightarrow>
@@ -485,15 +450,12 @@ definition
   "absHeap ups cns h \<equiv> \<lambda>x.
      case h x of
        Some (KOEndpoint ep) \<Rightarrow> Some (Endpoint (EndpointMap ep))
-     | Some (KONotification ntfn) \<Rightarrow> Some (Notification (NtfnMap ntfn))
+     | Some (KONotification ntfn) \<Rightarrow> Some (Notification (AEndpointMap ntfn))
      | Some KOKernelData \<Rightarrow> undefined \<comment> \<open>forbidden by pspace_relation\<close>
      | Some KOUserData \<Rightarrow> map_option (ArchObj \<circ> DataPage False) (ups x)
      | Some KOUserDataDevice \<Rightarrow> map_option (ArchObj \<circ> DataPage True) (ups x)
      | Some (KOTCB tcb) \<Rightarrow> Some (TCB (TcbMap tcb))
      | Some (KOCTE cte) \<Rightarrow> map_option (%sz. absCNode sz h x) (cns x)
-     | Some (KOReply reply) \<Rightarrow> Some (Structures_A.Reply (replyMap reply))
-     | Some (KOSchedContext sc) \<Rightarrow> Some (Structures_A.SchedContext
-                                           (scMap (h |> reply_of' |> replyPrev) sc) (scSize sc))
      | Some (KOArch ako) \<Rightarrow> map_option ArchObj (absHeapArch h x ako)
      | None \<Rightarrow> None"
 
@@ -516,6 +478,16 @@ lemma unaligned_page_offsets_helper:
     apply (frule_tac i=n and k="0x1000" in word_mult_less_mono1, simp+)+
   done
 
+(* FIXME: move *)
+lemma unaligned_helper:
+  "\<lbrakk>is_aligned x n; y\<noteq>0; y < 2 ^ n\<rbrakk> \<Longrightarrow> \<not> is_aligned (x + y) n"
+  apply (simp (no_asm_simp) add: is_aligned_mask)
+  apply (simp add: mask_add_aligned)
+  apply (cut_tac mask_eq_iff_w2p[of n y], simp_all add: word_size)
+  apply (rule ccontr)
+  apply (simp add: not_less power_overflow word_bits_conv)
+  done
+
 lemma pspace_aligned_distinct_None:
   (* NOTE: life would be easier if pspace_aligned and pspace_distinct were defined on PSpace instead of the whole kernel state. *)
 assumes pspace_aligned:
@@ -596,30 +568,15 @@ lemma pspace_aligned_distinct_None':
    apply assumption+
   done
 
-context
-begin
-
-private method ako =
-  find_goal \<open>match premises in "kheap s p = Some (ArchObj ako)" for s p ako \<Rightarrow> succeed\<close>,
-  (rename_tac ako, case_tac ako;
-   clarsimp simp: other_obj_relation_def pte_relation_def pde_relation_def split: if_split_asm)
-
-private method ko =
-  case_tac ko; clarsimp simp: other_obj_relation_def cte_relation_def split: if_split_asm
-
-
 lemma absHeap_correct:
   assumes pspace_aligned:  "pspace_aligned s"
   assumes pspace_distinct: "pspace_distinct s"
   assumes valid_objs:      "valid_objs s"
-  assumes valid_refills:   "active_scs_valid s"
   assumes pspace_relation: "pspace_relation (kheap s) (ksPSpace s')"
   assumes ghost_relation:  "ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')"
-  assumes replies:         "sc_replies_relation s s'"
 shows
   "absHeap (gsUserPages s') (gsCNodes s') (ksPSpace s') = kheap s"
 proof -
-  note relatedE = pspace_dom_relatedE[OF _ pspace_relation]
   from ghost_relation
   have gsUserPages:
     "\<And>a sz. (\<exists>dev. kheap s a = Some (ArchObj (DataPage dev sz))) \<longleftrightarrow>
@@ -630,274 +587,377 @@ proof -
     by (fastforce simp add: ghost_relation_def)+
 
   show "?thesis"
-    supply image_cong_simp [cong del]
+  supply  image_cong_simp [cong del]
     apply (rule ext)
     apply (simp add: absHeap_def split: option.splits)
     apply (rule conjI)
      using pspace_relation
-     apply (clarsimp simp: pspace_relation_def pspace_dom_def UNION_eq dom_def Collect_eq)
+     apply (clarsimp simp add: pspace_relation_def pspace_dom_def UNION_eq
+                               dom_def Collect_eq)
      apply (erule_tac x=x in allE)
      apply clarsimp
      apply (case_tac "kheap s x", simp)
-     apply (rename_tac ko)
      apply (erule_tac x=x in allE, clarsimp)
      apply (erule_tac x=x in allE, simp add: Ball_def)
      apply (erule_tac x=x in allE, clarsimp)
 
-     apply (case_tac ko; simp add: other_obj_relation_def split: if_split_asm kernel_object.splits)
+     apply (case_tac a)
+         apply (simp_all add: other_obj_relation_def
+                       split: if_split_asm Structures_H.kernel_object.splits)
       apply (rename_tac sz cs)
-      apply (clarsimp simp: image_def cte_map_def well_formed_cnode_n_def Collect_eq dom_def)
+      apply (clarsimp simp add: image_def cte_map_def
+                 well_formed_cnode_n_def Collect_eq dom_def)
       apply (erule_tac x="replicate sz False" in allE)+
       apply simp
      apply (rename_tac arch_kernel_obj)
-     apply (case_tac arch_kernel_obj; simp add: image_def)
+     apply (case_tac arch_kernel_obj, simp_all add: image_def)
        apply (erule_tac x=0 in allE, simp)
       apply (erule_tac x=0 in allE, simp)
      apply clarsimp
      apply (erule_tac x=0 in allE, simp add: pageBits_def)
      apply (rename_tac vmpage_size)
-     apply (case_tac vmpage_size; simp)
+     apply (case_tac vmpage_size, simp_all)
 
-    apply (clarsimp split: kernel_object.splits)
+    apply clarsimp
     apply (intro conjI impI allI)
-             apply (erule relatedE, ko, ako)
-             apply (clarsimp simp: ep_relation_def EndpointMap_def
-                             split: Structures_A.endpoint.splits)
-            apply (erule relatedE, ko, ako)
-            apply (clarsimp simp: ntfn_relation_def NtfnMap_def
-                            split: Structures_A.ntfn.splits)
-           apply (erule relatedE, ko, ako)
-          apply (erule relatedE, ko, ako)
-          apply (rename_tac vmpage_size n)
-          apply (cut_tac a=y and sz=vmpage_size in gsUserPages, clarsimp split: if_split_asm)
-          apply (case_tac "n=0", simp)
-          apply (case_tac "kheap s (y + n * 2 ^ pageBits)")
-           apply (rule ccontr)
-           apply (clarsimp dest!: gsUserPages[symmetric, THEN iffD1] )
-          using pspace_aligned
-          apply (simp add: pspace_aligned_def dom_def)
-          apply (erule_tac x=y in allE)
-          apply (case_tac "n=0",(simp split: if_split_asm)+)
-          apply (frule (2) unaligned_page_offsets_helper)
-          apply (frule_tac y="n*2^pageBits" in pspace_aligned_distinct_None'
-                                            [OF pspace_aligned pspace_distinct])
-           apply simp
-           apply (rule conjI, clarsimp simp add: word_gt_0)
-           apply (simp add: is_aligned_mask)
-           apply (clarsimp simp add: pageBits_def mask_def)
-           apply (case_tac vmpage_size; frule_tac i=n and k="0x1000" in word_mult_less_mono1; simp)
-          apply simp
-
-         apply (erule relatedE, ko, ako)
-         apply (rename_tac vmpage_size n)
-         apply (cut_tac a=y and sz=vmpage_size in gsUserPages, clarsimp split: if_split_asm)
-         apply (case_tac "n=0", simp)
-         apply (case_tac "kheap s (y + n * 2 ^ pageBits)")
-          apply (rule ccontr)
-          apply (clarsimp dest!: gsUserPages[symmetric, THEN iffD1])
-         using pspace_aligned
-         apply (simp add: pspace_aligned_def dom_def)
-         apply (erule_tac x=y in allE)
-         apply (case_tac "n=0"; simp)
-         apply (frule (2) unaligned_page_offsets_helper)
-         apply (frule_tac y="n*2^pageBits" in pspace_aligned_distinct_None'
-                                           [OF pspace_aligned pspace_distinct])
-          apply simp
-          apply (rule conjI, clarsimp simp add: word_gt_0)
-          apply (simp add: is_aligned_mask)
-          apply (clarsimp simp add: pageBits_def mask_def)
-          apply (case_tac vmpage_size; frule_tac i=n and k="0x1000" in word_mult_less_mono1; simp)
+           apply (erule pspace_dom_relatedE[OF _ pspace_relation])
+           apply clarsimp
+           apply (case_tac ko, simp_all add: tcb_relation_cut_def other_obj_relation_def)
+             apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+            apply (clarsimp simp add: ep_relation_def EndpointMap_def
+                     split: Structures_A.endpoint.splits)
+           apply (clarsimp simp add: EndpointMap_def
+                    split: Structures_A.endpoint.splits)
+           apply (rename_tac arch_kernel_obj)
+           apply (case_tac arch_kernel_obj,
+                  simp_all add: other_obj_relation_def)
+             apply (clarsimp simp add: pte_relation_def)
+            apply (clarsimp simp add: pde_relation_def)
+           apply (clarsimp split: if_split_asm)+
+
+          apply (erule pspace_dom_relatedE[OF _ pspace_relation])
+          apply (case_tac ko, simp_all add: tcb_relation_cut_def other_obj_relation_def)
+            apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+           apply (clarsimp simp add: ntfn_relation_def AEndpointMap_def
+                    split: Structures_A.ntfn.splits)
+          apply (clarsimp simp add: AEndpointMap_def
+                   split: Structures_A.ntfn.splits)
+          apply (rename_tac arch_kernel_obj)
+          apply (case_tac arch_kernel_obj, simp_all add: other_obj_relation_def)
+            apply (clarsimp simp add: pte_relation_def)
+           apply (clarsimp simp add: pde_relation_def)
+          apply (clarsimp split: if_split_asm)+
+
+         apply (erule pspace_dom_relatedE[OF _ pspace_relation])
+         apply (case_tac ko, simp_all add: tcb_relation_cut_def other_obj_relation_def)
+           apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+         apply (rename_tac arch_kernel_obj)
+         apply (case_tac arch_kernel_obj, simp_all add: other_obj_relation_def)
+           apply (clarsimp simp add: pte_relation_def)
+          apply (clarsimp simp add: pde_relation_def)
+         apply (clarsimp split: if_split_asm)+
+
+        apply (erule pspace_dom_relatedE[OF _ pspace_relation])
+        apply (case_tac ko, simp_all add: tcb_relation_cut_def other_obj_relation_def)
+          apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+        apply (rename_tac arch_kernel_obj)
+        apply (case_tac arch_kernel_obj, simp_all add: other_obj_relation_def)
+          apply (clarsimp simp add: pte_relation_def)
+         apply (clarsimp simp add: pde_relation_def)
+        apply (rename_tac vmpage_size)
+        apply (cut_tac a=y and sz=vmpage_size in gsUserPages, clarsimp split: if_split_asm)
+        apply (case_tac "n=0", simp)
+        apply (case_tac "kheap s (y + n * 2 ^ pageBits)")
+         apply (rule ccontr)
+         apply (clarsimp dest!: gsUserPages[symmetric, THEN iffD1] )
+        using pspace_aligned
+        apply (simp add: pspace_aligned_def dom_def)
+        apply (erule_tac x=y in allE)
+        apply (case_tac "n=0",(simp split: if_split_asm)+)
+        apply (frule (2) unaligned_page_offsets_helper)
+        apply (frule_tac y="n*2^pageBits" in pspace_aligned_distinct_None'
+                                          [OF pspace_aligned pspace_distinct])
          apply simp
-
-        apply (erule relatedE, ko, ako)
-        apply (clarsimp simp: TcbMap_def tcb_relation_def valid_obj_def)
-        apply (rename_tac tcb y tcb')
-        apply (case_tac tcb, case_tac tcb')
-        apply (simp add: thread_state_relation_imp_ThStateMap)
-        apply (subgoal_tac "map_option FaultMap (tcbFault tcb) = tcb_fault")
-         prefer 2
-         apply (simp add: fault_rel_optionation_def)
-         using valid_objs[simplified valid_objs_def dom_def fun_app_def, simplified]
-         apply (erule_tac x=y in allE)
-         apply (clarsimp simp: valid_obj_def valid_tcb_def split: option.splits)
-        using valid_objs[simplified valid_objs_def Ball_def dom_def fun_app_def]
+         apply (rule conjI, clarsimp simp add: word_gt_0)
+         apply (simp add: is_aligned_mask)
+         apply (clarsimp simp add: pageBits_def mask_def)
+        apply (case_tac vmpage_size; simp)
+          apply ((frule_tac i=n and k="0x1000" in word_mult_less_mono1, simp+)+)[4]
+        apply (erule pspace_dom_relatedE[OF _ pspace_relation])
+        apply (case_tac ko, simp_all add: tcb_relation_cut_def other_obj_relation_def)
+          apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+        apply (rename_tac arch_kernel_obj)
+        apply (case_tac arch_kernel_obj, simp_all add: other_obj_relation_def)
+          apply (clarsimp simp add: pte_relation_def)
+         apply (clarsimp simp add: pde_relation_def)
+        apply (rename_tac vmpage_size)
+        apply (cut_tac a=y and sz=vmpage_size in gsUserPages, clarsimp split: if_split_asm)
+        apply (case_tac "n=0", simp)
+        apply (case_tac "kheap s (y + n * 2 ^ pageBits)")
+         apply (rule ccontr)
+         apply (clarsimp dest!: gsUserPages[symmetric, THEN iffD1])
+        using pspace_aligned
+        apply (simp add: pspace_aligned_def dom_def)
         apply (erule_tac x=y in allE)
-        apply (clarsimp simp: cap_relation_imp_CapabilityMap valid_obj_def valid_tcb_def
-                              ran_tcb_cap_cases valid_cap_def2 arch_tcb_relation_imp_ArchTcnMap)
-
-       apply (erule relatedE, ko, ako)
-       apply (simp add: absCNode_def cte_map_def)
-       apply (cut_tac a=y and n=sz in gsCNodes, clarsimp)
-       using pspace_aligned[simplified pspace_aligned_def]
-       apply (drule_tac x=y in bspec, clarsimp)
-       apply clarsimp
-       apply (case_tac "(of_bl ya::word32) * 2^cte_level_bits = 0", simp)
-        apply (rule ext)
-        apply simp
-        apply (rule conjI)
-         prefer 2
-         using valid_objs[simplified valid_objs_def Ball_def dom_def fun_app_def]
-         apply (erule_tac x=y in allE)
-         apply (clarsimp simp: valid_obj_def valid_cs_def valid_cs_size_def
-                               well_formed_cnode_n_def dom_def Collect_eq)
-         apply (frule_tac x=ya in spec, simp)
-         apply (erule_tac x=bl in allE)
-         apply clarsimp
-        apply (frule pspace_relation_absD[OF _ pspace_relation])
-        apply (simp add: cte_map_def)
-        apply (drule_tac x="y + of_bl bl * 2^cte_level_bits" in spec)
-        apply clarsimp
-        apply (erule_tac x="cte_relation bl" in allE)
-        apply (erule impE)
-         apply (fastforce simp add: well_formed_cnode_n_def)
-        apply clarsimp
-        apply (clarsimp simp add: cte_relation_def)
-        apply (rule cap_relation_imp_CapabilityMap)
-         using valid_objs[simplified valid_objs_def Ball_def dom_def fun_app_def]
-         apply (erule_tac x=y in allE)
-         apply (clarsimp simp: valid_obj_def valid_cs_def valid_cap_def2 ran_def)
-         apply (fastforce simp: cte_level_bits_def cteSizeBits_def)+
-       apply (subgoal_tac "kheap s (y + of_bl ya * 2^cte_level_bits) = None")
+        apply (case_tac "n=0",simp+)
+        apply (frule (2) unaligned_page_offsets_helper)
+        apply (frule_tac y="n*2^pageBits" in pspace_aligned_distinct_None'
+                                          [OF pspace_aligned pspace_distinct])
+         apply simp
+         apply (rule conjI, clarsimp simp add: word_gt_0)
+         apply (simp add: is_aligned_mask)
+         apply (clarsimp simp add: pageBits_def mask_def)
+        apply (case_tac vmpage_size; simp)
+          apply ((frule_tac i=n and k="0x1000" in word_mult_less_mono1, simp+)+)[4]
+       apply (erule pspace_dom_relatedE[OF _ pspace_relation])
+       apply (case_tac ko, simp_all add: tcb_relation_cut_def other_obj_relation_def)
+         apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+        prefer 2
+        apply (rename_tac arch_kernel_obj)
+        apply (case_tac arch_kernel_obj, simp_all add: other_obj_relation_def)
+          apply (clarsimp simp add: pte_relation_def)
+         apply (clarsimp simp add: pde_relation_def)
+        apply (clarsimp split: if_split_asm)
+       apply (clarsimp simp add: TcbMap_def tcb_relation_def valid_obj_def)
+       apply (rename_tac tcb y tcb')
+       apply (case_tac tcb)
+       apply (case_tac tcb')
+       apply (simp add: thread_state_relation_imp_ThStateMap)
+       apply (subgoal_tac "map_option FaultMap (tcbFault tcb) = tcb_fault")
         prefer 2
-        using valid_objs[simplified valid_objs_def Ball_def dom_def fun_app_def]
+        apply (simp add: fault_rel_optionation_def)
+        using valid_objs[simplified valid_objs_def dom_def fun_app_def,
+                         simplified]
         apply (erule_tac x=y in allE)
-        apply (clarsimp simp add: valid_obj_def valid_cs_def valid_cs_size_def)
-        apply (rule pspace_aligned_distinct_None'[OF
-                    pspace_aligned pspace_distinct], assumption)
-        apply (clarsimp simp: word_neq_0_conv power_add cte_index_repair)
-        apply (simp add: well_formed_cnode_n_def dom_def Collect_eq)
-        apply (erule_tac x=ya in allE)+
-        apply (rule word_mult_less_mono1)
-          apply (subgoal_tac "sz = length ya")
-           apply simp
-           apply (rule of_bl_length, (simp add: word_bits_def)+)[1]
-          apply fastforce
-         apply (simp add: cte_level_bits_def)
-        apply (simp add: word_bits_conv cte_level_bits_def)
-        apply (drule_tac a="2::nat" in power_strict_increasing, simp+)
-       apply (rule ccontr, clarsimp)
-       apply (cut_tac a="y + of_bl ya * 2^cte_level_bits" and n=yc in gsCNodes)
-       apply clarsimp
-
-      (* mapping architecture-specific objects *)
-      apply clarsimp
-      apply (rename_tac x arch_kernel_object)
-      apply (erule relatedE, ko)
-      apply (rename_tac y P arch_kernel_obj)
-      apply (case_tac arch_kernel_object; simp add: absHeapArch_def split: asidpool.splits)
-
-        apply clarsimp
-        apply (case_tac arch_kernel_obj)
-           apply (simp add: other_obj_relation_def asid_pool_relation_def inv_def o_def)
-          apply (clarsimp simp add:  pte_relation_def)
-         apply (clarsimp simp add:  pde_relation_def)
-        apply (clarsimp split: if_split_asm)+
-
-       apply (case_tac arch_kernel_obj)
-          apply (simp add: other_obj_relation_def asid_pool_relation_def inv_def o_def)
-         using pspace_aligned[simplified pspace_aligned_def Ball_def dom_def]
-         apply (erule_tac x=y in allE)
-         apply (clarsimp simp add: pte_relation_def absPageTable_def pt_bits_def pageBits_def)
-         apply (rule conjI)
-          prefer 2
-          apply clarsimp
-          apply (rule sym)
-          apply (rule pspace_aligned_distinct_None'[OF pspace_aligned pspace_distinct]; simp)
-          apply (cut_tac x=ya and n="2^10" in
-                 ucast_less_shiftl_helper[where 'a=32,simplified word_bits_conv]; simp)
-          apply (clarsimp simp add: word_gt_0)
-         apply clarsimp
-         apply (subgoal_tac "ucast ya << 2 = 0")
-          prefer 2
-          apply (rule ccontr)
-          apply (frule_tac x=y in unaligned_helper, assumption)
-           apply (rule ucast_less_shiftl_helper; simp)
-          apply simp
-         apply simp
-         apply (rule ext)
-         apply (frule pspace_relation_absD[OF _ pspace_relation])
-         apply simp
-         apply (erule_tac x=offs in allE)
+        apply (clarsimp simp: valid_obj_def valid_tcb_def
+                        split: option.splits)
+       using valid_objs[simplified valid_objs_def Ball_def dom_def fun_app_def]
+       apply (erule_tac x=y in allE)
+       apply (clarsimp simp add: cap_relation_imp_CapabilityMap valid_obj_def
+                                 valid_tcb_def ran_tcb_cap_cases valid_cap_def2
+                                 arch_tcb_relation_imp_ArchTcnMap)
+      apply (simp add: absCNode_def cte_map_def)
+      apply (erule pspace_dom_relatedE[OF _ pspace_relation])
+      apply (case_tac ko, simp_all add: tcb_relation_cut_def other_obj_relation_def
+                                 split: if_split_asm)
+       prefer 2
+       apply (rename_tac arch_kernel_obj)
+       apply (case_tac arch_kernel_obj, simp_all add: other_obj_relation_def)
          apply (clarsimp simp add: pte_relation_def)
-         using valid_objs[simplified valid_objs_def fun_app_def dom_def, simplified]
-         apply (erule_tac x=y in allE)
-         apply (clarsimp simp add: valid_obj_def wellformed_pte_def)
-         apply (erule_tac x=offs in allE)
-         apply (rename_tac pte')
-         apply (case_tac pte', simp_all add: pte_relation_aligned_def)[1]
-          apply (clarsimp split: ARM_A.pte.splits)
-          apply (rule set_eqI, clarsimp)
-          apply (case_tac x; simp)
-         apply (clarsimp split: ARM_A.pte.splits)
-         apply (rule set_eqI, clarsimp)
-         apply (case_tac x; simp)
         apply (clarsimp simp add: pde_relation_def)
        apply (clarsimp split: if_split_asm)
+      apply (simp add: cte_map_def)
+      apply (clarsimp simp add: cte_relation_def)
+      apply (cut_tac a=y and n=sz in gsCNodes, clarsimp)
+      using pspace_aligned[simplified pspace_aligned_def]
+      apply (drule_tac x=y in bspec, clarsimp)
+      apply clarsimp
+      apply (case_tac "(of_bl ya::word32) * 2^cte_level_bits = 0", simp)
+       apply (rule ext)
+       apply simp
+       apply (rule conjI)
+        prefer 2
+        using valid_objs[simplified valid_objs_def Ball_def dom_def
+                                    fun_app_def]
+        apply (erule_tac x=y in allE)
+        apply (clarsimp simp add: valid_obj_def valid_cs_def valid_cs_size_def
+                    well_formed_cnode_n_def dom_def Collect_eq)
+        apply (frule_tac x=ya in spec, simp)
+        apply (erule_tac x=bl in allE)
+        apply clarsimp+
+       apply (frule pspace_relation_absD[OF _ pspace_relation])
+       apply (simp add: cte_map_def)
+       apply (drule_tac x="y + of_bl bl * 2^cte_level_bits" in spec)
+       apply clarsimp
+       apply (erule_tac x="cte_relation bl" in allE)
+       apply (erule impE)
+        apply (fastforce simp add: well_formed_cnode_n_def)
+       apply clarsimp
+       apply (clarsimp simp add: cte_relation_def)
+       apply (rule cap_relation_imp_CapabilityMap)
+        using valid_objs[simplified valid_objs_def Ball_def dom_def
+                                    fun_app_def]
+        apply (erule_tac x=y in allE)
+        apply (clarsimp simp: valid_obj_def valid_cs_def valid_cap_def2 ran_def)
+        apply (fastforce simp: cte_level_bits_def cteSizeBits_def)+
+      apply (subgoal_tac "kheap s (y + of_bl ya * 2^cte_level_bits) = None")
+       prefer 2
+       using valid_objs[simplified valid_objs_def Ball_def dom_def fun_app_def]
+       apply (erule_tac x=y in allE)
+       apply (clarsimp simp add: valid_obj_def valid_cs_def valid_cs_size_def)
+       apply (rule pspace_aligned_distinct_None'[OF
+                   pspace_aligned pspace_distinct], assumption)
+       apply (clarsimp simp: word_neq_0_conv power_add cte_index_repair)
+       apply (simp add: well_formed_cnode_n_def dom_def Collect_eq)
+       apply (erule_tac x=ya in allE)+
+       apply (rule word_mult_less_mono1)
+         apply (subgoal_tac "sz = length ya")
+          apply simp
+          apply (rule of_bl_length, (simp add: word_bits_def)+)[1]
+         apply fastforce
+        apply (simp add: cte_level_bits_def)
+       apply (simp add: word_bits_conv cte_level_bits_def)
+       apply (drule_tac a="2::nat" in power_strict_increasing, simp+)
+      apply (rule ccontr, clarsimp)
+      apply (cut_tac a="y + of_bl ya * 2^cte_level_bits" and n=yc in gsCNodes)
+      apply clarsimp
+
+    (* mapping architecture-specific objects *)
+    apply clarsimp
+    apply (erule pspace_dom_relatedE[OF _ pspace_relation])
+    apply (case_tac ko, simp_all add: tcb_relation_cut_def other_obj_relation_def)
+     apply (clarsimp simp add: cte_relation_def split: if_split_asm)
+    apply (rename_tac arch_kernel_object y ko P arch_kernel_obj)
+    apply (case_tac arch_kernel_object, simp_all add: absHeapArch_def
+                                            split: asidpool.splits)
 
+      apply clarsimp
       apply (case_tac arch_kernel_obj)
-         apply (simp add: other_obj_relation_def asid_pool_relation_def inv_def o_def)
+         apply (simp add: other_obj_relation_def asid_pool_relation_def
+                          inv_def o_def)
         apply (clarsimp simp add:  pte_relation_def)
-       using pspace_aligned
-       apply (simp add: pspace_aligned_def dom_def)
+       apply (clarsimp simp add:  pde_relation_def)
+      apply (clarsimp split: if_split_asm)+
+
+     apply (case_tac arch_kernel_obj)
+        apply (simp add: other_obj_relation_def asid_pool_relation_def inv_def
+                         o_def)
+       using pspace_aligned[simplified pspace_aligned_def Ball_def dom_def]
        apply (erule_tac x=y in allE)
-       apply (clarsimp simp add: pde_relation_def absPageDirectory_def pd_bits_def pageBits_def)
+       apply (clarsimp simp add: pte_relation_def absPageTable_def
+                                 pt_bits_def pageBits_def)
        apply (rule conjI)
         prefer 2
         apply clarsimp
         apply (rule sym)
-        apply (rule pspace_aligned_distinct_None' [OF pspace_aligned pspace_distinct]; simp)
-        apply (cut_tac x=ya and n="2^14" in
-               ucast_less_shiftl_helper[where 'a=32, simplified word_bits_conv]; simp)
+        apply (rule pspace_aligned_distinct_None'
+                    [OF pspace_aligned pspace_distinct], simp+)
+        apply (cut_tac x=ya and n="2^10" in
+               ucast_less_shiftl_helper[where 'a=32,simplified word_bits_conv], simp+)
         apply (clarsimp simp add: word_gt_0)
        apply clarsimp
        apply (subgoal_tac "ucast ya << 2 = 0")
         prefer 2
         apply (rule ccontr)
         apply (frule_tac x=y in unaligned_helper, assumption)
-         apply (rule ucast_less_shiftl_helper; simp)
-        apply simp
-       apply simp
+         apply (rule ucast_less_shiftl_helper, simp_all)
        apply (rule ext)
        apply (frule pspace_relation_absD[OF _ pspace_relation])
        apply simp
        apply (erule_tac x=offs in allE)
-       apply (clarsimp simp add: pde_relation_def)
-
-       using valid_objs[simplified valid_objs_def fun_app_def dom_def,simplified]
+       apply (clarsimp simp add: pte_relation_def)
+       using valid_objs[simplified valid_objs_def fun_app_def dom_def,
+                        simplified]
        apply (erule_tac x=y in allE)
-       apply (clarsimp simp add: valid_obj_def wellformed_pde_def)
+       apply (clarsimp simp add: valid_obj_def wellformed_pte_def)
        apply (erule_tac x=offs in allE)
-       apply (rename_tac pde')
-       apply (case_tac pde'; simp add: pde_relation_aligned_def)
-          apply (clarsimp split: ARM_A.pde.splits)+
-         apply (fastforce simp add: subset_eq)
-        apply (clarsimp split: ARM_A.pde.splits)
+       apply (rename_tac pte')
+       apply (case_tac pte', simp_all add: pte_relation_aligned_def)[1]
+        apply (clarsimp split: ARM_A.pte.splits)
         apply (rule set_eqI, clarsimp)
-        apply (case_tac x; simp)
-       apply (clarsimp split: ARM_A.pde.splits)
+        apply (case_tac x, simp_all)[1]
+       apply (clarsimp split: ARM_A.pte.splits)
        apply (rule set_eqI, clarsimp)
-       apply (case_tac x; simp)
-      apply (clarsimp simp add: pde_relation_def split: if_split_asm)
-
-     apply (rule relatedE, assumption, ko, ako)
-     apply (clarsimp simp: sc_relation_def scMap_def sc_replies_prevs_walk[OF replies])
-     apply (intro conjI impI)
-       apply (prop_tac "valid_refills y s")
-        apply (fastforce intro: valid_refills active_scs_validE
-                          simp: vs_all_heap_simps active_sc_def)
-       apply (clarsimp simp: valid_refills_def vs_all_heap_simps rr_valid_refills_def
-                      split: if_splits)
-      apply (insert valid_refills)
-      apply (force simp: active_scs_valid_def valid_refills_def vs_all_heap_simps
-                         active_sc_def
-                  split: if_splits)
-
-    apply (erule relatedE, ko, ako)
-    apply (clarsimp simp: reply_relation_def replyMap_def)
+       apply (case_tac x, simp_all)[1]
+      apply (clarsimp simp add: pde_relation_def)
+     apply (clarsimp split: if_split_asm)+
+
+    apply (case_tac arch_kernel_obj)
+       apply (simp add: other_obj_relation_def asid_pool_relation_def inv_def
+                        o_def)
+      apply (clarsimp simp add:  pte_relation_def)
+     using pspace_aligned
+     apply (simp add: pspace_aligned_def dom_def)
+     apply (erule_tac x=y in allE)
+     apply (clarsimp simp add: pde_relation_def absPageDirectory_def
+                               pd_bits_def pageBits_def)
+     apply (rule conjI)
+      prefer 2
+      apply clarsimp
+      apply (rule sym)
+      apply (rule pspace_aligned_distinct_None'
+                  [OF pspace_aligned pspace_distinct], simp+)
+      apply (cut_tac x=ya and n="2^14" in
+             ucast_less_shiftl_helper[where 'a=32, simplified word_bits_conv], simp+)
+      apply (clarsimp simp add: word_gt_0)
+     apply clarsimp
+     apply (subgoal_tac "ucast ya << 2 = 0")
+      prefer 2
+      apply (rule ccontr)
+      apply (frule_tac x=y in unaligned_helper, assumption)
+       apply (rule ucast_less_shiftl_helper, simp_all)
+     apply (rule ext)
+     apply (frule pspace_relation_absD[OF _ pspace_relation])
+     apply simp
+     apply (erule_tac x=offs in allE)
+     apply (clarsimp simp add: pde_relation_def)
+
+     using valid_objs[simplified valid_objs_def fun_app_def dom_def,simplified]
+     apply (erule_tac x=y in allE)
+     apply (clarsimp simp add: valid_obj_def wellformed_pde_def)
+     apply (erule_tac x=offs in allE)
+     apply (rename_tac pde')
+     apply (case_tac pde', simp_all add: pde_relation_aligned_def)[1]
+        apply (clarsimp split: ARM_A.pde.splits)+
+       apply (fastforce simp add: subset_eq)
+      apply (clarsimp split: ARM_A.pde.splits)
+      apply (rule set_eqI, clarsimp)
+      apply (case_tac x, simp_all)[1]
+     apply (clarsimp split: ARM_A.pde.splits)
+     apply (rule set_eqI, clarsimp)
+     apply (case_tac x, simp_all)[1]
+    apply (clarsimp simp add: pde_relation_def split: if_split_asm)
     done
 qed
 
-end
+definition
+  "EtcbMap tcb \<equiv>
+     \<lparr>tcb_priority = tcbPriority tcb,
+      time_slice = tcbTimeSlice tcb,
+      tcb_domain = tcbDomain tcb\<rparr>"
+
+definition
+  absEkheap :: "(word32 \<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 projectKOs)
+  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
+                        ARM_A.arch_kernel_obj.split_asm)+
+  done
 
 text \<open>The following function can be used to reverse cte_map.\<close>
 definition
@@ -968,11 +1028,12 @@ lemma TCB_implies_KOTCB:
 lemma cte_at_CNodeI:
   "\<lbrakk>kheap s a = Some (CNode (length b) cs); well_formed_cnode_n (length b) cs\<rbrakk>
    \<Longrightarrow> cte_at (a,b) s"
-  apply (subgoal_tac "\<exists>y. cs b = Some y")
-   apply clarsimp
-   apply (rule_tac cte=y in cte_wp_at_cteI[of s _ "length b" cs]; simp)
-  apply (simp add: well_formed_cnode_n_def dom_def Collect_eq)
-  done
+apply (subgoal_tac "\<exists>y. cs b = Some y")
+ apply clarsimp
+ apply (rule_tac cte=y in cte_wp_at_cteI[of s _ "length b" cs],
+        simp_all)
+apply (simp add: well_formed_cnode_n_def dom_def Collect_eq)
+done
 
 lemma cteMap_correct:
   assumes rel:              "(s,s') \<in> state_relation"
@@ -1396,7 +1457,7 @@ locale partial_sort_cdt = partial_sort "\<lambda> x y.  m' \<turnstile> cte_map
 
 begin
 
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 
 lemma valid_list_2 : "valid_list_2 t m"
     apply (insert assms')
@@ -1593,7 +1654,7 @@ lemma sort_cdt_list_correct:
 
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 definition absCDTList where
 "absCDTList cnp h \<equiv> sort_cdt_list (absCDT cnp h) h"
@@ -1735,6 +1796,13 @@ 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:
@@ -1742,11 +1810,15 @@ 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
-                           absCDTList_correct[THEN fun_cong] state_relation_def invs_def valid_state_def
-                           ready_queues_relation_def invs'_def
-                           valid_pspace_def valid_sched_def valid_pspace'_def curry_def fun_eq_iff)
+           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
 
 
@@ -1756,17 +1828,6 @@ 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,
-    consumed_time = ksConsumedTime s,
-    cur_time = ksCurTime s,
-    cur_sc = ksCurSc s,
-    reprogram_timer = ksReprogramTimer s,
-    scheduler_action = absSchedulerAction (ksSchedulerAction s),
-    domain_list = ksDomSchedule s,
-    domain_index = ksDomScheduleIdx s,
-    cur_domain = ksCurDomain s,
-    domain_time = ksDomainTime s,
-    ready_queues = curry (ksReadyQueues s),
-    release_queue = ksReleaseQueue s,
     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/ARM/ArchAcc_R.thy b/proof/refine/ARM/ArchAcc_R.thy
index b8eeb52b8e..f1b1ebb412 100644
--- a/proof/refine/ARM/ArchAcc_R.thy
+++ b/proof/refine/ARM/ArchAcc_R.thy
@@ -26,7 +26,7 @@ method simp_to_elim = (drule fun_all, elim allE impE)
 
 end
 
-context Arch begin global_naming ARM_A (*FIXME: arch_split*)
+context Arch begin global_naming ARM_A (*FIXME: arch-split*)
 
 lemma asid_pool_at_ko:
   "asid_pool_at p s \<Longrightarrow> \<exists>pool. ko_at (ArchObj (ARM_A.ASIDPool pool)) p s"
@@ -43,107 +43,38 @@ lemmas valid_arch_state_elims[rule_format, elim!] = conjuncts
 lemmas valid_vspace_obj_elims [rule_format, elim!] =
   valid_vspace_obj.simps[@simp_to_elim, @ \<open>(drule bspec)?\<close>]
 
-lemmas Arch_objBits_simps' = pteBits_def pdeBits_def pageBits_def objBits_simps
-
-sublocale setObject_pte: simple_non_tcb_non_sc_non_reply_ko' "setObject :: _ \<Rightarrow> pte \<Rightarrow> _" getObject
-  by (unfold_locales,
-      simp add: projectKO_opts_defs archObjSize_def Arch_objBits_simps' | wp)+
-
-sublocale setObject_pde: simple_non_tcb_non_sc_non_reply_ko' "setObject :: _ \<Rightarrow> pde \<Rightarrow> _" getObject
-  by (unfold_locales,
-      simp add: projectKO_opts_defs archObjSize_def Arch_objBits_simps' | wp)+
-
-sublocale setObject_asidpool: simple_non_tcb_non_sc_non_reply_ko' "setObject :: _ \<Rightarrow> asidpool \<Rightarrow> _" getObject
-  by (unfold_locales,
-      simp add: projectKO_opts_defs archObjSize_def Arch_objBits_simps' | wp)+
-
-sublocale storePDE: simple_non_tcb_non_sc_non_reply_ko' "storePDE" getObject
-  by (unfold_locales,
-      simp add: storePDE_def projectKO_opts_defs archObjSize_def Arch_objBits_simps' | wp)+
-
-sublocale storePTE: simple_non_tcb_non_sc_non_reply_ko' "storePTE" getObject
-  by (unfold_locales,
-      simp add: storePTE_def projectKO_opts_defs archObjSize_def Arch_objBits_simps' | wp)+
-
-lemmas storePTE_valid_objs'[wp] =
-  storePTE.valid_objs'[simplified valid_obj'_def pred_conj_def, simplified]
-lemmas storePTE_valid_pspace'[wp] =
-  storePTE.valid_pspace'[simplified valid_obj'_def pred_conj_def, simplified]
+end
 
-lemmas storePDE_valid_objs'[wp] =
-  storePDE.valid_objs'[simplified valid_obj'_def pred_conj_def, simplified]
-lemmas storePDE_valid_pspace'[wp] =
-  storePDE.valid_pspace'[simplified valid_obj'_def pred_conj_def, simplified]
+context begin interpretation Arch . (*FIXME: arch-split*)
 
-end
+(*FIXME move *)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-method readObject_arch_obj_at'_method
-  =  clarsimp simp: readObject_def obind_def omonad_defs split_def loadObject_default_def obj_at'_def
-                    objBits_simps archObjSize_def projectKOs bit_simps' typ_at_to_obj_at_arches
-             split: option.splits if_split_asm
-
-lemma readObject_misc_arch_ko_at'[simp, dest!]:
-  shows
-  readObject_ko_at'_pte: "readObject p s = Some (pte :: pte) \<Longrightarrow> ko_at' pte p s" and
-  readObject_ko_at'_pde: "readObject p s = Some (pde :: pde) \<Longrightarrow> ko_at' pde p s" and
-  readObject_ko_at'_asidpool: "readObject p s = Some (asidp :: asidpool) \<Longrightarrow> ko_at' asidp p s"
-   by readObject_arch_obj_at'_method+
-
-
-lemma readObject_misc_arch_obj_at'[simp]:
-  shows
-  readObject_pte_at'[simplified]: "bound (readObject p s ::pte option) \<Longrightarrow> pte_at' p s" and
-  readObject_pde_at'[simplified]: "bound (readObject p s ::pde option) \<Longrightarrow> pde_at' p s" and
-  readObject_asid_pool_at'[simplified]: "bound (readObject p s ::asidpool option) \<Longrightarrow> asid_pool_at' p s"
-   by readObject_arch_obj_at'_method+
-
-method no_ofail_readObject_method =
-  clarsimp simp: obj_at'_def readObject_def obind_def omonad_defs split_def projectKO_eq no_ofail_def,
-  rule ps_clear_lookupAround2, assumption+, simp,
-  blast intro: is_aligned_no_overflow,
-  clarsimp simp: bit_simps' project_inject obj_at_simps lookupAround2_known1 split: option.splits
-
-lemma no_ofail_arch_obj_at'_readObject_pte[simp]:
-  "no_ofail (obj_at' (P::pte \<Rightarrow> bool) p) (readObject p::pte kernel_r)"
-  by no_ofail_readObject_method
-
-lemma no_ofail_arch_obj_at'_readObject_pde[simp]:
-  "no_ofail (obj_at' (P::pde \<Rightarrow> bool) p) (readObject p::pde kernel_r)"
-  by no_ofail_readObject_method
-
-lemma no_ofail_arch_obj_at'_readObject_asidpool[simp]:
-  "no_ofail (obj_at' (P::asidpool \<Rightarrow> bool) p) (readObject p::asidpool kernel_r)"
-  by no_ofail_readObject_method
-
-lemma no_ofail_arch_misc_readObject:
-  shows
-  no_ofail_pte_at'_readObject[simp]: "no_ofail (pte_at' p) (readObject p::pte kernel_r)" and
-  no_ofail_pde_at'_readObject[simp]: "no_ofail (pde_at' p) (readObject p::pde kernel_r)" and
-  no_ofail_asidpool_at'_readObject[simp]: "no_ofail (asid_pool_at' p) (readObject p::asidpool kernel_r)"
-  by (clarsimp simp: typ_at_to_obj_at_arches no_ofail_def
-              dest!: no_ofailD[OF no_ofail_arch_obj_at'_readObject_pte]
-                     no_ofailD[OF no_ofail_arch_obj_at'_readObject_pde]
-                     no_ofailD[OF no_ofail_arch_obj_at'_readObject_asidpool])+
-
-(* aliases for compatibility with master *)
-
-lemmas getPTE_wp = setObject_pte.get_wp
-lemmas getPDE_wp = setObject_pde.get_wp
-lemmas getASID_wp = setObject_asidpool.getObject_wp
-
-lemmas getObject_pte_inv[wp] = setObject_pte.getObject_inv
-lemmas getObject_pde_inv[wp] = setObject_pde.getObject_inv
-lemmas getObject_asidpool_inv = setObject_asidpool.getObject_inv
-
-lemmas get_pte_sp' = setObject_pte.getObject_sp'
-lemmas get_pde_sp' = setObject_pde.getObject_sp'
-lemmas get_asidpool_sp' = setObject_asidpool.getObject_sp'
-
-lemmas setObject_ASID_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF setObject_asidpool.ctes_of]
-lemmas storePTE_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF storePTE.ctes_of]
-lemmas storePDE_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF storePDE.ctes_of]
+lemma pspace_relation_None:
+  "\<lbrakk>pspace_relation p p'; p' ptr = None \<rbrakk> \<Longrightarrow> p ptr = None"
+  apply (rule not_Some_eq[THEN iffD1, OF allI, OF notI])
+  apply (drule(1) pspace_relation_absD)
+   apply (case_tac y; clarsimp simp: cte_map_def of_bl_def well_formed_cnode_n_def split: if_splits)
+   subgoal for n
+    apply (drule spec[of _ ptr])
+    apply (drule spec)
+    apply clarsimp
+    apply (drule spec[of _ "replicate n False"])
+    apply (drule mp[OF _ refl])
+     apply (drule mp)
+    subgoal premises by (induct n; simp)
+    apply clarsimp
+    done
+  subgoal for x
+     apply (cases x; clarsimp)
+   apply ((drule spec[of _ 0], fastforce)+)[2]
+   apply (drule spec[of _ ptr])
+   apply (drule spec)
+   apply clarsimp
+   apply (drule mp[OF _ refl])
+   apply (drule spec[of _ 0])
+   subgoal for _ sz by (cases sz; simp add: pageBits_def)
+   done
+  done
 
 lemma no_0_obj'_abstract:
   "(s, s') \<in> state_relation \<Longrightarrow> no_0_obj' s' \<Longrightarrow> kheap s 0 = None"
@@ -161,198 +92,46 @@ lemma asid_low_bits [simp]:
   "asidLowBits = asid_low_bits"
   by (simp add: asid_low_bits_def asidLowBits_def)
 
-lemma pte_at_cross:
-  "\<lbrakk> pte_at p s; pspace_relation (kheap s) (ksPSpace s'); pspace_aligned s; pspace_distinct s \<rbrakk>
-   \<Longrightarrow> pte_at' p s'"
-  apply (drule (2) pspace_distinct_cross)
-  apply (clarsimp simp: pte_at_def obj_at_def typ_at'_def ko_wp_at'_def)
-  apply (prop_tac "p \<in> pspace_dom (kheap s)")
-   apply (clarsimp simp: pspace_dom_def)
-   apply (rule bexI)
-    prefer 2
-    apply fastforce
-   apply (clarsimp simp: ran_def image_iff)
-   apply (rule_tac x="(UCAST(32 \<rightarrow> 8) (p && mask pt_bits >> 2))" in exI)
-   apply (simp add: mask_pt_bits_inner_beauty)
-  apply (clarsimp simp: pspace_relation_def)
-  apply (drule bspec, fastforce)
-  apply (clarsimp simp:)
-  apply (clarsimp simp: pte_relation_def)
-  apply (drule spec[where x="(UCAST(32 \<rightarrow> 8) (p && mask pt_bits >> 2))"])
-  apply (clarsimp)
-   apply (simp add: mask_pt_bits_inner_beauty)
-  apply (clarsimp simp: objBitsKO_def archObjSize_def pteBits_def)
-  apply (clarsimp simp: pte_relation_aligned_def)
-  apply (frule (1) pspace_distinctD')
-  apply (clarsimp simp: objBitsKO_def archObjSize_def pteBits_def word_bits_def)
-  done
-
-lemma pde_at_cross:
-  "\<lbrakk> pde_at p s; pspace_relation (kheap s) (ksPSpace s'); pspace_aligned s; pspace_distinct s \<rbrakk>
-   \<Longrightarrow> pde_at' p s'"
-  apply (drule (2) pspace_distinct_cross)
-  apply (clarsimp simp: pde_at_def obj_at_def typ_at'_def ko_wp_at'_def)
-  apply (prop_tac "p \<in> pspace_dom (kheap s)")
-   apply (clarsimp simp: pspace_dom_def)
-   apply (rule bexI)
-    prefer 2
-    apply fastforce
-   apply (clarsimp simp: ran_def image_iff)
-   apply (rule_tac x="(UCAST(32 \<rightarrow> 12) (p && mask pd_bits >> 2))" in exI)
-   apply (simp add: mask_pd_bits_inner_beauty)
-  apply (clarsimp simp: pspace_relation_def)
-  apply (drule bspec, fastforce)
-  apply (clarsimp simp:)
-  apply (clarsimp simp: pde_relation_def)
-  apply (drule spec[where x="(UCAST(32 \<rightarrow> 12) (p && mask pd_bits >> 2))"])
-  apply (clarsimp)
-   apply (simp add: mask_pd_bits_inner_beauty)
-  apply (clarsimp simp: objBitsKO_def archObjSize_def pdeBits_def)
-  apply (clarsimp simp: pde_relation_aligned_def)
-  apply (frule (1) pspace_distinctD')
-  apply (clarsimp simp: objBitsKO_def archObjSize_def pdeBits_def word_bits_def)
-  done
-
-lemma asid_pool_at_cross:
-  "\<lbrakk> asid_pool_at p s; pspace_relation (kheap s) (ksPSpace s');
-     pspace_aligned s; pspace_distinct s \<rbrakk>
-   \<Longrightarrow> asid_pool_at' p s'"
-  apply (drule (2) pspace_distinct_cross)
-  apply (clarsimp simp: obj_at_def typ_at'_def ko_wp_at'_def)
-  apply (prop_tac "p \<in> pspace_dom (kheap s)")
-   apply (clarsimp simp: pspace_dom_def)
-   apply (rule bexI)
-    prefer 2
-    apply fastforce
-   apply clarsimp
-  apply (clarsimp simp: pspace_relation_def)
-  apply (drule bspec, fastforce)
-  apply (clarsimp simp: other_obj_relation_def split: kernel_object.splits arch_kernel_object.splits)
-  apply (clarsimp simp: objBits_simps)
-  apply (frule (1) pspace_alignedD)
-  apply (rule conjI, simp add: bit_simps archObjSize_def)
-  apply (clarsimp simp: pspace_distinct'_def)
-  apply (drule bspec, fastforce)
-  apply (simp add: objBits_simps archObjSize_def pageBits_def word_bits_def)
-  done
-
-lemma pte_relation_must_pte:
-  "pte_relation m (ArchObj (PageTable pt)) ko \<Longrightarrow> \<exists>pte. ko = (KOArch (KOPTE pte))"
-  apply (case_tac ko)
-   apply (simp_all add:pte_relation_def)
-  apply clarsimp
-  done
-
-lemma is_aligned_pte_offset:
-  "is_aligned pt_ptr pt_bits \<Longrightarrow>
-   is_aligned (pt_ptr + (i << pt_bits)) pt_bits"
-  apply (rule is_aligned_add)
-   apply (erule is_aligned_weaken, simp)
-  apply (simp add: is_aligned_shiftl)
-  done
-
-lemma page_table_at_cross:
-  "\<lbrakk> page_table_at p s; pspace_aligned s; pspace_distinct s; pspace_relation (kheap s) (ksPSpace s') \<rbrakk> \<Longrightarrow>
-   page_table_at' p s'"
-  apply (clarsimp simp: page_table_at'_def)
-  apply (rule context_conjI)
-   apply (clarsimp simp: obj_at_def)
-   apply (frule (1) pspace_alignedD)
-   apply (simp add: bit_simps')
-  apply clarsimp
-  apply (rule pte_at_cross; assumption?)
-  apply (clarsimp simp: obj_at_def pte_at_def  is_aligned_pte_offset pt_bits_def pageBits_def)
-  apply (intro conjI)
-   apply (rule_tac x="ArchObj (PageTable pt)" in exI)
-   apply (intro conjI)
-    apply (subgoal_tac "p + (y << 2) && ~~ mask 10 = p", simp)
-    apply (subst is_aligned_mask_out_add_eq)
-     apply (clarsimp simp: obj_at_def pte_at_def  is_aligned_pte_offset ptBits_def pteBits_def)
-    apply clarsimp
-    defer
-    apply (clarsimp simp: a_type_def)
-   apply (rule is_aligned_add)
-    apply (erule is_aligned_weaken)
-    apply (clarsimp simp: ptBits_def)
-   apply (clarsimp simp: is_aligned_shift)
-  apply (simp add: and_mask_0_iff_le_mask)
-  apply (rule le_mask_shiftl_le_mask[where n=8]; simp add: mask_def)
-  apply (frule word_less_sub_1, simp)
-  done
-
-lemma page_directory_at_cross:
-  "\<lbrakk> page_directory_at p s; pspace_aligned s; pspace_distinct s; pspace_relation (kheap s) (ksPSpace s') \<rbrakk> \<Longrightarrow>
-   page_directory_at' p s'"
-  apply (clarsimp simp: page_directory_at'_def)
-  apply (rule context_conjI)
-   apply (clarsimp simp: obj_at_def)
-   apply (frule (1) pspace_alignedD)
-   apply (simp add: bit_simps')
-  apply clarsimp
-  apply (rule pde_at_cross; assumption?)
-  apply (clarsimp simp: obj_at_def pde_at_def  is_aligned_pte_offset pdBits_def pdeBits_def pd_bits_def pageBits_def)
-  apply (intro conjI)
-   apply (rule_tac x="ArchObj (PageDirectory pd)" in exI)
-   apply (intro conjI)
-    apply (subgoal_tac "p + (y << 2) && ~~ mask 14 = p", simp)
-    apply (subst is_aligned_mask_out_add_eq)
-     apply (clarsimp simp: obj_at_def pte_at_def  is_aligned_pte_offset pdBits_def pdeBits_def)
-    apply clarsimp
-    defer
-    apply (clarsimp simp: a_type_def)
-   apply (rule is_aligned_add)
-    apply (erule is_aligned_weaken)
-    apply (clarsimp simp: ptBits_def)
-   apply (clarsimp simp: is_aligned_shift)
-  apply (simp add: and_mask_0_iff_le_mask)
-  apply (rule le_mask_shiftl_le_mask[where n=12]; simp add: mask_def)
-  apply (frule word_less_sub_1, simp)
-  done
-
-lemma corres_cross_over_asid_pool_at:
-  "\<lbrakk> \<And>s. P s \<Longrightarrow> asid_pool_at p s \<and> pspace_distinct s \<and> pspace_aligned s;
-     corres r P (Q and asid_pool_at' p) f g \<rbrakk> \<Longrightarrow>
-   corres r P Q f g"
-  apply (rule corres_cross_over_guard[where Q="Q and asid_pool_at' p"])
-   apply (drule meta_spec, drule (1) meta_mp, clarsimp)
-   apply (erule asid_pool_at_cross, clarsimp simp: state_relation_def; assumption)
-  apply assumption
-  done
-
-lemma corres_cross_over_pte_at:
-  "\<lbrakk> \<And>s. P s \<Longrightarrow> pte_at p s \<and> pspace_distinct s \<and> pspace_aligned s;
-     corres r P (P' and pte_at' p) f g\<rbrakk> \<Longrightarrow>
-   corres r P P' f g"
-  apply (rule corres_cross_over_guard[where Q="P' and pte_at' p"])
-   apply (drule meta_spec, drule (1) meta_mp, clarsimp)
-   apply (erule pte_at_cross; assumption?)
-   apply (simp add: state_relation_def)
-  apply assumption
-  done
-
-
 lemma getObject_ASIDPool_corres [corres]:
   "p = p' \<Longrightarrow> corres (\<lambda>p p'. p = inv ASIDPool p' o ucast)
           (asid_pool_at p) (asid_pool_at' p')
           (get_asid_pool p) (getObject p')"
   apply (simp add: getObject_def get_asid_pool_def get_object_def split_def)
   apply (rule corres_no_failI)
-   apply wp
-   apply (fastforce simp: typ_at_to_obj_at_arches
-                    dest: no_ofailD[OF no_ofail_asidpool_at'_readObject])
-  apply (clarsimp simp: in_monad loadObject_default_def projectKOs gets_the_def)
+   apply (rule no_fail_pre, wp)
+   apply (clarsimp simp: typ_at'_def ko_wp_at'_def)
+   apply (case_tac ko; simp)
+   apply (rename_tac arch_kernel_object)
+   apply (case_tac arch_kernel_object, simp_all)[1]
+   apply (clarsimp simp: lookupAround2_known1
+                         projectKOs)
+   apply (clarsimp simp: obj_at'_def projectKOs objBits_simps
+                         archObjSize_def)
+   apply (erule (1) ps_clear_lookupAround2)
+     apply simp
+    apply (erule is_aligned_no_overflow)
+   apply simp
+   apply (clarsimp simp add: objBits_simps archObjSize_def
+                      split: option.split)
+  apply (clarsimp simp: in_monad loadObject_default_def projectKOs)
   apply (simp add: bind_assoc exec_gets)
   apply (drule asid_pool_at_ko)
   apply (clarsimp simp: obj_at_def)
   apply (simp add: return_def)
+  apply (simp add: in_magnitude_check objBits_simps
+                   archObjSize_def pageBits_def)
   apply (clarsimp simp: state_relation_def pspace_relation_def)
   apply (drule bspec, blast)
-  apply (clarsimp simp: other_obj_relation_def asid_pool_relation_def obj_at'_def projectKOs)
+  apply (clarsimp simp: other_obj_relation_def asid_pool_relation_def)
   done
 
+lemmas aligned_distinct_asid_pool_atI'
+    = aligned_distinct_obj_atI'[where 'a=asidpool,
+                                simplified, OF _ _ _ refl]
+
 lemma aligned_distinct_relation_asid_pool_atI'[elim]:
   "\<lbrakk> asid_pool_at p s; pspace_relation (kheap s) (ksPSpace s');
-     pspace_aligned' s'; pspace_distinct' s'\<rbrakk>
+     pspace_aligned' s'; pspace_distinct' s' \<rbrakk>
         \<Longrightarrow> asid_pool_at' p s'"
   apply (drule asid_pool_at_ko)
   apply (clarsimp simp add: obj_at_def)
@@ -360,7 +139,7 @@ lemma aligned_distinct_relation_asid_pool_atI'[elim]:
   apply (clarsimp simp: other_obj_relation_def)
   apply (simp split: Structures_H.kernel_object.split_asm
                      arch_kernel_object.split_asm)
-  apply (drule (2) aligned'_distinct'_ko_at'I[where 'a=asidpool]; fastforce?)
+  apply (drule(2) aligned_distinct_asid_pool_atI')
   apply (clarsimp simp: obj_at'_def typ_at'_def ko_wp_at'_def
                         projectKOs)
   done
@@ -369,22 +148,38 @@ lemma getObject_ASIDPool_corres':
   "corres (\<lambda>p p'. p = inv ASIDPool p' o ucast)
           (asid_pool_at p) (pspace_aligned' and pspace_distinct')
           (get_asid_pool p) (getObject p)"
-  by (corresKsimp search: getObject_ASIDPool_corres) fastforce
-
-lemma setObject_asidpool_replies_of'[wp]:
-  "setObject c (asidpool::asidpool) \<lbrace>\<lambda>s. P' (replies_of' s)\<rbrace>"
-  by setObject_easy_cases
-
-lemma setObject_pte_replies_of'[wp]:
-  "setObject c (pte::pte) \<lbrace>\<lambda>s. P' (replies_of' s)\<rbrace>"
-  by setObject_easy_cases
+  apply (rule stronger_corres_guard_imp,
+         rule getObject_ASIDPool_corres)
+   apply auto
+  done
 
-lemma setObject_pde_replies_of'[wp]:
-  "setObject c (pde::pde) \<lbrace>\<lambda>s. P' (replies_of' s)\<rbrace>"
-  by setObject_easy_cases
+lemma storePDE_cte_wp_at'[wp]:
+  "\<lbrace>\<lambda>s. P (cte_wp_at' P' p s)\<rbrace>
+     storePDE ptr val
+   \<lbrace>\<lambda>rv s. P (cte_wp_at' P' p s)\<rbrace>"
+  apply (simp add: storePDE_def)
+  apply (wp setObject_cte_wp_at2'[where Q="\<top>"])
+    apply (clarsimp simp: updateObject_default_def in_monad
+                          projectKO_opts_defs projectKOs)
+   apply (rule equals0I)
+   apply (clarsimp simp: updateObject_default_def in_monad
+                         projectKOs projectKO_opts_defs)
+  apply simp
+  done
 
-crunch storePDE, storePTE
-  for replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
+lemma storePTE_cte_wp_at'[wp]:
+  "\<lbrace>\<lambda>s. P (cte_wp_at' P' p s)\<rbrace>
+     storePTE ptr val
+   \<lbrace>\<lambda>rv s. P (cte_wp_at' P' p s)\<rbrace>"
+  apply (simp add: storePTE_def)
+  apply (wp setObject_cte_wp_at2'[where Q="\<top>"])
+    apply (clarsimp simp: updateObject_default_def in_monad
+                          projectKO_opts_defs projectKOs)
+   apply (rule equals0I)
+   apply (clarsimp simp: updateObject_default_def in_monad
+                         projectKOs projectKO_opts_defs)
+  apply simp
+  done
 
 crunch setIRQState
   for cte_wp_at'[wp]: "\<lambda>s. P (cte_wp_at' P' p s)"
@@ -393,7 +188,7 @@ crunch getIRQSlot
 
 lemma setObject_ASIDPool_corres [corres]:
   "p = p' \<Longrightarrow> a = inv ASIDPool a' o ucast \<Longrightarrow>
-  corres dc (asid_pool_at p) (asid_pool_at' p')
+  corres dc (asid_pool_at p and valid_etcbs) (asid_pool_at' p')
             (set_asid_pool p a) (setObject p' a')"
   apply (simp add: set_asid_pool_def)
   apply (corresKsimp search: setObject_other_corres[where P="\<lambda>_. True"]
@@ -405,7 +200,7 @@ lemma setObject_ASIDPool_corres [corres]:
 
 lemma setObject_ASIDPool_corres':
   "a = inv ASIDPool a' o ucast \<Longrightarrow>
-  corres dc (asid_pool_at p) (pspace_aligned' and pspace_distinct')
+  corres dc (asid_pool_at p and valid_etcbs) (pspace_aligned' and pspace_distinct')
             (set_asid_pool p a) (setObject p a')"
   apply (rule stronger_corres_guard_imp[OF setObject_ASIDPool_corres])
    apply auto
@@ -423,15 +218,23 @@ lemma getObject_PDE_corres [corres]:
      (get_pde p) (getObject p')"
   apply (simp add: getObject_def get_pde_def get_pd_def get_object_def split_def bind_assoc)
   apply (rule corres_no_failI)
-  apply wp
-   apply (fastforce simp: typ_at_to_obj_at_arches dest: no_ofailD[OF no_ofail_pde_at'_readObject])
+   apply (rule no_fail_pre, wp)
+   apply (clarsimp simp: ko_wp_at'_def typ_at'_def lookupAround2_known1)
+   apply (case_tac ko; simp)
+   apply (rename_tac arch_kernel_object)
+   apply (case_tac arch_kernel_object; simp add: projectKOs)
+   apply (clarsimp simp: objBits_def cong: option.case_cong)
+   apply (erule (1) ps_clear_lookupAround2)
+     apply simp
+    apply (erule is_aligned_no_overflow)
+    apply (simp add: objBits_simps archObjSize_def word_bits_def)
    apply simp
-  apply (clarsimp simp: in_monad loadObject_default_def projectKOs gets_the_def)
+  apply (clarsimp simp: in_monad loadObject_default_def projectKOs)
   apply (simp add: bind_assoc exec_gets)
   apply (clarsimp simp: pde_at_def obj_at_def)
   apply (clarsimp simp add: a_type_def return_def
                   split: if_split_asm Structures_A.kernel_object.splits arch_kernel_obj.splits)
-  apply (clarsimp simp: obj_at'_def projectKOs)
+  apply (clarsimp simp: typ_at'_def ko_wp_at'_def)
   apply (simp add: in_magnitude_check objBits_simps archObjSize_def pageBits_def pdeBits_def)
   apply (clarsimp simp: state_relation_def pspace_relation_def)
   apply (drule bspec, blast)
@@ -442,8 +245,8 @@ lemma getObject_PDE_corres [corres]:
   done
 
 lemmas aligned_distinct_pde_atI'
-    = aligned'_distinct'_ko_at'I[where 'a=pde,
-                                simplified, OF _ _ _ _ refl]
+    = aligned_distinct_obj_atI'[where 'a=pde,
+                                simplified, OF _ _ _ refl]
 
 lemma aligned_distinct_relation_pde_atI'[elim]:
   "\<lbrakk> pde_at p s; pspace_relation (kheap s) (ksPSpace s');
@@ -467,7 +270,7 @@ lemma aligned_distinct_relation_pde_atI'[elim]:
   apply (subst(asm) add.commute,
          subst(asm) word_plus_and_or_coroll2)
   apply (clarsimp simp: pde_relation_def)
-  apply (drule(2) aligned_distinct_pde_atI', simp)
+  apply (drule(2) aligned_distinct_pde_atI')
   apply (clarsimp simp: obj_at'_def typ_at'_def ko_wp_at'_def
                         projectKOs)
   done
@@ -503,10 +306,19 @@ lemma get_master_pde_corres [@lift_corres_args, corres]:
     apply (simp add: getObject_def get_pde_def get_pd_def  get_object_def
       split_def bind_assoc pde_relation_aligned_def get_master_pde_def)
     apply (rule corres_no_failI)
-     apply wp
-   apply (fastforce simp: typ_at_to_obj_at_arches dest: no_ofailD[OF no_ofail_pde_at'_readObject])
-    apply (clarsimp simp: in_monad loadObject_default_def gets_the_def
-                          projectKOs and_not_mask_twice)
+     apply (rule no_fail_pre, wp)
+     apply (clarsimp simp: ko_wp_at'_def typ_at'_def lookupAround2_known1)
+     apply (case_tac ko, simp_all)[1]
+     apply (rename_tac arch_kernel_object)
+     apply (case_tac arch_kernel_object, simp_all add: projectKOs)[1]
+     apply (clarsimp simp: objBits_def cong: option.case_cong)
+     apply (erule (1) ps_clear_lookupAround2)
+       apply simp
+      apply (erule is_aligned_no_overflow)
+     apply (simp add: objBits_simps archObjSize_def word_bits_def)
+    apply simp
+    apply (clarsimp simp: in_monad loadObject_default_def
+      projectKOs and_not_mask_twice)
     apply (simp add: bind_assoc exec_gets)
     apply (clarsimp simp: pde_at_def obj_at_def)
     apply (clarsimp split:ARM_A.pde.splits)
@@ -515,14 +327,14 @@ lemma get_master_pde_corres [@lift_corres_args, corres]:
        apply (clarsimp simp add: a_type_def return_def get_pd_def
                   bind_def get_pde_def get_object_def gets_def get_def
                   split: if_split_asm Structures_A.kernel_object.splits arch_kernel_obj.splits)
-       apply (clarsimp simp: obj_at'_def projectKOs)
-       apply (clarsimp simp: objBits_simps archObjSize_def pageBits_def pdeBits_def)
+       apply (clarsimp simp:typ_at'_def ko_wp_at'_def)
+       apply (clarsimp simp: in_magnitude_check objBits_simps archObjSize_def pageBits_def pdeBits_def)
        apply (clarsimp simp:state_relation_def)
        apply (frule_tac x = "(ucast (p && mask pd_bits >> 2))"
                      in pde_relation_alignedD)
          apply assumption
         apply (simp add:mask_pd_bits_inner_beauty)
-       apply (clarsimp simp: pde_relation_aligned_def gets_the_def exec_gets return_def
+       apply (clarsimp simp: pde_relation_aligned_def
                       split: if_splits ARM_H.pde.splits)
        apply (drule_tac p' = "p && ~~ mask 6" in valid_duplicates'_D[rotated])
           apply (simp add:is_aligned_neg_mask is_aligned_weaken[where y = 2])
@@ -542,13 +354,13 @@ lemma get_master_pde_corres [@lift_corres_args, corres]:
       apply (clarsimp simp add: a_type_def return_def get_pd_def
         bind_def get_pde_def get_object_def gets_def get_def
         split: if_split_asm Structures_A.kernel_object.splits arch_kernel_obj.splits)
-      apply (clarsimp simp: obj_at'_def projectKOs)
-      apply (clarsimp simp: objBits_simps archObjSize_def pageBits_def pdeBits_def)
+      apply (clarsimp simp:typ_at'_def ko_wp_at'_def)
+      apply (clarsimp simp: in_magnitude_check objBits_simps archObjSize_def pageBits_def pdeBits_def)
       apply (clarsimp simp:state_relation_def)
       apply (frule_tac x = "(ucast (p && mask pd_bits >> 2))" in pde_relation_alignedD)
         apply assumption
        apply (simp add:mask_pd_bits_inner_beauty)
-      apply (clarsimp simp:pde_relation_aligned_def gets_the_def exec_gets return_def
+      apply (clarsimp simp:pde_relation_aligned_def
         split:if_splits ARM_H.pde.splits)
       apply (drule_tac p' = "p && ~~ mask 6" in valid_duplicates'_D[rotated])
          apply (simp add:is_aligned_neg_mask is_aligned_weaken[where y = 2])
@@ -566,13 +378,13 @@ lemma get_master_pde_corres [@lift_corres_args, corres]:
      apply (clarsimp simp add: a_type_def return_def get_pd_def
        bind_def get_pde_def get_object_def gets_def get_def
        split: if_split_asm Structures_A.kernel_object.splits arch_kernel_obj.splits)
-      apply (clarsimp simp: obj_at'_def projectKOs)
-     apply (clarsimp simp: objBits_simps archObjSize_def pageBits_def pdeBits_def)
+     apply (clarsimp simp:typ_at'_def ko_wp_at'_def)
+     apply (clarsimp simp: in_magnitude_check objBits_simps archObjSize_def pageBits_def pdeBits_def)
      apply (clarsimp simp:state_relation_def)
      apply (frule_tac x = "(ucast (p && mask pd_bits >> 2))" in pde_relation_alignedD)
        apply assumption
       apply (simp add:mask_pd_bits_inner_beauty)
-     apply (clarsimp simp:pde_relation_aligned_def gets_the_def exec_gets return_def
+     apply (clarsimp simp:pde_relation_aligned_def
        split:if_splits ARM_H.pde.splits)
      apply (drule_tac p' = "p && ~~ mask 6" in valid_duplicates'_D[rotated])
         apply (simp add:is_aligned_neg_mask is_aligned_weaken[where y = 2])
@@ -590,8 +402,8 @@ lemma get_master_pde_corres [@lift_corres_args, corres]:
     apply (clarsimp simp add: a_type_def return_def get_pd_def
       bind_def get_pde_def get_object_def gets_def get_def
       split: if_split_asm Structures_A.kernel_object.splits arch_kernel_obj.splits)
-    apply (clarsimp simp: obj_at'_def projectKOs)
-    apply (clarsimp simp: objBits_simps archObjSize_def pageBits_def pdeBits_def)
+    apply (clarsimp simp:typ_at'_def ko_wp_at'_def)
+    apply (clarsimp simp: in_magnitude_check objBits_simps archObjSize_def pageBits_def pdeBits_def)
     apply (clarsimp simp:state_relation_def)
     apply (drule_tac s = a and s' = b and p = "p && ~~ mask 6"
       in aligned_distinct_relation_pde_atI'[rotated -1])
@@ -657,16 +469,24 @@ lemma getObject_PTE_corres [corres]:
      (get_pte p) (getObject p')"
   apply (simp add: getObject_def get_pte_def get_pt_def get_object_def split_def bind_assoc)
   apply (rule corres_no_failI)
-  apply wp
-   apply (fastforce simp: typ_at_to_obj_at_arches dest: no_ofailD[OF no_ofail_pte_at'_readObject])
+   apply (rule no_fail_pre, wp)
+   apply (clarsimp simp: ko_wp_at'_def typ_at'_def lookupAround2_known1)
+   apply (case_tac ko, simp_all)[1]
+   apply (rename_tac arch_kernel_object)
+   apply (case_tac arch_kernel_object, simp_all add: projectKOs)[1]
+   apply (clarsimp simp: objBits_def cong: option.case_cong)
+   apply (erule (1) ps_clear_lookupAround2)
+     apply simp
+    apply (erule is_aligned_no_overflow)
+    apply (simp add: objBits_simps archObjSize_def word_bits_def)
    apply simp
   apply (clarsimp simp: in_monad loadObject_default_def projectKOs)
-  apply (simp add: bind_assoc exec_gets gets_the_def)
+  apply (simp add: bind_assoc exec_gets)
   apply (clarsimp simp: obj_at_def pte_at_def)
   apply (clarsimp simp add: a_type_def return_def
                   split: if_split_asm Structures_A.kernel_object.splits arch_kernel_obj.splits)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (simp add: objBits_simps archObjSize_def pageBits_def pteBits_def)
+  apply (clarsimp simp: typ_at'_def ko_wp_at'_def)
+  apply (simp add: in_magnitude_check objBits_simps archObjSize_def pageBits_def pteBits_def)
   apply (clarsimp simp: state_relation_def pspace_relation_def)
   apply (drule bspec, blast)
   apply (clarsimp simp: other_obj_relation_def pte_relation_def)
@@ -688,8 +508,8 @@ lemma pte_relation_alignedD:
   done
 
 lemmas aligned_distinct_pte_atI'
-    = aligned'_distinct'_ko_at'I[where 'a=pte,
-                                simplified, OF _ _ _ _ refl]
+    = aligned_distinct_obj_atI'[where 'a=pte,
+                                simplified, OF _ _ _ refl]
 
 lemma aligned_distinct_relation_pte_atI'[elim]:
   "\<lbrakk> pte_at p s; pspace_relation (kheap s) (ksPSpace s');
@@ -713,7 +533,7 @@ lemma aligned_distinct_relation_pte_atI'[elim]:
   apply (subst(asm) add.commute,
          subst(asm) word_plus_and_or_coroll2)
   apply (clarsimp simp: pte_relation_def)
-  apply (drule(2) aligned_distinct_pte_atI', simp)
+  apply (drule(2) aligned_distinct_pte_atI')
   apply (clarsimp simp: obj_at'_def typ_at'_def ko_wp_at'_def
                         projectKOs)
   done
@@ -736,11 +556,19 @@ lemma get_master_pte_corres [@lift_corres_args, corres]:
     apply (simp add: getObject_def get_pte_def get_pt_def  get_object_def
       split_def bind_assoc pte_relation_aligned_def get_master_pte_def)
     apply (rule corres_no_failI)
-   apply wp
-   apply (fastforce simp: typ_at_to_obj_at_arches dest: no_ofailD[OF no_ofail_pte_at'_readObject])
+     apply (rule no_fail_pre, wp)
+     apply (clarsimp simp: ko_wp_at'_def typ_at'_def lookupAround2_known1)
+     apply (case_tac ko, simp_all)[1]
+     apply (rename_tac arch_kernel_object)
+     apply (case_tac arch_kernel_object, simp_all add: projectKOs)[1]
+     apply (clarsimp simp: objBits_def cong: option.case_cong)
+     apply (erule (1) ps_clear_lookupAround2)
+       apply simp
+      apply (erule is_aligned_no_overflow)
+     apply (simp add: objBits_simps archObjSize_def word_bits_def)
     apply simp
     apply (clarsimp simp: in_monad loadObject_default_def
-      projectKOs and_not_mask_twice gets_the_def)
+      projectKOs and_not_mask_twice)
     apply (simp add: bind_assoc exec_gets)
     apply (clarsimp simp: pte_at_def obj_at_def)
     apply (clarsimp split:ARM_A.pte.splits)
@@ -749,13 +577,13 @@ lemma get_master_pte_corres [@lift_corres_args, corres]:
       apply (clarsimp simp add: a_type_def return_def get_pt_def
                   bind_def get_pte_def get_object_def gets_def get_def
                   split: if_split_asm Structures_A.kernel_object.splits arch_kernel_obj.splits)
-      apply (clarsimp simp: obj_at'_def projectKOs)
-      apply (clarsimp simp: objBits_simps archObjSize_def pageBits_def pteBits_def)
+      apply (clarsimp simp:typ_at'_def ko_wp_at'_def)
+      apply (clarsimp simp: in_magnitude_check objBits_simps archObjSize_def pageBits_def pteBits_def)
       apply (clarsimp simp:state_relation_def)
       apply (frule_tac x = "(ucast (p && mask pt_bits >> 2))" in pte_relation_alignedD)
         apply assumption
        apply (simp add:mask_pt_bits_inner_beauty)
-      apply (clarsimp simp:pte_relation_aligned_def gets_the_def exec_gets return_def
+      apply (clarsimp simp:pte_relation_aligned_def
         split:if_splits ARM_H.pte.splits)
       apply (drule_tac p' = "p && ~~ mask 6" in valid_duplicates'_D[rotated])
          apply (simp add:is_aligned_weaken[where y = 2] is_aligned_neg_mask)
@@ -773,8 +601,8 @@ lemma get_master_pte_corres [@lift_corres_args, corres]:
      apply (clarsimp simp add: a_type_def return_def get_pt_def
        bind_def get_pte_def get_object_def gets_def get_def
        split: if_split_asm Structures_A.kernel_object.splits arch_kernel_obj.splits)
-      apply (clarsimp simp: obj_at'_def projectKOs)
-     apply (clarsimp simp: objBits_simps archObjSize_def pageBits_def pteBits_def)
+     apply (clarsimp simp:typ_at'_def ko_wp_at'_def)
+     apply (clarsimp simp: in_magnitude_check objBits_simps archObjSize_def pageBits_def pteBits_def)
      apply (clarsimp simp:state_relation_def)
      apply (drule_tac s = a and s' = b and p = "p && ~~ mask 6"
       in aligned_distinct_relation_pte_atI'[rotated -1])
@@ -806,15 +634,15 @@ lemma get_master_pte_corres [@lift_corres_args, corres]:
                bind_def get_pte_def get_object_def gets_def get_def
             split: if_split_asm Structures_A.kernel_object.splits
                    arch_kernel_obj.splits)
-      apply (clarsimp simp: obj_at'_def projectKOs)
-   apply (clarsimp simp: objBits_simps
+   apply (clarsimp simp:typ_at'_def ko_wp_at'_def)
+   apply (clarsimp simp: in_magnitude_check objBits_simps
                          archObjSize_def pageBits_def pteBits_def)
    apply (clarsimp simp:state_relation_def)
    apply (frule_tac x = "(ucast (p && mask pt_bits >> 2))"
                  in pte_relation_alignedD)
      apply assumption
     apply (simp add:mask_pt_bits_inner_beauty)
-   apply (clarsimp simp:pte_relation_aligned_def gets_the_def exec_gets return_def
+   apply (clarsimp simp:pte_relation_aligned_def
      split:if_splits ARM_H.pte.splits)
    apply (drule_tac p' = "p && ~~ mask 6" in valid_duplicates'_D[rotated])
       apply (simp add:is_aligned_weaken[where y = 2] is_aligned_neg_mask)
@@ -858,7 +686,7 @@ lemma get_master_pte_corres':
 lemma setObject_PD_corres [@lift_corres_args, corres]:
   "pde_relation_aligned (p>>2) pde pde' \<Longrightarrow>
          corres dc  (ko_at (ArchObj (PageDirectory pd)) (p && ~~ mask pd_bits)
-                     and pspace_aligned)
+                     and pspace_aligned and valid_etcbs)
                     (pde_at' p)
           (set_pd (p && ~~ mask pd_bits) (pd(ucast (p && mask pd_bits >> 2) := pde)))
           (setObject p pde')"
@@ -874,8 +702,8 @@ lemma setObject_PD_corres [@lift_corres_args, corres]:
    apply (simp add: objBits_simps archObjSize_def word_bits_def)
   apply (clarsimp simp: setObject_def in_monad split_def updateObject_default_def projectKOs)
   apply (simp add: in_magnitude_check objBits_simps archObjSize_def pageBits_def pdeBits_def)
-  apply (clarsimp simp: obj_at_def gets_the_def)
-  apply (clarsimp simp: set_object_def bind_assoc exec_get exec_gets)
+  apply (clarsimp simp: obj_at_def exec_gets)
+  apply (clarsimp simp: set_object_def bind_assoc exec_get)
   apply (clarsimp simp: put_def)
   apply (clarsimp simp: state_relation_def mask_pd_bits_inner_beauty)
   apply (rule conjI)
@@ -900,7 +728,8 @@ lemma setObject_PD_corres [@lift_corres_args, corres]:
    apply (drule bspec, assumption)
    apply clarsimp
    apply (erule (1) obj_relation_cutsE)
-         apply (simp+)[4]
+       apply simp
+      apply simp
      apply clarsimp
      apply (frule (1) pspace_alignedD)
      apply (drule_tac p=x in pspace_alignedD, assumption)
@@ -917,9 +746,13 @@ lemma setObject_PD_corres [@lift_corres_args, corres]:
    apply (simp add: other_obj_relation_def
                split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
   apply (rule conjI)
-   apply (fastforce simp: sc_replies_relation_def sc_replies_of_scs_def map_project_def
-                          scs_of_kh_def opt_map_def projectKO_opts_defs)
-  apply (rule conjI)
+   apply (clarsimp simp: ekheap_relation_def pspace_relation_def)
+   apply (drule(1) ekheap_kheap_dom)
+   apply clarsimp
+   apply (drule_tac x=p in bspec, erule domI)
+   apply (simp add: tcb_relation_cut_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 pd_bits" in allE)+
    apply fastforce
@@ -935,7 +768,7 @@ lemma setObject_PD_corres [@lift_corres_args, corres]:
 lemma setObject_PT_corres [@lift_corres_args, corres]:
   "pte_relation_aligned (p >> 2) pte pte' \<Longrightarrow>
          corres dc  (ko_at (ArchObj (PageTable pt)) (p && ~~ mask pt_bits)
-                     and pspace_aligned)
+                     and pspace_aligned and valid_etcbs)
                     (pte_at' p)
           (set_pt (p && ~~ mask pt_bits) (pt(ucast (p && mask pt_bits >> 2) := pte)))
           (setObject p pte')"
@@ -951,8 +784,8 @@ lemma setObject_PT_corres [@lift_corres_args, corres]:
    apply (simp add: objBits_simps archObjSize_def word_bits_def)
   apply (clarsimp simp: setObject_def in_monad split_def updateObject_default_def projectKOs)
   apply (simp add: in_magnitude_check objBits_simps archObjSize_def pageBits_def pteBits_def)
-  apply (clarsimp simp: obj_at_def gets_the_def)
-  apply (clarsimp simp: set_object_def bind_assoc exec_get exec_gets)
+  apply (clarsimp simp: obj_at_def exec_gets)
+  apply (clarsimp simp: set_object_def bind_assoc exec_get)
   apply (clarsimp simp: put_def)
   apply (clarsimp simp: state_relation_def mask_pt_bits_inner_beauty)
   apply (rule conjI)
@@ -975,7 +808,7 @@ lemma setObject_PT_corres [@lift_corres_args, corres]:
    apply (drule bspec, assumption)
    apply clarsimp
    apply (erule (1) obj_relation_cutsE)
-         apply (simp+)[3]
+       apply simp
       apply clarsimp
       apply (frule (1) pspace_alignedD)
       apply (drule_tac p=x in pspace_alignedD, assumption)
@@ -993,9 +826,13 @@ lemma setObject_PT_corres [@lift_corres_args, corres]:
    apply (simp add: other_obj_relation_def
                split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
   apply (rule conjI)
-   apply (fastforce simp: sc_replies_relation_def sc_replies_of_scs_def map_project_def
-                          scs_of_kh_def opt_map_def projectKO_opts_defs)
-  apply (rule conjI)
+   apply (clarsimp simp: ekheap_relation_def pspace_relation_def)
+   apply (drule(1) ekheap_kheap_dom)
+   apply clarsimp
+   apply (drule_tac x=p in bspec, erule domI)
+   apply (simp add: tcb_relation_cut_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" in allE)+
    apply fastforce
@@ -1011,18 +848,18 @@ lemma setObject_PT_corres [@lift_corres_args, corres]:
 
 lemma storePDE_corres [@lift_corres_args, corres]:
   "pde_relation_aligned (p >> 2) pde pde' \<Longrightarrow>
-  corres dc (pde_at p and pspace_aligned) (pde_at' p) (store_pde p pde) (storePDE p pde')"
+  corres dc (pde_at p and pspace_aligned and valid_etcbs) (pde_at' p) (store_pde p pde) (storePDE p pde')"
   apply (simp add: store_pde_def storePDE_def)
   apply (rule corres_symb_exec_l)
      apply (erule setObject_PD_corres[OF _ refl])
     apply (clarsimp simp: exs_valid_def get_pd_def get_object_def exec_gets bind_assoc
-                          obj_at_def pde_at_def gets_the_def)
+                          obj_at_def pde_at_def)
     apply (clarsimp simp: a_type_def return_def
                     split: Structures_A.kernel_object.splits arch_kernel_obj.splits if_split_asm)
    apply wp
    apply clarsimp
   apply (clarsimp simp: get_pd_def obj_at_def no_fail_def pde_at_def
-                        get_object_def bind_assoc exec_gets gets_the_def)
+                        get_object_def bind_assoc exec_gets)
   apply (clarsimp simp: a_type_def return_def
                   split: Structures_A.kernel_object.splits arch_kernel_obj.splits if_split_asm)
   done
@@ -1030,7 +867,7 @@ lemma storePDE_corres [@lift_corres_args, corres]:
 lemma storePDE_corres':
   "pde_relation_aligned (p >> 2) pde pde' \<Longrightarrow>
   corres dc
-     (pde_at p and pspace_aligned) (pspace_aligned' and pspace_distinct')
+     (pde_at p and pspace_aligned and valid_etcbs) (pspace_aligned' and pspace_distinct')
      (store_pde p pde) (storePDE p pde')"
   apply (rule stronger_corres_guard_imp, rule storePDE_corres)
    apply auto
@@ -1038,25 +875,25 @@ lemma storePDE_corres':
 
 lemma storePTE_corres [@lift_corres_args, corres]:
   "pte_relation_aligned (p>>2) pte pte' \<Longrightarrow>
-  corres dc (pte_at p and pspace_aligned) (pte_at' p) (store_pte p pte) (storePTE p pte')"
+  corres dc (pte_at p and pspace_aligned and valid_etcbs) (pte_at' p) (store_pte p pte) (storePTE p pte')"
   apply (simp add: store_pte_def storePTE_def)
   apply (rule corres_symb_exec_l)
      apply (erule setObject_PT_corres[OF _ refl])
-    apply (clarsimp simp: exs_valid_def get_pt_def get_object_def gets_the_def
+    apply (clarsimp simp: exs_valid_def get_pt_def get_object_def
                           exec_gets bind_assoc obj_at_def pte_at_def)
     apply (clarsimp simp: a_type_def return_def
                     split: Structures_A.kernel_object.splits arch_kernel_obj.splits if_split_asm)
    apply wp
    apply clarsimp
   apply (clarsimp simp: get_pt_def obj_at_def pte_at_def no_fail_def
-                        get_object_def bind_assoc exec_gets gets_the_def)
+                        get_object_def bind_assoc exec_gets)
   apply (clarsimp simp: a_type_def return_def
                   split: Structures_A.kernel_object.splits arch_kernel_obj.splits if_split_asm)
   done
 
 lemma storePTE_corres':
   "pte_relation_aligned (p >> 2) pte pte' \<Longrightarrow>
-  corres dc (pte_at p and pspace_aligned)
+  corres dc (pte_at p and pspace_aligned and valid_etcbs)
             (pspace_aligned' and pspace_distinct')
             (store_pte p pte) (storePTE p pte')"
   apply (rule stronger_corres_guard_imp, rule storePTE_corres)
@@ -1073,6 +910,13 @@ defs checkPDAt_def:
 defs checkPTAt_def:
   "checkPTAt pt \<equiv> stateAssert (page_table_at' pt) []"
 
+lemma pte_relation_must_pte:
+  "pte_relation m (ArchObj (PageTable pt)) ko \<Longrightarrow> \<exists>pte. ko = (KOArch (KOPTE pte))"
+  apply (case_tac ko)
+   apply (simp_all add:pte_relation_def)
+  apply clarsimp
+  done
+
 lemma pde_relation_must_pde:
   "pde_relation m (ArchObj (PageDirectory pd)) ko \<Longrightarrow> \<exists>pde. ko = (KOArch (KOPDE pde))"
   apply (case_tac ko)
@@ -1110,11 +954,12 @@ lemma page_table_at_state_relation:
     split:if_splits)
   apply (drule pte_relation_must_pte)
   apply (drule(1) pspace_distinctD')
-  apply (clarsimp simp:objBits_simps archObjSize_def word_bits_def pteBits_def)
+  apply (clarsimp simp:objBits_simps archObjSize_def)
   apply (rule is_aligned_weaken)
    apply (erule aligned_add_aligned)
     apply (rule is_aligned_shiftl_self)
-   apply simp+
+   apply simp
+  apply (simp add: pteBits_def)
   done
 
 lemma page_directory_at_state_relation:
@@ -1145,13 +990,26 @@ lemma page_directory_at_state_relation:
   apply (clarsimp simp:ucast_ucast_len split:if_splits)
   apply (drule pde_relation_must_pde)
   apply (drule(1) pspace_distinctD')
-  apply (clarsimp simp:objBits_simps archObjSize_def word_bits_def pdeBits_def)
+  apply (clarsimp simp:objBits_simps archObjSize_def)
   apply (rule is_aligned_weaken)
    apply (erule aligned_add_aligned)
     apply (rule is_aligned_shiftl_self)
-   apply simp+
+   apply simp
+  apply (simp add: pdeBits_def)
   done
 
+lemma getPDE_wp:
+  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' (ko::pde) p s \<longrightarrow> Q ko s\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  by (clarsimp simp: getObject_def split_def loadObject_default_def
+                     archObjSize_def in_magnitude_check pdeBits_def
+                     projectKOs in_monad valid_def obj_at'_def objBits_simps)
+
+lemma getPTE_wp:
+  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' (ko::pte) p s \<longrightarrow> Q ko s\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  by (clarsimp simp: getObject_def split_def loadObject_default_def
+                     archObjSize_def in_magnitude_check pteBits_def
+                     projectKOs in_monad valid_def obj_at'_def objBits_simps)
+
 lemmas get_pde_wp_valid = hoare_add_post'[OF get_pde_valid get_pde_wp]
 
 lemma page_table_at_lift:
@@ -1180,16 +1038,36 @@ lemma lookupPTSlot_corres [@lift_corres_args, corres]:
 
 declare in_set_zip_refl[simp]
 
+crunch storePDE
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps mapM_x_wp' simp: crunch_simps)
+
+crunch storePTE
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps mapM_x_wp' simp: crunch_simps)
+
+lemmas storePDE_typ_ats[wp] = typ_at_lifts [OF storePDE_typ_at']
+lemmas storePTE_typ_ats[wp] = typ_at_lifts [OF storePTE_typ_at']
+
+lemma setObject_asid_typ_at' [wp]:
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> setObject p' (v::asidpool) \<lbrace>\<lambda>_ s. P (typ_at' T p s)\<rbrace>"
+  by (wp setObject_typ_at')
+
+lemmas setObject_asid_typ_ats' [wp] = typ_at_lifts [OF setObject_asid_typ_at']
+
+lemma getObject_pte_inv[wp]:
+  "\<lbrace>P\<rbrace> getObject p \<lbrace>\<lambda>rv :: pte. P\<rbrace>"
+  by (simp add: getObject_inv loadObject_default_inv)
+
+lemma getObject_pde_inv[wp]:
+  "\<lbrace>P\<rbrace> getObject p \<lbrace>\<lambda>rv :: pde. P\<rbrace>"
+  by (simp add: getObject_inv loadObject_default_inv)
+
 crunch copyGlobalMappings
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
   (wp: mapM_x_wp')
-end
-
-sublocale Arch < copyGlobalMappings: typ_at_all_props' "copyGlobalMappings newPD"
-  by typ_at_props'
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas copyGlobalMappings_typ_ats[wp] = typ_at_lifts [OF copyGlobalMappings_typ_at']
 
 lemma arch_cap_rights_update:
   "acap_relation c c' \<Longrightarrow>
@@ -1273,13 +1151,13 @@ definition
 
 lemma createMappingEntries_valid_slots' [wp]:
   "\<lbrace>valid_objs' and
-    K (vmsz_aligned base sz \<and> vmsz_aligned vptr sz \<and> ptrFromPAddr base \<noteq> 0) \<rbrace>
+    K (vmsz_aligned' base sz \<and> vmsz_aligned' vptr sz \<and> ptrFromPAddr base \<noteq> 0) \<rbrace>
   createMappingEntries base vptr sz vm_rights attrib pd
   \<lbrace>\<lambda>m. valid_slots' m\<rbrace>, -"
   apply (simp add: createMappingEntries_def)
   apply (rule hoare_pre)
    apply (wp|wpc|simp add: valid_slots'_def valid_mapping'_def)+
-  apply (simp add: vmsz_aligned_def)
+  apply (simp add: vmsz_aligned'_def)
   apply auto
   done
 
@@ -1312,6 +1190,12 @@ lemma page_directory_at_lift:
 lemmas checkPDAt_corres =
   corres_stateAssert_implied_frame[OF page_directory_at_lift, folded checkPDAt_def]
 
+lemma getASID_wp:
+  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' (ko::asidpool) p s \<longrightarrow> Q ko s\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  by (clarsimp simp: getObject_def split_def loadObject_default_def
+                     archObjSize_def in_magnitude_check pageBits_def
+                     projectKOs in_monad valid_def obj_at'_def objBits_simps)
+
 lemma find_pd_for_asid_corres [corres]:
   "asid = asid' \<Longrightarrow> corres (lfr \<oplus> (=)) ((\<lambda>s. valid_arch_state s \<or> vspace_at_asid asid pd s)
                            and valid_vspace_objs and pspace_aligned
@@ -1384,6 +1268,83 @@ lemma setObject_arch:
   apply (wp X | simp)+
   done
 
+lemma setObject_ASID_arch [wp]:
+  "\<lbrace>\<lambda>s. P (ksArchState s)\<rbrace> setObject p (v::asidpool) \<lbrace>\<lambda>_ s. P (ksArchState s)\<rbrace>"
+  apply (rule setObject_arch)
+  apply (simp add: updateObject_default_def)
+  apply wp
+  apply simp
+  done
+
+lemma setObject_PDE_arch [wp]:
+  "\<lbrace>\<lambda>s. P (ksArchState s)\<rbrace> setObject p (v::pde) \<lbrace>\<lambda>_ s. P (ksArchState s)\<rbrace>"
+  apply (rule setObject_arch)
+  apply (simp add: updateObject_default_def)
+  apply wp
+  apply simp
+  done
+
+lemma setObject_PTE_arch [wp]:
+  "\<lbrace>\<lambda>s. P (ksArchState s)\<rbrace> setObject p (v::pte) \<lbrace>\<lambda>_ s. P (ksArchState s)\<rbrace>"
+  apply (rule setObject_arch)
+  apply (simp add: updateObject_default_def)
+  apply wp
+  apply simp
+  done
+
+lemma setObject_ASID_valid_arch [wp]:
+  "\<lbrace>valid_arch_state'\<rbrace> setObject p (v::asidpool) \<lbrace>\<lambda>_. valid_arch_state'\<rbrace>"
+  by (rule valid_arch_state_lift'; wp)
+
+lemma setObject_PDE_valid_arch [wp]:
+  "\<lbrace>valid_arch_state'\<rbrace> setObject p (v::pde) \<lbrace>\<lambda>_. valid_arch_state'\<rbrace>"
+  by (rule valid_arch_state_lift') (wp setObject_typ_at')+
+
+lemma setObject_PTE_valid_arch [wp]:
+  "\<lbrace>valid_arch_state'\<rbrace> setObject p (v::pte) \<lbrace>\<lambda>_. valid_arch_state'\<rbrace>"
+  by (rule valid_arch_state_lift') (wp setObject_typ_at')+
+
+lemma setObject_ASID_ct [wp]:
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setObject p (e::asidpool) \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: setObject_def updateObject_default_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_PDE_ct [wp]:
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setObject p (e::pde) \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: setObject_def updateObject_default_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_pte_ct [wp]:
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setObject p (e::pte) \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: setObject_def updateObject_default_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_ASID_cur_tcb' [wp]:
+  "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> setObject p (e::asidpool) \<lbrace>\<lambda>_ s. cur_tcb' s\<rbrace>"
+  apply (simp add: cur_tcb'_def)
+  apply (rule hoare_lift_Pf [where f=ksCurThread])
+   apply wp+
+  done
+
+lemma setObject_PDE_cur_tcb' [wp]:
+  "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> setObject p (e::pde) \<lbrace>\<lambda>_ s. cur_tcb' s\<rbrace>"
+  apply (simp add: cur_tcb'_def)
+  apply (rule hoare_lift_Pf [where f=ksCurThread])
+   apply wp+
+  done
+
+lemma setObject_pte_cur_tcb' [wp]:
+  "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> setObject p (e::pte) \<lbrace>\<lambda>_ s. cur_tcb' s\<rbrace>"
+  apply (simp add: cur_tcb'_def)
+  apply (rule hoare_lift_Pf [where f=ksCurThread])
+   apply wp+
+  done
+
+
+
 lemma page_directory_pde_at_lookupI':
   "page_directory_at' pd s \<Longrightarrow> pde_at' (lookup_pd_slot pd vptr) s"
   apply (simp add: lookup_pd_slot_def Let_def)
@@ -1404,6 +1365,50 @@ lemma page_table_pte_at_lookupI':
   apply (rule vptr_shiftr_le_2pt[simplified pt_bits_stuff])
   done
 
+lemma storePTE_ctes [wp]:
+  "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> storePTE p pte \<lbrace>\<lambda>_ s. P (ctes_of s)\<rbrace>"
+  apply (rule ctes_of_from_cte_wp_at [where Q=\<top>, simplified])
+  apply (rule storePTE_cte_wp_at')
+  done
+
+lemma storePDE_ctes [wp]:
+  "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> storePDE p pte \<lbrace>\<lambda>_ s. P (ctes_of s)\<rbrace>"
+  apply (rule ctes_of_from_cte_wp_at [where Q=\<top>, simplified])
+  apply (rule storePDE_cte_wp_at')
+  done
+
+
+lemma storePDE_valid_objs [wp]:
+  "\<lbrace>valid_objs' and valid_pde' pde\<rbrace> storePDE p pde \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (simp add: storePDE_def doMachineOp_def split_def)
+  apply (rule hoare_pre)
+   apply (wp hoare_drop_imps|wpc|simp)+
+   apply (rule setObject_valid_objs')
+   prefer 2
+   apply assumption
+  apply (clarsimp simp: updateObject_default_def in_monad)
+  apply (clarsimp simp: valid_obj'_def)
+  done
+
+lemma setObject_ASID_cte_wp_at'[wp]:
+  "\<lbrace>\<lambda>s. P (cte_wp_at' P' p s)\<rbrace>
+     setObject ptr (asid::asidpool)
+   \<lbrace>\<lambda>rv s. P (cte_wp_at' P' p s)\<rbrace>"
+  apply (wp setObject_cte_wp_at2'[where Q="\<top>"])
+    apply (clarsimp simp: updateObject_default_def in_monad
+                          projectKO_opts_defs projectKOs)
+   apply (rule equals0I)
+   apply (clarsimp simp: updateObject_default_def in_monad
+                         projectKOs projectKO_opts_defs)
+  apply simp
+  done
+
+lemma setObject_ASID_ctes_of'[wp]:
+  "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>
+     setObject ptr (asid::asidpool)
+   \<lbrace>\<lambda>rv s. P (ctes_of s)\<rbrace>"
+  by (rule ctes_of_from_cte_wp_at [where Q=\<top>, simplified]) wp
+
 lemma clearMemory_vms':
   "valid_machine_state' s \<Longrightarrow>
    \<forall>x\<in>fst (clearMemory ptr bits (ksMachineState s)).
@@ -1420,7 +1425,7 @@ lemma dmo_clearMemory_invs'[wp]:
   "\<lbrace>invs'\<rbrace> doMachineOp (clearMemory w sz) \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: doMachineOp_def split_def)
   apply wp
-  apply (clarsimp simp: invs'_def valid_dom_schedule'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def)
   apply (rule conjI)
    apply (simp add: valid_irq_masks'_def, elim allEI, clarsimp)
    apply (drule use_valid)
diff --git a/proof/refine/ARM/ArchMove_R.thy b/proof/refine/ARM/ArchMove_R.thy
index 240cb37f0d..627391b298 100644
--- a/proof/refine/ARM/ArchMove_R.thy
+++ b/proof/refine/ARM/ArchMove_R.thy
@@ -17,4 +17,13 @@ lemmas cte_index_repair_sym = cte_index_repair[symmetric]
 
 lemmas of_nat_inj32 = of_nat_inj[where 'a=32, folded word_bits_def]
 
+context begin
+interpretation Arch .
+
+(* Move to Deterministic_AI*)
+crunch copy_global_mappings
+  for valid_etcbs[wp]: valid_etcbs (wp: mapM_x_wp')
+
+end
+
 end
diff --git a/proof/refine/ARM/Arch_R.thy b/proof/refine/ARM/Arch_R.thy
index 5197f7c394..3a05e92571 100644
--- a/proof/refine/ARM/Arch_R.thy
+++ b/proof/refine/ARM/Arch_R.thy
@@ -15,7 +15,7 @@ begin
 
 unbundle l4v_word_context
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 declare is_aligned_shiftl [intro!]
 declare is_aligned_shiftr [intro!]
@@ -69,12 +69,12 @@ lemma descendants_of'_helper:
   done
 
 lemma createObject_typ_at':
-  "\<lbrace>\<lambda>s.  koTypeOf ty = otype \<and> is_aligned ptr (objBitsKO ty) \<and> objBitsKO ty < word_bits \<and>
-         pspace_aligned' s \<and> pspace_bounded' s \<and> pspace_no_overlap' ptr (objBitsKO ty) s\<rbrace>
+  "\<lbrace>\<lambda>s.  koTypeOf ty = otype \<and> is_aligned ptr (objBitsKO ty) \<and>
+         pspace_aligned' s \<and> pspace_no_overlap' ptr (objBitsKO ty) s\<rbrace>
    createObjects' ptr (Suc 0) ty 0
    \<lbrace>\<lambda>rv s. typ_at' otype ptr s\<rbrace>"
   apply (clarsimp simp:createObjects'_def alignError_def split_def | wp unless_wp | wpc )+
-  apply (clarsimp simp:obj_at'_def ko_wp_at'_def typ_at'_def)+
+  apply (clarsimp simp:obj_at'_def ko_wp_at'_def typ_at'_def pspace_distinct'_def)+
   apply (subgoal_tac "ps_clear ptr (objBitsKO ty)
     (s\<lparr>ksPSpace := \<lambda>a. if a = ptr then Some ty else ksPSpace s a\<rparr>)")
   apply (simp add:ps_clear_def)+
@@ -87,11 +87,27 @@ lemma createObject_typ_at':
   apply (subgoal_tac "x \<in> {x..x + 2 ^ objBitsKO y - 1}")
    apply (fastforce simp: p_assoc_help)
   apply (rule first_in_uptoD)
-  apply (frule(1) pspace_alignedD')
-  apply (drule(1) pspace_boundedD')
+  apply (drule(1) pspace_alignedD')
   apply (clarsimp simp: is_aligned_no_wrap' p_assoc_help)
   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>
@@ -138,12 +154,14 @@ lemma performASIDControlInvocation_corres:
     apply (rule corres_split)
        apply (erule deleteObjects_corres)
        apply (simp add:pageBits_def)
-      apply (rule corres_split[OF getSlotCap_corres], simp)
+      apply (rule corres_split[OF getSlotCap_corres])
+         apply simp
         apply (rule_tac F = " pcap = (cap.UntypedCap False word1 pageBits idxa)" in corres_gen_asm)
         apply (rule corres_split[OF updateFreeIndex_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))",
                                         unfolded APIType_map2_def makeObjectKO_def,
                                         THEN createObjects_corres',simplified,
@@ -186,7 +204,7 @@ lemma performASIDControlInvocation_corres:
           apply (simp cong: conj_cong)
           apply (wp createObjects_valid_pspace'
                     [where sz = pageBits and ty="Inl (KOArch (KOASIDPool undefined))"])
-               apply (simp add: makeObjectKO_def)+
+             apply (simp add: makeObjectKO_def)+
            apply (simp add:objBits_simps archObjSize_def range_cover_full)+
           apply (clarsimp simp:valid_cap'_def)
           apply (wp createObject_typ_at'
@@ -194,7 +212,6 @@ lemma performASIDControlInvocation_corres:
           apply (rule descendants_of'_helper)
           apply (wp createObjects_null_filter'
                     [where sz = pageBits and ty="Inl (KOArch (KOASIDPool undefined))"])
-
          apply (clarsimp simp: conj_comms obj_bits_api_def arch_kobj_size_def
                 objBits_simps archObjSize_def default_arch_object_def
                 pred_conj_def)
@@ -212,7 +229,7 @@ lemma performASIDControlInvocation_corres:
                               makeObjectKO_def range_cover_full
                         simp del: capFreeIndex_update.simps
                | strengthen invs_valid_pspace' invs_pspace_aligned'
-                            invs_pspace_distinct' invs_pspace_bounded'
+                            invs_pspace_distinct'
                             exI[where x="makeObject :: asidpool"])+
         apply (wp updateFreeIndex_forward_invs'
           updateFreeIndex_pspace_no_overlap'
@@ -229,7 +246,7 @@ lemma performASIDControlInvocation_corres:
      apply wp+
     apply (clarsimp simp: conj_comms)
     apply (clarsimp simp: conj_comms ex_disj_distrib
-           | strengthen invs_valid_pspace' invs_pspace_aligned' invs_pspace_bounded'
+           | strengthen invs_valid_pspace' invs_pspace_aligned'
                         invs_pspace_distinct')+
     apply (wp deleteObjects_invs'[where p="makePoolParent i'"]
               deleteObjects_cte_wp_at'
@@ -245,27 +262,25 @@ lemma performASIDControlInvocation_corres:
     apply (wp deleteObjects_descendants[where p="makePoolParent i'"]
               deleteObjects_cte_wp_at'
               deleteObjects_null_filter[where p="makePoolParent i'"])
-   apply (clarsimp simp:invs_mdb max_free_index_def invs_untyped_children schact_is_rct)
-   apply (subgoal_tac "detype_locale x y sa" for x y)
-    prefer 2
-    apply (simp add:detype_locale_def)
-    apply (fastforce simp:cte_wp_at_caps_of_state descendants_range_def2
-            empty_descendants_range_in invs_untyped_children)
+   apply (clarsimp simp:invs_mdb max_free_index_def invs_untyped_children)
+   apply (prop_tac "detype_locale x y sa" for x y)
+    apply (simp add: detype_locale_def)
+    apply (fastforce simp: cte_wp_at_caps_of_state descendants_range_def2
+                           empty_descendants_range_in invs_untyped_children)
    apply (intro conjI)
           apply (clarsimp)
          apply (erule(1) caps_of_state_valid)
-        subgoal by (fastforce simp: cte_wp_at_caps_of_state descendants_range_def2
-                                    empty_descendants_range_in)
+        subgoal by (fastforce simp:cte_wp_at_caps_of_state
+                descendants_range_def2 empty_descendants_range_in)
        apply (fold_subgoals (prefix))[2]
-      subgoal premises prems using prems by (clarsimp simp:invs_def valid_state_def)+
+       subgoal premises prems using prems by (clarsimp simp:invs_def valid_state_def)+
      apply (clarsimp simp:cte_wp_at_caps_of_state)
     apply (drule detype_locale.non_null_present)
      apply (fastforce simp:cte_wp_at_caps_of_state)
     apply simp
    apply (frule_tac ptr = "(aa,ba)" in detype_invariants [rotated 3])
-         apply fastforce
-        apply simp
-       apply (clarsimp simp: schact_is_rct)
+        apply fastforce
+       apply simp
       apply (simp add: cte_wp_at_caps_of_state)
      apply (simp add: is_cap_simps)
     apply (simp add:empty_descendants_range_in descendants_range_def2)
@@ -297,7 +312,9 @@ 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 (simp add: detype_def clear_um_def)
+   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)
+  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)+
   apply clarsimp
@@ -329,8 +346,10 @@ lemma performASIDControlInvocation_corres:
    apply (drule (1) cte_cap_in_untyped_range)
         apply (fastforce simp add: cte_wp_at_ctes_of)
        apply assumption+
-     apply (clarsimp simp: invs'_def if_unsafe_then_cap'_def cte_wp_at_ctes_of)
-    apply fastforce+
+     apply (clarsimp simp: invs'_def valid_state'_def if_unsafe_then_cap'_def cte_wp_at_ctes_of)
+    apply fastforce
+   apply simp
+  apply clarsimp
   done
 
 definition
@@ -383,12 +402,12 @@ lemma checkVPAlignment_corres:
   done
 
 lemma checkVP_wpR [wp]:
-  "\<lbrace>\<lambda>s. vmsz_aligned w sz \<longrightarrow> P () s\<rbrace>
+  "\<lbrace>\<lambda>s. vmsz_aligned' w sz \<longrightarrow> P () s\<rbrace>
   checkVPAlignment sz w \<lbrace>P\<rbrace>, -"
   apply (simp add: checkVPAlignment_def unlessE_whenE cong: vmpage_size.case_cong)
   apply (rule hoare_pre)
    apply (wp whenE_wp|wpc)+
-  apply (simp add: is_aligned_mask vmsz_aligned_def)
+  apply (simp add: is_aligned_mask vmsz_aligned'_def)
   done
 
 lemma asidHighBits [simp]:
@@ -508,7 +527,7 @@ lemma resolveVAddr_corres:
   done
 
 lemma decodeARMPageFlush_corres:
-  "\<lbrakk>invocation_type (mi_label mi) = l; ARM_H.isPageFlushLabel l\<rbrakk> \<Longrightarrow>
+  "ARM_H.isPageFlushLabel (invocation_type (mi_label mi)) \<Longrightarrow>
    corres (ser \<oplus> archinv_relation)
            (invs and
             valid_cap (cap.ArchObjectCap (arch_cap.PageCap d word seta vmpage_size option)) and
@@ -537,7 +556,7 @@ lemma decodeARMPageFlush_corres:
                         returnOk $
                         arch_invocation.InvokePage $
                         ARM_A.page_invocation.PageFlush
-                         (label_to_flush_type l) (start + vaddr)
+                         (label_to_flush_type (invocation_type (mi_label mi))) (start + vaddr)
                          (end + vaddr - 1) (addrFromPPtr word + start) pd asid
                     odE
             else throwError ExceptionTypes_A.syscall_error.TruncatedMessage)
@@ -797,7 +816,7 @@ shows
             apply (simp add: lookup_failure_map_def)
            apply simp
           apply (rule_tac P="\<lambda>s. asid_table (asid_high_bits_of word2) = Some word1 \<longrightarrow> asid_pool_at word1 s" and
-                          P'="pspace_aligned' and pspace_distinct' and pspace_bounded'" in corres_inst)
+                          P'="pspace_aligned' and pspace_distinct'" in corres_inst)
           apply (simp add: liftME_return)
           apply (rule whenE_throwError_corres_initial, simp)
            apply auto[1]
@@ -869,7 +888,7 @@ shows
            apply (drule dom_hd_assocsD)
            apply (simp add: select_ext_fa[simplified free_asid_select_def]
                             free_asid_select_def o_def returnOk_liftE[symmetric]
-                 split del: if_split)
+                       split del: if_split)
            apply (thin_tac "fst a \<notin> b \<and> P" for a b P)
            apply (case_tac "isUntypedCap a \<and> capBlockSize a = objBits (makeObject::asidpool)
                             \<and> \<not> capIsDevice a")
@@ -977,7 +996,7 @@ shows
     apply (cases "ARM_H.isPageFlushLabel (invocation_type (mi_label mi))")
      apply (clarsimp simp: ARM_H.isPageFlushLabel_def split del: if_split)
      apply (clarsimp split: invocation_label.splits arch_invocation_label.splits split del: if_split)
-        apply (rule decodeARMPageFlush_corres[simplified];
+        apply (rule decodeARMPageFlush_corres,
                 clarsimp simp: ARM_H.isPageFlushLabel_def)+
     apply (clarsimp simp: ARM_H.isPageFlushLabel_def split del: if_split)
     apply (cases "invocation_type (mi_label mi) = ArchInvocationLabel ARMPageGetAddress")
@@ -1100,7 +1119,7 @@ shows
        apply (wp hoare_drop_imps)+
     apply (clarsimp simp: valid_cap_simps mask_2pm1 linorder_not_le split: option.split)
     apply (intro conjI; (clarsimp)?)
-   apply (clarsimp simp: invs'_def valid_pspace'_def
+   apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
                   split: option.splits)
   apply clarsimp
   done
@@ -1111,7 +1130,6 @@ lemma arch_performInvocation_corres:
      (einvs and ct_active and valid_arch_inv ai and schact_is_rct)
      (invs' and ct_active' and valid_arch_inv' ai' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
      (arch_perform_invocation ai) (Arch.performInvocation ai')"
-  apply add_cur_tcb'
   apply (clarsimp simp: arch_perform_invocation_def
                         ARM_H.performInvocation_def
                         performARMMMUInvocation_def)
@@ -1193,7 +1211,7 @@ lemma performASIDControlInvocation_tcb_at':
   apply clarsimp
   apply (drule(1) cte_cap_in_untyped_range,
     fastforce simp add: cte_wp_at_ctes_of, assumption, simp_all)
-   apply (clarsimp simp: invs'_def if_unsafe_then_cap'_def cte_wp_at_ctes_of)
+   apply (clarsimp simp: invs'_def valid_state'_def if_unsafe_then_cap'_def cte_wp_at_ctes_of)
   apply clarsimp
   done
 
@@ -1210,13 +1228,13 @@ lemma invokeArch_tcb_at':
   apply (wp, clarsimp simp: pred_tcb_at')
   done
 
-end
-
-context begin interpretation Arch .
-
 crunch setThreadState
- for pspace_no_overlap'[wp]: "pspace_no_overlap' w s"
-  (simp: unless_def wp: crunch_wps)
+  for pspace_no_overlap'[wp]: "pspace_no_overlap' w s"
+  (simp: unless_def)
+
+lemma sts_cte_cap_to'[wp]:
+  "\<lbrace>ex_cte_cap_to' p\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. ex_cte_cap_to' p\<rbrace>"
+  by (wp ex_cte_cap_to'_pres)
 
 lemma valid_slots_duplicated_lift':
   assumes ko_wp_at':
@@ -1283,10 +1301,6 @@ crunch
   for vs_entry_align[wp]: "ko_wp_at' (\<lambda>ko. P (vs_entry_align ko)) p"
   (wp: crunch_wps)
 
-crunch setThreadState
-  for sc_at'_n[wp]: "sc_at'_n n p"
-  (simp: crunch_simps wp: crunch_wps)
-
 lemma sts_valid_arch_inv':
   "\<lbrace>valid_arch_inv' ai\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_arch_inv' ai\<rbrace>"
   apply (cases ai, simp_all add: valid_arch_inv'_def)
@@ -1302,7 +1316,7 @@ lemma sts_valid_arch_inv':
   apply clarsimp
   apply (clarsimp simp: valid_apinv'_def split: asidpool_invocation.splits)
   apply (rule hoare_pre, wp)
-  apply (simp add: o_def)
+  apply simp
   done
 
 lemma less_pptrBase_valid_pde_offset':
@@ -1330,7 +1344,7 @@ lemmas less_pptrBase_valid_pde_offset''
     = less_pptrBase_valid_pde_offset'[where x=0, simplified]
 
 lemma createMappingEntries_valid_pde_slots':
-  "\<lbrace>K (vmsz_aligned vptr sz \<and> is_aligned pd pdBits
+  "\<lbrace>K (vmsz_aligned' vptr sz \<and> is_aligned pd pdBits
                 \<and> vptr < pptrBase)\<rbrace>
      createMappingEntries base vptr sz vm_rights attrib pd
    \<lbrace>\<lambda>rv s. valid_pde_slots' rv\<rbrace>,-"
@@ -1340,7 +1354,7 @@ lemma createMappingEntries_valid_pde_slots':
    apply (clarsimp simp: lookup_pd_slot_def Let_def mask_add_aligned)
    apply (erule less_pptrBase_valid_pde_offset'')
   apply (rule hoare_pre, wp)
-  apply (clarsimp simp: vmsz_aligned_def superSectionPDEOffsets_def pdeBits_def del: ballI)
+  apply (clarsimp simp: vmsz_aligned'_def superSectionPDEOffsets_def pdeBits_def del: ballI)
   apply (subst p_0x3C_shift[symmetric])
    apply (simp add: lookup_pd_slot_def Let_def)
    apply (erule aligned_add_aligned)
@@ -1647,29 +1661,25 @@ lemma arch_decodeInvocation_wf[wp]:
       apply (wpsimp simp: valid_arch_inv'_def valid_page_inv'_def)
             apply (rule hoare_vcg_conj_liftE_R,(wp ensureSafeMapping_inv)[1])+
             apply (wpsimp wp: whenE_throwError_wp checkVP_wpR hoare_vcg_const_imp_liftE_R
-                              ensureSafeMapping_valid_slots_duplicated'
+                              hoare_drop_impE_R ensureSafeMapping_valid_slots_duplicated'
                               createMappingEntries_valid_pde_slots' findPDForASID_page_directory_at'
                         simp: valid_arch_inv'_def valid_page_inv'_def)+
-        apply (rule hoare_drop_impE_R)
-        apply (wpsimp wp: whenE_throwError_wp checkVP_wpR hoare_vcg_const_imp_liftE_R
-                          ensureSafeMapping_valid_slots_duplicated'
-                          createMappingEntries_valid_pde_slots' findPDForASID_page_directory_at'
-                    simp: valid_arch_inv'_def valid_page_inv'_def)+
      apply (clarsimp simp: neq_Nil_conv invs_valid_objs' linorder_not_le
                            cte_wp_at_ctes_of)
      apply (drule ctes_of_valid', fastforce)+
      apply (case_tac option; clarsimp, drule_tac t="cteCap cte" in sym, simp)
       apply (clarsimp simp: valid_cap'_def ptBits_def pageBits_def
-                            is_arch_update'_def isCap_simps capAligned_def vmsz_aligned_def
+                            is_arch_update'_def isCap_simps capAligned_def vmsz_aligned'_def
                       cong: conj_cong)
       apply (rule conjI)
-       apply (erule is_aligned_addrFromPPtr_n, case_tac vmpage_size; simp)
+       apply (erule is_aligned_addrFromPPtr_n, case_tac vmpage_size, simp_all)[1]
+      apply (simp add: vmsz_aligned_def)
       apply (rule conjI)
        apply (erule order_le_less_trans[rotated])
        apply (erule is_aligned_no_overflow'[simplified field_simps])
       apply (clarsimp simp: page_directory_at'_def pdBits_eq lookup_pd_slot_eq)+
      apply (clarsimp simp: valid_cap'_def ptBits_def pageBits_def
-                           is_arch_update'_def isCap_simps capAligned_def vmsz_aligned_def
+                           is_arch_update'_def isCap_simps capAligned_def vmsz_aligned'_def
                      cong: conj_cong)
      apply (rule conjI)
       apply (erule is_aligned_addrFromPPtr_n, case_tac vmpage_size, simp_all)[1]
@@ -1775,7 +1785,7 @@ lemma invs_asid_table_strengthen':
   "invs' s \<and> asid_pool_at' ap s \<and> asid \<le> 2 ^ asid_high_bits - 1 \<longrightarrow>
    invs' (s\<lparr>ksArchState :=
             armKSASIDTable_update (\<lambda>_. ((armKSASIDTable \<circ> ksArchState) s)(asid \<mapsto> ap)) (ksArchState s)\<rparr>)"
-  apply (clarsimp simp: invs'_def valid_dom_schedule'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def)
   apply (rule conjI)
    apply (clarsimp simp: valid_global_refs'_def global_refs'_def)
   apply (clarsimp simp: valid_arch_state'_def)
@@ -1841,7 +1851,7 @@ lemma performASIDControlInvocation_invs' [wp]:
          cong: rev_conj_cong)
     apply (clarsimp simp:conj_comms
                          descendants_of_null_filter'
-      | strengthen invs_pspace_aligned' invs_pspace_distinct' invs_pspace_bounded'
+      | strengthen invs_pspace_aligned' invs_pspace_distinct'
           invs_pspace_aligned' invs_valid_pspace')+
     apply (wp updateFreeIndex_forward_invs'
            updateFreeIndex_cte_wp_at
@@ -1852,7 +1862,7 @@ lemma performASIDControlInvocation_invs' [wp]:
            updateCap_cte_wp_at_cases hoare_weak_lift_imp
            getSlotCap_wp)+
   apply (clarsimp simp:conj_comms ex_disj_distrib is_aligned_mask
-           | strengthen invs_valid_pspace' invs_pspace_aligned' invs_pspace_bounded'
+           | strengthen invs_valid_pspace' invs_pspace_aligned'
                         invs_pspace_distinct' empty_descendants_range_in')+
   apply (wp deleteObjects_invs'[where p="makePoolParent aci"]
             hoare_vcg_ex_lift
diff --git a/proof/refine/ARM/Bits_R.thy b/proof/refine/ARM/Bits_R.thy
index 26192f09c8..0cc0a36729 100644
--- a/proof/refine/ARM/Bits_R.thy
+++ b/proof/refine/ARM/Bits_R.thy
@@ -20,10 +20,9 @@ crunch_ignore (add:
   storeWordVM loadWord setRegister getRegister getRestartPC
   debugPrint setNextPC maskInterrupt clearMemory throw_on_false
   unifyFailure ignoreFailure empty_on_failure emptyOnFailure clearMemoryVM null_cap_on_failure
-  setNextPC getRestartPC assertDerived throw_on_false getObject setObject updateObject loadObject
-  ifM andM orM whenM whileM haskell_assert)
+  setNextPC getRestartPC assertDerived throw_on_false getObject setObject updateObject loadObject)
 
-context Arch begin (*FIXME: arch_split*)
+context Arch begin (*FIXME: arch-split*)
 
 crunch_ignore (add:
   invalidateLocalTLB_ASID invalidateLocalTLB_VAASID
@@ -34,7 +33,7 @@ crunch_ignore (add:
 
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma throwE_R: "\<lbrace>\<top>\<rbrace> throw f \<lbrace>P\<rbrace>,-"
   by (simp add: validE_R_def) wp
@@ -57,9 +56,7 @@ lemma isCap_simps:
   "isNotificationCap v = (\<exists>v0 v1 v2 v3. v = NotificationCap v0 v1 v2 v3)"
   "isEndpointCap v = (\<exists>v0 v1 v2 v3 v4 v5. v = EndpointCap v0 v1 v2 v3 v4 v5)"
   "isUntypedCap v = (\<exists>d v0 v1 f. v = UntypedCap d v0 v1 f)"
-  "isReplyCap v = (\<exists>v0 v1. v = ReplyCap v0 v1)"
-  "isSchedContextCap v = (\<exists>v0 v1. v = SchedContextCap v0 v1)"
-  "isSchedControlCap v = (v = SchedControlCap)"
+  "isReplyCap v = (\<exists>v0 v1 v2. v = ReplyCap v0 v1 v2)"
   "isIRQControlCap v = (v = IRQControlCap)"
   "isIRQHandlerCap v = (\<exists>v0. v = IRQHandlerCap v0)"
   "isNullCap v = (v = NullCap)"
@@ -97,27 +94,6 @@ lemma projectKO_ntfn:
   "(projectKO_opt ko = Some t) = (ko = KONotification t)"
   by (cases ko) (auto simp: projectKO_opts_defs)
 
-lemma projectKO_reply:
-  "(projectKO_opt ko = Some t) = (ko = KOReply t)"
-  by (cases ko) (auto simp: projectKO_opts_defs)
-
-lemma reply_of'_KOReply[simp]:
-  "reply_of' (KOReply reply) = Some reply"
-  apply (clarsimp simp: projectKO_reply)
-  done
-
-lemma projectKO_sc:
-  "(projectKO_opt ko = Some t) = (ko = KOSchedContext t)"
-  by (cases ko) (auto simp: projectKO_opts_defs)
-
-lemma sc_of'_Sched[simp]:
-  "sc_of' (KOSchedContext sc) = Some sc"
-  by (simp add: projectKO_sc)
-
-lemma tcb_of'_TCB[simp]:
-  "tcb_of' (KOTCB tcb) = Some tcb"
-  by (simp add: projectKO_tcb)
-
 lemma projectKO_ASID:
   "(projectKO_opt ko = Some t) = (ko = KOArch (KOASIDPool t))"
   by (cases ko)
@@ -145,9 +121,9 @@ lemma projectKO_user_data_device:
 
 
 lemmas projectKOs =
-  projectKO_ntfn projectKO_ep projectKO_cte projectKO_tcb projectKO_reply projectKO_sc
+  projectKO_ntfn projectKO_ep projectKO_cte projectKO_tcb
   projectKO_ASID projectKO_PTE projectKO_PDE projectKO_user_data projectKO_user_data_device
-  projectKO_eq
+  projectKO_eq projectKO_eq2
 
 lemma capAligned_epI:
   "ep_at' p s \<Longrightarrow> capAligned (EndpointCap p a b c d e)"
@@ -175,25 +151,14 @@ lemma capAligned_tcbI:
                   dest!: ko_wp_at_aligned simp: objBits_simps' projectKOs)
   done
 
-lemma capAligned_replyI:
-  "reply_at' p s \<Longrightarrow> capAligned (ReplyCap p r)"
+lemma capAligned_reply_tcbI:
+  "tcb_at' p s \<Longrightarrow> capAligned (ReplyCap p m r)"
   apply (clarsimp simp: obj_at'_real_def capAligned_def
                         objBits_simps word_bits_def capUntypedPtr_def isCap_simps)
   apply (fastforce dest: ko_wp_at_norm
                   dest!: ko_wp_at_aligned simp: objBits_simps' projectKOs)
   done
 
-lemma capAligned_sched_contextI:
-  "\<lbrakk>sc_at'_n r p s; sc_size_bounds r\<rbrakk>
-      \<Longrightarrow> capAligned (SchedContextCap p r)"
-  by (clarsimp simp: obj_at'_real_def capAligned_def sc_size_bounds_def ko_wp_at'_def isCap_simps
-                     objBits_simps word_bits_def capUntypedPtr_def maxUntypedSizeBits_def)
-
-lemma sc_at'_n_sc_at':
-  "sc_at'_n n p s \<Longrightarrow> sc_at' p s"
-  apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKOs)
-  by (case_tac ko; clarsimp)
-
 lemma ko_at_valid_objs':
   assumes ko: "ko_at' k p s"
   assumes vo: "valid_objs' s"
@@ -202,39 +167,6 @@ lemma ko_at_valid_objs':
   by (clarsimp simp: valid_objs'_def obj_at'_def projectKOs
                      project_inject ranI)
 
-lemmas ko_at_valid_objs'_pre =
-  ko_at_valid_objs'[simplified project_inject, atomized, simplified, rule_format]
-
-lemmas ep_ko_at_valid_objs_valid_ep' =
-  ko_at_valid_objs'_pre[where 'a=endpoint, simplified injectKO_defs valid_obj'_def, simplified]
-
-lemmas ntfn_ko_at_valid_objs_valid_ntfn' =
-  ko_at_valid_objs'_pre[where 'a=notification, simplified injectKO_defs valid_obj'_def,
-                        simplified]
-
-lemmas tcb_ko_at_valid_objs_valid_tcb' =
-  ko_at_valid_objs'_pre[where 'a=tcb, simplified injectKO_defs valid_obj'_def, simplified]
-
-lemmas cte_ko_at_valid_objs_valid_cte' =
-  ko_at_valid_objs'_pre[where 'a=cte, simplified injectKO_defs valid_obj'_def, simplified]
-
-lemmas sc_ko_at_valid_objs_valid_sc' =
-  ko_at_valid_objs'_pre[where 'a=sched_context, simplified injectKO_defs valid_obj'_def,
-                        simplified]
-
-lemmas reply_ko_at_valid_objs_valid_reply' =
-  ko_at_valid_objs'_pre[where 'a=reply, simplified injectKO_defs valid_obj'_def, simplified]
-
-(* FIXME: arch split *)
-lemmas pde_ko_at_valid_objs_valid_pde' =
-  ko_at_valid_objs'_pre[where 'a=pde, simplified injectKO_pde valid_obj'_def, simplified]
-
-lemmas pte_ko_at_valid_objs_valid_pte' =
-  ko_at_valid_objs'_pre[where 'a=pte, simplified injectKO_pde valid_obj'_def, simplified]
-
-lemmas asidpool_ko_at_valid_objs_valid_asid_pool' =
-  ko_at_valid_objs'_pre[where 'a=asidpool, simplified injectKO_pde valid_obj'_def, simplified]
-
 lemma obj_at_valid_objs':
   "\<lbrakk> obj_at' P p s; valid_objs' s \<rbrakk> \<Longrightarrow>
   \<exists>k. P k \<and>
@@ -270,9 +202,6 @@ lemma getIdleThread_corres [corres]:
 lemma git_wp [wp]: "\<lbrace>\<lambda>s. P (ksIdleThread s) s\<rbrace> getIdleThread \<lbrace>P\<rbrace>"
   by (unfold getIdleThread_def, wp)
 
-lemma getIdleSc_wp [wp]: "\<lbrace>\<lambda>s. P (ksIdleSC s) s\<rbrace> getIdleSC \<lbrace>P\<rbrace>"
-  by (unfold getIdleSC_def, wp)
-
 lemma gsa_wp [wp]: "\<lbrace>\<lambda>s. P (ksSchedulerAction s) s\<rbrace> getSchedulerAction \<lbrace>P\<rbrace>"
   by (unfold getSchedulerAction_def, wp)
 
diff --git a/proof/refine/ARM/CNodeInv_R.thy b/proof/refine/ARM/CNodeInv_R.thy
index 44035c0cb7..b33fcc3300 100644
--- a/proof/refine/ARM/CNodeInv_R.thy
+++ b/proof/refine/ARM/CNodeInv_R.thy
@@ -15,7 +15,7 @@ begin
 
 unbundle l4v_word_context
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 primrec
   valid_cnode_inv' :: "Invocations_H.cnode_invocation \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -43,6 +43,8 @@ where
        p_cap \<noteq> capability.NullCap) and
     (\<lambda>s. src \<noteq> dest \<longrightarrow> cte_wp_at' (\<lambda>c. cteCap c = NullCap) dest s) and
     (\<lambda>s. ex_cte_cap_to' pivot s \<and> ex_cte_cap_to' dest s))"
+| "valid_cnode_inv' (SaveCaller slot) =
+   (ex_cte_cap_to' slot and cte_wp_at' (\<lambda>c. cteCap c = NullCap) slot)"
 | "valid_cnode_inv' (CancelBadgedSends cap) =
    (valid_cap' cap and K (hasCancelSendRights cap))"
 
@@ -66,6 +68,7 @@ where
 | "cnodeinv_relation (RotateCall sc pc src pvt dst) x = (\<exists>sc' pc'.
    cap_relation sc sc' \<and> cap_relation pc pc' \<and>
    x = Rotate sc' pc' (cte_map src) (cte_map pvt) (cte_map dst))"
+| "cnodeinv_relation (SaveCall p) x = (x = SaveCaller (cte_map p))"
 | "cnodeinv_relation (CancelBadgedSendsCall c) x = (\<exists>c'. cap_relation c c' \<and> x = CancelBadgedSends c')"
 
 
@@ -137,9 +140,9 @@ lemma get_cap_corres':
   by (simp add: get_cap_corres)
 
 lemma cnode_invok_case_cleanup:
-  "i \<notin> {CNodeRevoke, CNodeDelete, CNodeCancelBadgedSends, CNodeRotate}
+  "i \<notin> {CNodeRevoke, CNodeDelete, CNodeCancelBadgedSends, CNodeRotate, CNodeSaveCaller}
         \<Longrightarrow> (case i of CNodeRevoke \<Rightarrow> P | CNodeDelete \<Rightarrow> Q | CNodeCancelBadgedSends \<Rightarrow> R
-                 | CNodeRotate \<Rightarrow> S
+                 | CNodeRotate \<Rightarrow> S | CNodeSaveCaller \<Rightarrow> T
                  | _ \<Rightarrow> U) = U"
   by (simp split: gen_invocation_labels.split)
 
@@ -162,76 +165,91 @@ lemma decodeCNodeInvocation_corres:
     cap' cs')"
   apply (rule decode_cnode_cases2[where args=args and exs=cs and label="mi_label mi"])
         \<comment> \<open>Move / Insert\<close>
-       apply (clarsimp simp: list_all2_Cons1 decode_cnode_invocation_def
-                             decodeCNodeInvocation_def split_def Let_def
-                             unlessE_whenE isCNodeCap_CNodeCap
-                             cnode_invok_case_cleanup
-                  split del: if_split
-                       cong: if_cong list.case_cong)
-       apply (rule corres_guard_imp)
-         apply (rule corres_splitEE)
-            apply (rule lookupSlotForCNodeOp_corres; simp)
-           apply (rule corres_splitEE)
-              apply (rule ensureEmptySlot_corres; simp)
-             apply (rule corres_splitEE)
-                apply (rule lookupSlotForCNodeOp_corres; simp)
-               apply (simp(no_asm) add: liftE_bindE del: de_Morgan_conj split del: if_split)
-               apply (rule corres_split[OF get_cap_corres'])
-                  apply (simp add: split_def)
-                 apply (rule whenE_throwError_corres)
-                   apply (simp add: lookup_failure_map_def)
-                  apply auto[1]
-                 apply (rule_tac r'="\<lambda>a b. fst b = rights_mask_map (fst a)
-                                         \<and> snd b = fst (snd a)
-                                         \<and> snd (snd a) = (gen_invocation_type (mi_label mi)
-                                               \<in> {CNodeMove, CNodeMutate})"
-                            in corres_splitEE)
-                    apply (rule corres_trivial)
-                    subgoal by (auto split: list.split gen_invocation_labels.split,
-                                auto simp: returnOk_def all_rights_def
-                                           rightsFromWord_correspondence)
-                   apply (rule_tac r'=cap_relation in corres_splitEE)
-                      apply (simp add: returnOk_def del: imp_disjL)
-                      apply (rule conjI[rotated], rule impI)
-                       apply (rule deriveCap_corres)
-                        apply (clarsimp simp: cap_relation_mask
-                                              cap_map_update_data
-                                       split: option.split)
-                       apply clarsimp
-                      apply (clarsimp simp: cap_map_update_data
-                                     split: option.split)
+        apply (clarsimp simp: list_all2_Cons1 decode_cnode_invocation_def
+                              decodeCNodeInvocation_def split_def Let_def
+                              unlessE_whenE isCNodeCap_CNodeCap
+                              cnode_invok_case_cleanup
+                   split del: if_split
+                        cong: if_cong list.case_cong)
+        apply (rule corres_guard_imp)
+          apply (rule corres_splitEE)
+             apply (rule lookupSlotForCNodeOp_corres; simp)
+            apply (rule corres_splitEE)
+               apply (rule ensureEmptySlot_corres; simp)
+              apply (rule corres_splitEE)
+                 apply (rule lookupSlotForCNodeOp_corres; simp)
+                apply (simp(no_asm) add: liftE_bindE del: de_Morgan_conj split del: if_split)
+                apply (rule corres_split[OF get_cap_corres'])
+                   apply (simp add: split_def)
+                  apply (rule whenE_throwError_corres)
+                    apply (simp add: lookup_failure_map_def)
+                   apply auto[1]
+                  apply (rule_tac r'="\<lambda>a b. fst b = rights_mask_map (fst a)
+                                          \<and> snd b = fst (snd a)
+                                          \<and> snd (snd a) = (gen_invocation_type (mi_label mi)
+                                                \<in> {CNodeMove, CNodeMutate})"
+                             in corres_splitEE)
                      apply (rule corres_trivial)
-                     subgoal by (auto simp add: whenE_def, auto simp add: returnOk_def)
-                    apply (wp | wpc | simp(no_asm))+
-                apply (wp hoare_vcg_const_imp_liftE_R hoare_vcg_const_imp_lift
-                          hoare_vcg_all_liftE_R hoare_vcg_all_lift lsfco_cte_at' hoare_drop_imps
-                               | clarsimp)+
-        subgoal by (auto elim!: valid_cnode_capI)
-       apply (clarsimp simp: invs'_def valid_pspace'_def)
-      \<comment> \<open>Revoke\<close>
+                     subgoal by (auto split: list.split gen_invocation_labels.split,
+                                 auto simp: returnOk_def all_rights_def
+                                            rightsFromWord_correspondence)
+                    apply (rule_tac r'=cap_relation in corres_splitEE)
+                       apply (simp add: returnOk_def del: imp_disjL)
+                       apply (rule conjI[rotated], rule impI)
+                        apply (rule deriveCap_corres)
+                         apply (clarsimp simp: cap_relation_mask
+                                               cap_map_update_data
+                                        split: option.split)
+                        apply clarsimp
+                       apply (clarsimp simp: cap_map_update_data
+                                      split: option.split)
+                      apply (rule corres_trivial)
+                      subgoal by (auto simp add: whenE_def, auto simp add: returnOk_def)
+                     apply (wp | wpc | simp(no_asm))+
+                 apply (wp hoare_vcg_const_imp_liftE_R hoare_vcg_const_imp_lift
+                           hoare_vcg_all_liftE_R hoare_vcg_all_lift lsfco_cte_at' hoare_drop_imps
+                                | clarsimp)+
+         subgoal by (auto elim!: valid_cnode_capI)
+        apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+       \<comment> \<open>Revoke\<close>
+       apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
+                        isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split)
+       apply (rule corres_guard_imp, rule corres_splitEE)
+            apply (rule lookupSlotForCNodeOp_corres; simp)
+           apply (simp add: split_beta)
+           apply (rule corres_returnOkTT)
+           apply simp
+          apply wp+
+        apply (auto elim!: valid_cnode_capI)[1]
+       apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+      \<comment> \<open>Delete\<close>
       apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
                        isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split)
-      apply (rule corres_guard_imp, rule corres_splitEE)
+      apply (rule corres_guard_imp)
+        apply (rule corres_splitEE)
            apply (rule lookupSlotForCNodeOp_corres; simp)
           apply (simp add: split_beta)
           apply (rule corres_returnOkTT)
           apply simp
          apply wp+
        apply (auto elim!: valid_cnode_capI)[1]
-      apply (clarsimp simp: invs'_def valid_pspace'_def)
-     \<comment> \<open>Delete\<close>
+      apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+     \<comment> \<open>SaveCall\<close>
      apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
                       isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split)
      apply (rule corres_guard_imp)
        apply (rule corres_splitEE)
           apply (rule lookupSlotForCNodeOp_corres; simp)
          apply (simp add: split_beta)
-         apply (rule corres_returnOkTT)
-         apply simp
-        apply wp+
+         apply (rule corres_split_norE)
+            apply (rule ensureEmptySlot_corres)
+            apply simp
+           apply (rule corres_returnOkTT)
+           apply simp
+          apply (wp hoare_drop_imps)+
       apply (auto elim!: valid_cnode_capI)[1]
-     apply (clarsimp simp: invs'_def valid_pspace'_def)
-   \<comment> \<open>CancelBadgedSends\<close>
+     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+    \<comment> \<open>CancelBadgedSends\<close>
     apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
                      isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split)
     apply (rule corres_guard_imp)
@@ -248,7 +266,7 @@ lemma decodeCNodeInvocation_corres:
       apply (rule hoare_trivE_R[where P="\<top>"])
       apply (wpsimp simp: cte_wp_at_ctes_of pred_conj_def)
      apply (fastforce elim!: valid_cnode_capI simp: invs_def valid_state_def valid_pspace_def)
-    apply (clarsimp simp: invs'_def valid_pspace'_def)
+    apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
    \<comment> \<open>Rotate\<close>
    apply (frule list_all2_lengthD)
    apply (clarsimp simp: list_all2_Cons1)
@@ -261,7 +279,7 @@ lemma decodeCNodeInvocation_corres:
        apply (rule corres_splitEE, (rule lookupSlotForCNodeOp_corres; simp))+
            apply (rule_tac R = "\<lambda>s. cte_at pivot_slot s \<and> cte_at dest_slot s
                                   \<and> cte_at src_slot s \<and> invs s" in
-                           whenE_throwError_corres' [where R' = \<top>])
+             whenE_throwError_corres' [where R' = \<top>])
              apply simp
             apply (elim conjE)
             apply rule
@@ -273,8 +291,7 @@ lemma decodeCNodeInvocation_corres:
             apply (drule (2) cte_map_inj_eq, clarsimp+)[1]
            apply (rule corres_split_norE)
               apply (rule_tac F = "(src_slot \<noteq> dest_slot) = (srcSlot \<noteq> destSlot)"
-                          and P = "\<lambda>s. cte_at src_slot s \<and> cte_at dest_slot s \<and> invs s"
-                          and P' = invs' in corres_req)
+                and P = "\<lambda>s. cte_at src_slot s \<and> cte_at dest_slot s \<and> invs s" and P' = invs' in corres_req)
                apply simp
                apply rule
                 apply clarsimp
@@ -303,9 +320,17 @@ lemma decodeCNodeInvocation_corres:
                  apply simp
                  apply (intro conjI)
                   apply (erule cap_map_update_data)+
-                apply (wp hoare_drop_imps hoare_vcg_if_lift_ER)+
-    apply (fastforce elim!: valid_cnode_capI)
-   apply (clarsimp dest!: list_all2_lengthD simp: invs'_def valid_pspace'_def)
+                apply (wp hoare_drop_imps)+
+          apply simp
+          apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid')
+         apply (simp add: if_apply_def2)
+         apply (wp hoare_drop_imps)
+        apply wp
+       apply simp
+       apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid' hoare_drop_imps
+                 | simp add: if_apply_def2 del: de_Morgan_conj split del: if_split)+
+    apply (auto elim!: valid_cnode_capI)[1]
+   apply (clarsimp dest!: list_all2_lengthD simp: invs'_def valid_state'_def valid_pspace'_def)
   \<comment> \<open>Errors\<close>
   apply (elim disjE)
      apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
@@ -333,7 +358,7 @@ lemma decodeCNodeInvocation_corres:
              split del: if_split cong: if_cong)
   apply (rule corres_guard_imp)
     apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres _ wp_post_tautE wp_post_tautE])
-      apply (clarsimp simp: list_all2_Cons1 split: list.split_asm)
+      apply simp
      apply simp
     apply (clarsimp simp: list_all2_Cons1 list_all2_Nil
                    split: list.split_asm split del: if_split)
@@ -405,44 +430,49 @@ lemma decodeCNodeInv_wf[wp]:
      (CNodeCap w n w2 n2) cs
    \<lbrace>valid_cnode_inv'\<rbrace>, -"
   apply (rule decode_cnode_cases2[where label=label and args=args and exs=cs])
-       \<comment> \<open>Move/Insert\<close>
-       apply (simp add: decodeCNodeInvocation_def isCNodeCap_CNodeCap
-                        split_def cnode_invok_case_cleanup unlessE_whenE
+        \<comment> \<open>Move/Insert\<close>
+        apply (simp add: decodeCNodeInvocation_def isCNodeCap_CNodeCap
+                         split_def cnode_invok_case_cleanup unlessE_whenE
+                   cong: if_cong bool.case_cong list.case_cong)
+        apply (rule hoare_pre)
+         apply (wp whenE_throwError_wp)
+               apply (rule deriveCap_Null_helper)
+               apply (simp add: imp_conjR)
+               apply ((wp deriveCap_derived deriveCap_untyped_derived
+                 | wp (once) hoare_drop_imps)+)[1]
+              apply (wp whenE_throwError_wp getCTE_wp | wpc | simp(no_asm))+
+           apply (rule_tac Q'="\<lambda>rv. invs' and cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) destSlot
+                                          and ex_cte_cap_to' destSlot"
+                                   in hoare_strengthen_postE_R, wp)
+           apply (clarsimp simp: cte_wp_at_ctes_of)
+           apply (frule invs_valid_objs')
+           apply (simp add: ctes_of_valid' valid_updateCapDataI
+                            weak_derived_updateCapData capBadge_updateCapData_True
+                            badge_derived_updateCapData
+                            badge_derived_mask untyped_derived_eq_maskCapRights
+                            untyped_derived_eq_updateCapData
+                            untyped_derived_eq_refl)
+           apply (auto simp:isCap_simps updateCapData_def)[1]
+          apply (wp ensureEmptySlot_stronger | simp | wp (once) hoare_drop_imps)+
+       \<comment> \<open>Revoke\<close>
+       apply (simp add: decodeCNodeInvocation_def isCNodeCap_CNodeCap split_def
+                        unlessE_whenE
                   cong: if_cong bool.case_cong list.case_cong)
        apply (rule hoare_pre)
-        apply (wp whenE_throwError_wp)
-              apply (rule deriveCap_Null_helper)
-              apply (simp add: imp_conjR)
-              apply ((wp deriveCap_derived deriveCap_untyped_derived
-                     | wp (once) hoare_drop_imps)+)[1]
-             apply (wp whenE_throwError_wp getCTE_wp | wpc | simp(no_asm))+
-          apply (rule_tac Q'="\<lambda>rv. invs' and cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) destSlot
-                                         and ex_cte_cap_to' destSlot"
-                                  in hoare_strengthen_postE_R, wp)
-          apply (clarsimp simp: cte_wp_at_ctes_of)
-          apply (frule invs_valid_objs')
-          apply (simp add: ctes_of_valid' valid_updateCapDataI
-                           weak_derived_updateCapData capBadge_updateCapData_True
-                           badge_derived_updateCapData
-                           untyped_derived_eq_maskCapRights
-                           untyped_derived_eq_updateCapData
-                           untyped_derived_eq_refl)
-          apply (auto simp:isCap_simps updateCapData_def)[1]
-         apply (wp ensureEmptySlot_stronger | simp | wp (once) hoare_drop_imps)+
-      \<comment> \<open>Revoke\<close>
+        apply (wp lsfco_cte_at' | simp)+
+       apply clarsimp
+      \<comment> \<open>Delete\<close>
       apply (simp add: decodeCNodeInvocation_def isCNodeCap_CNodeCap split_def
                        unlessE_whenE
                  cong: if_cong bool.case_cong list.case_cong)
       apply (rule hoare_pre)
        apply (wp lsfco_cte_at' | simp)+
       apply clarsimp
-     \<comment> \<open>Delete\<close>
+     \<comment> \<open>SaveCaller\<close>
      apply (simp add: decodeCNodeInvocation_def isCNodeCap_CNodeCap split_def
-                      unlessE_whenE
-                cong: if_cong bool.case_cong list.case_cong)
+                      unlessE_whenE)
      apply (rule hoare_pre)
-      apply (wp lsfco_cte_at' | simp)+
-     apply clarsimp
+      apply (wp lsfco_cte_at' | simp | wp (once) hoare_drop_imps)+
     \<comment> \<open>CancelBadgedSends\<close>
     apply (simp add: decodeCNodeInvocation_def isCNodeCap_CNodeCap split_def
                      unlessE_whenE)
@@ -485,29 +515,37 @@ lemma decodeCNodeInvocation_inv[wp]:
                      fst_conv snd_conv, simp)
   apply (rule decode_cnode_cases2[where label=label and args=args and exs=cs])
         apply (simp_all add: decodeCNodeInvocation_def isCNodeCap_CNodeCap split_def
-                             Let_def whenE_def unlessE_def cnode_invok_case_cleanup)[5]
-        apply (fold_subgoals (prefix))[5]
+                             Let_def whenE_def unlessE_def cnode_invok_case_cleanup
+                  split del: if_split cong del: if_cong)[6]
+        apply (fold_subgoals (prefix))[6]
         subgoal premises prems
         by (safe intro!: hoare_pre[where P=P],
                 (wp hoare_drop_imps | simp | wpcw)+)
   apply (elim disjE exE conjE,
          simp_all add: decodeCNodeInvocation_def isCNodeCap_CNodeCap
                        cnode_invok_case_cleanup unlessE_whenE
-                split: list.split_asm)
+                split: list.split_asm split del: if_split)
   apply (simp_all split: list.split add: unlessE_whenE)
   apply safe
   apply (wp | simp)+
   done
+
 text \<open>Various proofs about the two recursive deletion operations.
         These call out to various functions in Tcb and Ipc, and are
         thus better proved here than in CSpace_R.\<close>
 
 text \<open>Proving the termination of rec_del\<close>
 
+crunch cancel_ipc
+  for typ_at[wp]: "\<lambda>s. P (typ_at T p s)"
+  (wp: crunch_wps hoare_vcg_if_splitE simp: crunch_simps)
+
 declare if_split [split]
 
 text \<open>Proving desired properties about rec_del/cap_delete\<close>
 
+declare of_nat_power [simp del]
+
 (* FIXME: pull up *)
 declare word_unat_power [symmetric, simp del]
 
@@ -529,12 +567,6 @@ lemma not_recursive_ctes_irq_state_independent[simp, intro!]:
   "not_recursive_ctes (s \<lparr> ksMachineState := ksMachineState s \<lparr> irq_state := x \<rparr>\<rparr>) = not_recursive_ctes s"
   by (simp add: not_recursive_ctes_def)
 
-lemma not_recursive_ctes_independent_simple[simp]:
-  "not_recursive_ctes (ksCurTime_update f s) = not_recursive_ctes s"
-  "not_recursive_ctes (ksConsumedTime_update f' s) = not_recursive_ctes s"
-  "not_recursive_ctes (ksMachineState_update f'' s) = not_recursive_ctes s"
-  by (simp add: not_recursive_ctes_def)+
-
 lemma capSwap_not_recursive:
   "\<lbrace>\<lambda>s. card (not_recursive_ctes s) \<le> n
      \<and> cte_wp_at' (\<lambda>cte. \<not> (isZombie (cteCap cte) \<and> capZombiePtr (cteCap cte) = p1)) p1 s
@@ -586,46 +618,18 @@ lemma suspend_ctes_of_thread:
   apply (case_tac cte, simp)
   done
 
-lemma schedContextUnbindTCB_ctes_of[wp]:
-  "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>
-     schedContextUnbindTCB t
-   \<lbrace>\<lambda>_ s. P (ctes_of s)\<rbrace>"
-  apply (wpsimp simp: schedContextUnbindTCB_def wp: threadSet_ctes_ofT)
-     apply (clarsimp simp: ran_def tcb_cte_cases_def split: if_splits)
-  by wpsimp+
-
-crunch setConsumed, schedContextCompleteYieldTo, unbindNotification, unbindFromSC
-  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  (simp: crunch_simps wp: crunch_wps)
-
-lemma schedContextUnbindTCB_ctes_of_thread:
-  "schedContextUnbindTCB t' \<lbrace>\<lambda>s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>"
-  by wp
-
-lemma schedContextCompleteYieldTo_ctes_of_thread:
-  "schedContextCompleteYieldTo t' \<lbrace>\<lambda>s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>"
-  by wp
-
-lemma getSchedContext_ctes_of_thread:
-  "getSchedContext t' \<lbrace>\<lambda>s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>"
-  by wpsimp
-
 lemma unbindNotification_ctes_of_thread:
-  "unbindNotification t' \<lbrace>\<lambda>s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>"
-  by wp
-
-lemma unbindFromSC_ctes_of_thread:
-  "unbindFromSC t' \<lbrace>\<lambda>s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>"
+  "\<lbrace>\<lambda>s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>
+     unbindNotification t
+   \<lbrace>\<lambda>rv s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>"
   by wp
 
 lemma prepareThreadDelete_ctes_of_thread:
-  "prepareThreadDelete t' \<lbrace>\<lambda>s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>"
+  "\<lbrace>\<lambda>s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>
+     prepareThreadDelete t
+   \<lbrace>\<lambda>rv s. \<exists>node. ctes_of s x = Some (CTE (ThreadCap t) node)\<rbrace>"
   by (wpsimp simp: prepareThreadDelete_def)
 
-crunch schedContextCancelYieldTo, tcbReleaseRemove, tcbSchedDequeue, unbindFromSC
-  for cteCaps_of[wp]: "\<lambda>s. P (cteCaps_of s)"
-  (wp: crunch_wps simp: crunch_simps)
-
 lemma suspend_not_recursive_ctes:
   "\<lbrace>\<lambda>s. P (not_recursive_ctes s)\<rbrace>
      suspend t
@@ -633,19 +637,28 @@ lemma suspend_not_recursive_ctes:
   apply (simp only: suspend_def not_recursive_ctes_def cteCaps_of_def)
   unfolding updateRestartPC_def
   apply (wp threadSet_ctes_of | simp add: unless_def del: o_apply)+
-         apply (fold cteCaps_of_def)
-         apply (wp gts_wp' stateAssert_wp hoare_vcg_all_lift hoare_drop_imps)+
+   apply (fold cteCaps_of_def)
+   apply (wp cancelIPC_cteCaps_of)
   apply (clarsimp elim!: rsubst[where P=P] intro!: set_eqI)
+  apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def)
+  apply (auto simp: isCap_simps finaliseCap_def Let_def)
   done
 
-crunch schedContextUnbindTCB, schedContextCompleteYieldTo, unbindNotification,
-         prepareThreadDelete, unbindFromSC
-  for not_recursive_ctes[wp]: "\<lambda>s. P (not_recursive_ctes s)"
-  (simp: not_recursive_ctes_def cteCaps_of_def wp: threadSet_ctes_of)
+lemma unbindNotification_not_recursive_ctes:
+  "\<lbrace>\<lambda>s. P (not_recursive_ctes s)\<rbrace>
+     unbindNotification t
+   \<lbrace>\<lambda>rv s. P (not_recursive_ctes s)\<rbrace>"
+  apply (simp only: not_recursive_ctes_def cteCaps_of_def)
+  apply wp
+  done
 
-lemma preemptionPoint_not_recursive_ctes[wp]:
-  "preemptionPoint \<lbrace>\<lambda>s. P (not_recursive_ctes s)\<rbrace>"
-  by (wpsimp wp: preemptionPoint_inv simp: not_recursive_ctes_def)
+lemma prepareThreadDelete_not_recursive_ctes:
+  "\<lbrace>\<lambda>s. P (not_recursive_ctes s)\<rbrace>
+     prepareThreadDelete t
+   \<lbrace>\<lambda>rv s. P (not_recursive_ctes s)\<rbrace>"
+  apply (simp only: prepareThreadDelete_def cteCaps_of_def)
+  apply wp
+  done
 
 definition
   finaliseSlot_recset :: "((word32 \<times> bool \<times> kernel_state) \<times> (word32 \<times> bool \<times> kernel_state)) set"
@@ -665,8 +678,21 @@ lemma finaliseSlot_recset_wf: "wf finaliseSlot_recset"
   by (intro wf_sum_wf wf_rdcall_finalise_ord_lift wf_measure
             wf_inv_image wf_lex_prod wf_less_than)
 
-crunch getRefills, isCurDomainExpired
-  for inv[wp]: P
+lemma in_preempt':
+  "(Inr rv, s') \<in> fst (preemptionPoint s) \<Longrightarrow>
+   \<exists>f g. s' = ksWorkUnitsCompleted_update f
+      (s \<lparr> ksMachineState := ksMachineState s \<lparr> irq_state := g (irq_state (ksMachineState s)) \<rparr>\<rparr>)"
+  apply (simp add: preemptionPoint_def alternative_def in_monad eq_commute
+                   getActiveIRQ_def doMachineOp_def split_def
+                   select_f_def select_def getWorkUnits_def setWorkUnits_def
+                   modifyWorkUnits_def return_def returnOk_def
+              split: option.splits if_splits)
+   apply (erule disjE)
+     apply (cases "workUnitsLimit \<le> ksWorkUnitsCompleted s + 1", drule (1) mp,
+            rule exI[where x="\<lambda>x. 0"], rule exI[where x=Suc], force,
+            rule exI[where x="\<lambda>x. x + 1"], rule exI[where x=id], force)+
+  apply (rule exI[where x="\<lambda>x. x + 1"], rule exI[where x=id], force)
+  done
 
 lemma updateCap_implies_cte_at:
   "(rv, s') \<in> fst (updateCap ptr cap s)
@@ -682,16 +708,11 @@ lemma case_Zombie_assert_fold:
        = assertE (isZombie cap \<longrightarrow> P (capZombiePtr cap))"
   by (cases cap, simp_all add: isCap_simps assertE_def)
 
-lemma preemptionPoint_ctes_of:
-  "preemptionPoint \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
-  apply (wpsimp wp: preemptionPoint_inv)
-  done
-
 termination finaliseSlot'
   apply (rule finaliseSlot'.termination,
          rule finaliseSlot_recset_wf)
    apply (simp add: finaliseSlot_recset_def wf_sum_def)
-  apply (clarsimp simp: in_monad)
+  apply (clarsimp simp: in_monad dest!: in_preempt')
   apply (drule in_inv_by_hoareD [OF isFinalCapability_inv])
   apply (frule use_valid [OF _ getCTE_cte_wp_at, OF _ TrueI])
   apply (drule in_inv_by_hoareD [OF getCTE_inv])
@@ -702,7 +723,6 @@ termination finaliseSlot'
    apply (frule use_valid [OF _ getCTE_cte_wp_at, OF _ TrueI])
    apply (drule in_inv_by_hoareD [OF getCTE_inv])
    apply clarsimp
-   apply (erule use_valid [OF _ preemptionPoint_not_recursive_ctes])
    apply (erule use_valid [OF _ capSwap_not_recursive])
    apply (simp add: cte_wp_at_ctes_of)
    apply (frule updateCap_implies_cte_at)
@@ -715,18 +735,14 @@ termination finaliseSlot'
       apply simp
      apply (clarsimp simp: finaliseCap_def Let_def isCap_simps in_monad
                            getThreadCSpaceRoot_def locateSlot_conv)
-     apply (intro conjI)
-      apply (erule use_valid [OF _ prepareThreadDelete_not_recursive_ctes])
-      apply (erule use_valid [OF _ suspend_not_recursive_ctes])
-      apply (erule use_valid [OF _ unbindFromSC_not_recursive_ctes])
-      apply (erule use_valid [OF _ unbindNotification_not_recursive_ctes])
-      apply (erule use_valid [OF _ stateAssert_inv], simp)
-     apply (frule(1) use_valid [OF _ stateAssert_inv])
      apply (frule(1) use_valid [OF _ unbindNotification_ctes_of_thread, OF _ exI])
-     apply (frule(1) use_valid [OF _ unbindFromSC_ctes_of_thread])
      apply (frule(1) use_valid [OF _ suspend_ctes_of_thread])
      apply (frule(1) use_valid [OF _ prepareThreadDelete_ctes_of_thread])
      apply clarsimp
+     apply (erule use_valid [OF _ prepareThreadDelete_not_recursive_ctes])
+     apply (erule use_valid [OF _ suspend_not_recursive_ctes])
+     apply (erule use_valid [OF _ unbindNotification_not_recursive_ctes])
+     apply simp
     apply (clarsimp simp: finaliseCap_def Let_def isCap_simps in_monad)
    apply (clarsimp simp: finaliseCap_def Let_def isCap_simps in_monad)
   apply (clarsimp simp: in_monad Let_def locateSlot_conv
@@ -735,7 +751,6 @@ termination finaliseSlot'
   apply (clarsimp split: if_split_asm
                    simp: in_monad
                   dest!: in_getCTE)
-    apply (erule use_valid[OF _ preemptionPoint_ctes_of])
     apply (erule use_valid [OF _ updateCap_ctes_of_wp])+
     apply (clarsimp simp: cte_wp_at_ctes_of modify_map_def)
     apply (case_tac ourCTE)
@@ -743,15 +758,13 @@ termination finaliseSlot'
     apply (case_tac rv, simp)
     apply (rename_tac cap' node')
     apply (case_tac cap'; simp)
-   apply (erule use_valid[OF _ preemptionPoint_ctes_of])
    apply (erule use_valid [OF _ updateCap_ctes_of_wp])+
    apply (clarsimp simp: cte_wp_at_ctes_of modify_map_def)
    apply (frule use_valid [OF _ finaliseCap_cases], simp)
    apply (case_tac ourCTE, case_tac rv,
           clarsimp simp: isCap_simps)
    apply (elim disjE conjE exE, simp_all)[1]
-   apply (clarsimp simp: finaliseCap_def Let_def isCap_simps in_monad fst_cte_ptrs_def)
-  apply (erule use_valid[OF _ preemptionPoint_ctes_of])
+   apply (clarsimp simp: finaliseCap_def Let_def isCap_simps in_monad)
   apply (frule use_valid [OF _ finaliseCap_cases], simp)
   apply (case_tac rv, case_tac ourCTE)
   apply (clarsimp simp: isCap_simps cte_wp_at_ctes_of)
@@ -771,11 +784,7 @@ lemma finaliseSlot'_preservation:
     "\<And>sl1 sl2. \<lbrace>P\<rbrace> capSwapForDelete sl1 sl2 \<lbrace>\<lambda>rv. P\<rbrace>"
     "\<And>sl cap. \<lbrace>P\<rbrace> updateCap sl cap \<lbrace>\<lambda>rv. P\<rbrace>"
     "\<And>f s. P (ksWorkUnitsCompleted_update f s) = P s"
-  assumes indep: "irq_state_independent_H P"
-                 "updateTimeStamp_independent P"
-                 "getCurrentTime_independent_H P"
-                 "time_state_independent_H P"
-                 "domain_time_independent_H P"
+  assumes irq: "irq_state_independent_H P"
   shows
     "st \<turnstile> \<lbrace>P\<rbrace> finaliseSlot' slot exposed \<lbrace>\<lambda>rv. P\<rbrace>, \<lbrace>\<lambda>rv. P\<rbrace>"
 proof (induct rule: finalise_spec_induct)
@@ -789,7 +798,7 @@ proof (induct rule: finalise_spec_induct)
         apply (wp "1.hyps")
           apply (unfold Let_def split_def fst_conv snd_conv
                         case_Zombie_assert_fold haskell_fail_def)
-          apply (wp wp preemptionPoint_inv| simp add: o_def indep)+
+          apply (wp wp preemptionPoint_inv| simp add: o_def irq)+
            apply (wp hoare_drop_imps)
           apply (wp wp | simp)+
                apply (wp hoare_drop_imps | simp(no_asm))+
@@ -812,17 +821,13 @@ lemma cteDelete_preservation:
     "\<And>sl1 sl2. \<lbrace>P\<rbrace> capSwapForDelete sl1 sl2 \<lbrace>\<lambda>rv. P\<rbrace>"
     "\<And>sl cap. \<lbrace>P\<rbrace> updateCap sl cap \<lbrace>\<lambda>rv. P\<rbrace>"
     "\<And>f s. P (ksWorkUnitsCompleted_update f s) = P s"
-  assumes indep: "irq_state_independent_H P"
-                 "updateTimeStamp_independent P"
-                 "getCurrentTime_independent_H P"
-                 "time_state_independent_H P"
-                 "domain_time_independent_H P"
+  assumes irq: "irq_state_independent_H P"
   shows
     "\<lbrace>P\<rbrace> cteDelete p e \<lbrace>\<lambda>rv. P\<rbrace>"
   apply (simp add: cteDelete_def whenE_def split_def)
   apply (wp wp)
   apply (simp only: simp_thms cases_simp)
-  apply (wp finaliseSlot_preservation wp indep)
+  apply (wp finaliseSlot_preservation wp irq)
   apply simp
   done
 
@@ -1183,6 +1188,11 @@ lemma ctes_of_strng:
   \<longrightarrow> (\<exists>cte. cte_wp_at' ((=) cte) ptr s \<and> P cte)"
   by (clarsimp simp: cte_wp_at_ctes_of)
 
+lemma updateCap_valid_cap [wp]:
+  "\<lbrace>valid_cap' cap\<rbrace> updateCap ptr cap' \<lbrace>\<lambda>r. valid_cap' cap\<rbrace>"
+  unfolding updateCap_def
+  by (wp setCTE_valid_cap getCTE_wp) (clarsimp dest!: cte_at_cte_wp_atD)
+
 lemma mdb_chain_0_trancl:
   assumes chain: "mdb_chain_0 m"
   and   n0: "no_0 m"
@@ -2067,7 +2077,8 @@ proof -
         done
 
       hence d2n: "dest2_node = dest_node"
-        unfolding dest2_node_def using dsneq by simp
+        unfolding dest2_node_def using dsneq
+        by simp
 
       from trancl obtain d where dnext: "m \<turnstile> d \<leadsto> src" and ncd: "m \<turnstile> c \<leadsto>\<^sup>* d"
         by (clarsimp dest!: tranclD2)
@@ -4483,6 +4494,12 @@ lemma untypedRange_new:
 lemmas range_simps [simp] =
   isUntyped_new capRange_new untypedRange_new
 
+lemma isReplyMaster_eq:
+  "(isReplyCap new \<and> capReplyMaster new)
+      = (isReplyCap old \<and> capReplyMaster old)"
+  using derived
+  by (fastforce simp: weak_derived'_def isCap_simps)
+
 end
 
 lemma master_eqE:
@@ -4782,6 +4799,27 @@ lemma distinct_zombies_n:
   apply (clarsimp simp: weak_der'_def weak_derived'_def)
   done
 
+lemma reply_masters_rvk_fb_m:
+  "reply_masters_rvk_fb m"
+  using valid by auto
+
+lemma reply_masters_rvk_fb_n:
+  "reply_masters_rvk_fb n"
+  using reply_masters_rvk_fb_m
+        weak_der'.isReplyMaster_eq[OF weak_der_src]
+        weak_der'.isReplyMaster_eq[OF weak_der_dest]
+  apply (simp add: reply_masters_rvk_fb_def)
+  apply (frule bspec, rule ranI, rule m_p)
+  apply (frule bspec, rule ranI, rule mdb_ptr_src.m_p)
+  apply (clarsimp simp: ball_ran_eq)
+  apply (case_tac cte, clarsimp)
+  apply (frule n_cap, frule revokable, frule badge_n)
+  apply (simp split: if_split_asm)
+  apply clarsimp
+  apply (elim allE, drule(1) mp)
+  apply simp
+  done
+
 lemma cteSwap_valid_mdb_helper:
   assumes untyped_eq: "isUntypedCap src_cap \<Longrightarrow> scap = src_cap"
                       "isUntypedCap dest_cap \<Longrightarrow> dcap = dest_cap"
@@ -4789,7 +4827,7 @@ lemma cteSwap_valid_mdb_helper:
   using cteSwap_chain cteSwap_dlist_helper cteSwap_valid_badges
         cteSwap_chunked caps_contained untyped_mdb_n untyped_inc_n
         nullcaps_n ut_rev_n class_links_n irq_control_n
-        distinct_zombies_n
+        distinct_zombies_n reply_masters_rvk_fb_n
   by (auto simp:untyped_eq)
 
 end
@@ -4835,9 +4873,9 @@ lemma cteSwap_iflive'[wp]:
   apply auto
   done
 
-crunch updateMDB, updateCap
-  for valid_replies'[wp]: valid_replies'
-  (wp: valid_replies'_lift)
+lemmas tcbSlots =
+  tcbCTableSlot_def tcbVTableSlot_def
+  tcbReplySlot_def tcbCallerSlot_def tcbIPCBufferSlot_def
 
 lemma cteSwap_valid_pspace'[wp]:
   "\<lbrace>valid_pspace' and
@@ -4897,20 +4935,28 @@ lemma cteSwap_valid_pspace'[wp]:
   apply clarsimp+
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 crunch cteSwap
-  for tcb_at [wp]: "tcb_at' t"
-  and sch [wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  and inQ [wp]: "obj_at' (inQ d p) tcb"
-  and ksQ [wp]: "\<lambda>s. P (ksReadyQueues s)"
-  and sym [wp]: "\<lambda>s. sym_refs (state_refs_of' s)"
-  and cur [wp]: "\<lambda>s. P (ksCurThread s)"
-  and ksCurDomain [wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule [wp]:  "\<lambda>s. P (ksDomSchedule s)"
-  and it  [wp]: "\<lambda>s. P (ksIdleThread s)"
-  and ksIdleSC[wp]: "\<lambda>s. P (ksIdleSC s)"
-  and tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. x = tcbDomain tcb) t"
+  for tcb_at[wp]: "tcb_at' t"
+crunch cteSwap
+  for sch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+crunch cteSwap
+  for inQ[wp]: "obj_at' (inQ d p) tcb"
+crunch cteSwap
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s)"
+crunch cteSwap
+  for sym[wp]: "\<lambda>s. sym_refs (state_refs_of' s)"
+crunch cteSwap
+  for cur[wp]: "\<lambda>s. P (ksCurThread s)"
+crunch cteSwap
+  for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
+crunch cteSwap
+  for ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
+crunch cteSwap
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+crunch cteSwap
+  for tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. x = tcbDomain tcb) t"
 
 lemma cteSwap_idle'[wp]:
   "\<lbrace>valid_idle'\<rbrace>
@@ -5007,19 +5053,33 @@ lemma cteSwap_urz[wp]:
 
 crunch cteSwap
   for valid_arch_state'[wp]: "valid_arch_state'"
-  and irq_states'[wp]: "valid_irq_states'"
-  and pde_mappings'[wp]: "valid_pde_mappings'"
-  and vq'[wp]: "valid_queues'"
-  and ksqsL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
-  and ksqsL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
-  and st_tcb_at'[wp]: "st_tcb_at' P t"
-  and vms'[wp]:  "valid_machine_state'"
-  and pspace_domain_valid[wp]:  "pspace_domain_valid"
-  and ct_not_inQ[wp]:  "ct_not_inQ"
-  and ksDomScheduleIdx[wp]:  "\<lambda>s. P (ksDomScheduleIdx s)"
-  and replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
-  and valid_release_queue[wp]: "valid_release_queue"
-  and valid_release_queue'[wp]: "valid_release_queue'"
+
+crunch cteSwap
+  for irq_states'[wp]: "valid_irq_states'"
+
+crunch cteSwap
+  for pde_mappings'[wp]: "valid_pde_mappings'"
+
+crunch cteSwap
+  for ksqsL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+
+crunch cteSwap
+  for ksqsL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+
+crunch cteSwap
+  for st_tcb_at'[wp]: "st_tcb_at' P t"
+
+crunch cteSwap
+  for vms'[wp]: "valid_machine_state'"
+
+crunch cteSwap
+  for pspace_domain_valid[wp]: "pspace_domain_valid"
+
+crunch cteSwap
+  for ct_not_inQ[wp]: "ct_not_inQ"
+
+crunch cteSwap
+  for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
 
 crunch cteSwap
   for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
@@ -5037,14 +5097,14 @@ lemma cteSwap_invs'[wp]:
     K (c1 \<noteq> c2)\<rbrace>
   cteSwap c c1 c' c2
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def pred_conj_def)
+  apply (simp add: invs'_def valid_state'_def pred_conj_def)
   apply (rule hoare_pre)
    apply (wp hoare_vcg_conj_lift sch_act_wf_lift
              valid_queues_lift cur_tcb_lift
              valid_irq_node_lift irqs_masked_lift tcb_in_cur_domain'_lift
              ct_idle_or_in_cur_domain'_lift2)
   apply (clarsimp simp: cte_wp_at_ctes_of weak_derived_zobj weak_derived_cte_refs
-                        weak_derived_capRange_capBits o_def)
+                        weak_derived_capRange_capBits)
   done
 
 lemma capSwap_invs'[wp]:
@@ -5498,17 +5558,13 @@ lemma make_zombie_invs':
                       (\<forall>p \<in> threadCapRefs (cteCap cte).
                             st_tcb_at' ((=) Inactive) p s
                              \<and> bound_tcb_at' ((=) None) p s
-                             \<and> bound_sc_tcb_at' (\<lambda>sco. sco = None \<or> sco = Some idle_sc_ptr) p s
-                             \<and> bound_yt_tcb_at' ((=) None) p s
-                             \<comment> \<open>RT warning: The previous two conjuncts are new, they were
-                                             inserted to fix this lemma.\<close>
                              \<and> obj_at' (Not \<circ> tcbQueued) p s
                              \<and> obj_at' (\<lambda>tcb. tcbSchedNext tcb = None
                                               \<and> tcbSchedPrev tcb = None) p s)) sl s\<rbrace>
     updateCap sl cap
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_mdb'_def
-                   valid_irq_handlers'_def irq_issued'_def valid_dom_schedule'_def)
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def valid_mdb'_def
+                   valid_irq_handlers'_def irq_issued'_def)
   apply (wp updateCap_ctes_of_wp sch_act_wf_lift valid_queues_lift cur_tcb_lift
             updateCap_iflive' updateCap_ifunsafe' updateCap_idle'
             valid_arch_state_lift' valid_irq_node_lift ct_idle_or_in_cur_domain'_lift2
@@ -5516,40 +5572,36 @@ lemma make_zombie_invs':
        | simp)+
   apply clarsimp
   apply (intro conjI[rotated])
-          apply (clarsimp simp: cte_wp_at_ctes_of)
-          apply (auto simp: untypedZeroRange_def isCap_simps)[1]
-         apply (clarsimp simp: modify_map_def ran_def split del: if_split
-                        split: if_split_asm)
-          apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of isCap_simps)
-         subgoal by auto
+        apply (clarsimp simp: cte_wp_at_ctes_of)
+        apply (auto simp: untypedZeroRange_def isCap_simps)[1]
+      apply (clarsimp simp: modify_map_def ran_def split del: if_split
+                     split: if_split_asm)
+       apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of isCap_simps)
+      apply auto[1]
 
-        apply (clarsimp simp: disj_comms cte_wp_at_ctes_of
-                       dest!: ztc_phys capBits_capUntyped_capRange)
-        apply (frule(1) capBits_capUntyped_capRange, simp)
-        apply (clarsimp dest!: valid_global_refsD_with_objSize)
+     apply (clarsimp simp: disj_comms cte_wp_at_ctes_of
+                    dest!: ztc_phys capBits_capUntyped_capRange)
+     apply (frule(1) capBits_capUntyped_capRange, simp)
+     apply (clarsimp dest!: valid_global_refsD_with_objSize)
 
-       apply (clarsimp simp: disj_comms cte_wp_at_ctes_of
-                      dest!: ztc_phys capBits_capUntyped_capRange)
-       apply (frule(1) capBits_capUntyped_capRange, simp)
-       apply (clarsimp dest!: valid_global_refsD_with_objSize)
+     apply (clarsimp simp: disj_comms cte_wp_at_ctes_of
+                    dest!: ztc_phys capBits_capUntyped_capRange)
+     apply (frule(1) capBits_capUntyped_capRange, simp)
+     apply (clarsimp dest!: valid_global_refsD_with_objSize)
 
-     subgoal by (auto elim: if_unsafe_then_capD' simp: isCap_simps)
+    apply (auto elim: if_unsafe_then_capD' simp: isCap_simps)[1]
 
      apply (clarsimp simp: cte_wp_at_ctes_of)
      apply (drule bspec[where x=sl], simp)
      apply (clarsimp simp: isCap_simps)
-
-    apply (clarsimp simp: cte_wp_at_ctes_of)
-    apply (subgoal_tac "st_tcb_at' ((=) Inactive) p' s
-                                \<and> obj_at' (Not \<circ> tcbQueued) p' s
-                                \<and> bound_tcb_at' ((=) None) p' s
-                                \<and> bound_sc_tcb_at' (\<lambda>sco. sco = None \<or> sco = Some idle_sc_ptr) p' s
-                                \<and> bound_yt_tcb_at' ((=) None) p' s")
-     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def ko_wp_at'_def projectKOs)
-    subgoal by (auto dest!: isCapDs)
-
-   apply (simp only: fold_list_refs_of_replies')
-
+   apply (clarsimp simp: cte_wp_at_ctes_of)
+   apply (subgoal_tac "st_tcb_at' ((=) Inactive) p' s
+                               \<and> obj_at' (Not \<circ> tcbQueued) p' s
+                               \<and> bound_tcb_at' ((=) None) p' s
+                               \<and> obj_at' (\<lambda>tcb. tcbSchedNext tcb = None
+                                                \<and> tcbSchedPrev tcb = None) p' s")
+    apply (clarsimp simp: pred_tcb_at'_def obj_at'_def ko_wp_at'_def projectKOs)
+   apply (auto dest!: isCapDs)[1]
   apply (clarsimp simp: cte_wp_at_ctes_of disj_ac
                  dest!: isCapDs)
   apply (frule ztc_phys[where cap=cap])
@@ -5627,15 +5679,19 @@ lemma make_zombie_invs':
            simp add: cteCaps_of_def,
            simp_all add: disj_ac)[1]
     apply (erule(1) ctes_of_valid_cap')
+   apply (rule conjI)
     apply (subgoal_tac "cap \<noteq> IRQControlCap")
      apply (clarsimp simp: irq_control_def)
     apply (clarsimp simp: isCap_simps)
+   apply (simp add: reply_masters_rvk_fb_def, erule ball_ran_fun_updI)
+   apply (clarsimp simp: isCap_simps)
   apply (clarsimp simp: modify_map_apply)
   apply (erule(1) ztc_replace_update_final, simp_all)
    apply (simp add: cteCaps_of_def)
   apply (erule(1) ctes_of_valid_cap')
 done
 
+
 lemma isFinal_Zombie:
   "isFinal (Zombie p' b n) p cs"
   by (simp add: isFinal_def sameObjectAs_def isCap_simps)
@@ -5657,10 +5713,38 @@ lemma shrink_zombie_invs':
   apply (rule ccontr, simp add: linorder_not_less mult.commute mult.left_commute)
   done
 
+crunch suspend
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps getObject_inv_tcb simp: crunch_simps)
+
 lemma cte_wp_at_cteCap_norm:
   "(cte_wp_at' (\<lambda>c. P (cteCap c)) p s) = (\<exists>cap. cte_wp_at' (\<lambda>c. cteCap c = cap) p s \<and> P cap)"
   by (auto simp add: cte_wp_at'_def)
 
+crunch cancelAllIPC
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: crunch_wps mapM_x_wp simp: crunch_simps)
+
+crunch cancelAllIPC
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps mapM_x_wp simp: crunch_simps)
+
+crunch cancelAllSignals
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: crunch_wps mapM_x_wp simp: crunch_simps)
+
+crunch cancelAllSignals
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps mapM_x_wp simp: crunch_simps)
+
+crunch doMachineOp
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: crunch_wps mapM_x_wp simp: crunch_simps)
+
+crunch doMachineOp
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps mapM_x_wp simp: crunch_simps)
+
 lemma valid_Zombie_cte_at':
   "\<lbrakk> s \<turnstile>' Zombie p zt m; n < zombieCTEs zt \<rbrakk> \<Longrightarrow> cte_at' (p + (of_nat n * 2^cteSizeBits)) s"
   apply (clarsimp simp: valid_cap'_def split: zombie_type.split_asm)
@@ -5761,6 +5845,15 @@ lemma updateCap_cap_to':
   apply (clarsimp simp: modify_map_def cte_wp_at_ctes_of cteCaps_of_def)
   done
 
+lemmas setNotification_cap_to'[wp]
+    = ex_cte_cap_to'_pres [OF setNotification_cte_wp_at' set_ntfn_ksInterrupt]
+
+lemmas setEndpoint_cap_to'[wp]
+    = ex_cte_cap_to'_pres [OF setEndpoint_cte_wp_at' setEndpoint_ksInterruptState]
+
+lemmas setThreadState_cap_to'[wp]
+    = ex_cte_cap_to'_pres [OF setThreadState_cte_wp_at' setThreadState_ksInterruptState]
+
 crunch cancelSignal
   for cap_to'[wp]: "ex_cte_cap_wp_to' P p"
   (simp: crunch_simps wp: crunch_wps)
@@ -5773,8 +5866,6 @@ lemma emptySlot_deletes [wp]:
   apply (clarsimp split: option.splits simp: modify_map_def)
   done
 
-lemmas emptySlot_sch_act_simple[wp] = sch_act_simple_lift[OF emptySlot_nosch]
-
 lemma capCylicZombieD[dest!]:
   "capCyclicZombie cap slot \<Longrightarrow> \<exists>zb n. cap = Zombie slot zb n"
   by (clarsimp simp: capCyclicZombie_def split: capability.split_asm)
@@ -5808,9 +5899,10 @@ lemmas finaliseSlot_abort_cases
     = use_spec(2) [OF finaliseSlot_abort_cases',
                       folded validE_R_def finaliseSlot_def]
 
+crunch emptySlot
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
 crunch capSwapForDelete
   for it[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and ksIdleSC[wp]: "\<lambda>s. P (ksIdleSC s)"
 
 lemma cteDelete_delete_cases:
   "\<lbrace>\<top>\<rbrace>
@@ -5932,21 +6024,10 @@ definition
   "finalise_prop_stuff P
     = ((\<forall>s f. P (ksWorkUnitsCompleted_update f s) = P s)
     \<and> irq_state_independent_H P
-    \<and> updateTimeStamp_independent P
-    \<and> getCurrentTime_independent_H P
-    \<and> time_state_independent_H P
-    \<and> domain_time_independent_H P
     \<and> (\<forall>s f. P (gsUntypedZeroRanges_update f s) = P s)
     \<and> (\<forall>s f. P (ksInterruptState_update f s) = P s)
     \<and> (\<forall>s f. P (ksMachineState_update (irq_state_update f) s) = P s)
-    \<and> (\<forall>s f. P (ksMachineState_update (irq_masks_update f) s) = P s)
-    \<and> (\<forall>s f. P (s\<lparr>ksMachineState := ksMachineState s \<lparr>last_machine_time
-                                                      := f (last_machine_time (ksMachineState s)) (time_state (ksMachineState s))\<rparr>\<rparr>)
-             = P s)
-    \<and> (\<forall>s f. P (ksMachineState_update (time_state_update f) s) = P s)
-    \<and> (\<forall>s f. P (ksCurTime_update f s) = P s)
-    \<and> (\<forall>s f. P (ksConsumedTime_update f s) = P s)
-    \<and> (\<forall>s f. P (ksDomainTime_update f s) = P s))"
+    \<and> (\<forall>s f. P (ksMachineState_update (irq_masks_update f) s) = P s))"
 
 lemma setCTE_no_cte_prop:
   "\<lbrace>no_cte_prop P\<rbrace> setCTE sl cte \<lbrace>\<lambda>_. no_cte_prop P\<rbrace>"
@@ -6057,74 +6138,6 @@ lemmas preemptionPoint_invR =
 lemmas preemptionPoint_invE =
   valid_validE_E [OF preemptionPoint_inv]
 
-lemma sch_act_simple_only_ksSchedulerAction:
-  "ksSchedulerAction (f s) = ksSchedulerAction s \<Longrightarrow> sch_act_simple (f s) =  sch_act_simple s"
-  unfolding sch_act_simple_def
-  apply simp
-  done
-
-crunch schedContextCompleteYieldTo, unbindMaybeNotification, schedContextMaybeUnbindNtfn,
-         prepareThreadDelete, setMessageInfo, schedContextUpdateConsumed, isFinalCapability,
-         setQueue
-  for ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-
-crunch tcbSchedEnqueue, replyClear, suspend, schedContextUnbindTCB, schedContextUnbindNtfn,
-         schedContextUnbindAllTCBs
-  for sch_act_simple[wp]: sch_act_simple
-  (wp: crunch_wps
-   simp: crunch_simps sch_act_simple_lift[OF setQueue_nosch]
-         sch_act_simple_only_ksSchedulerAction[where f="ksReadyQueuesL1Bitmap_update g" for g,
-                                               simplified]
-         sch_act_simple_only_ksSchedulerAction[where f="ksReadyQueuesL2Bitmap_update g" for g,
-                                               simplified])
-
-lemma cancelAllIPC_sch_act_simple:
-  "\<lbrace>\<lambda>s. obj_at' ((=) IdleEP) ep_ptr s \<longrightarrow> sch_act_simple s\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
-  unfolding cancelAllIPC_def
-  apply (wpsimp wp: getEndpoint_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma cancelAllSignals_sch_act_simple:
-  "\<lbrace>\<lambda>s. obj_at' ((isIdleNtfn or isActiveNtfn) o ntfnObj) ntfn_ptr s \<longrightarrow> sch_act_simple s\<rbrace>
-   cancelAllSignals ntfn_ptr
-   \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
-  unfolding cancelAllSignals_def
-  apply (wpsimp wp: getNotification_wp)
-  apply (case_tac "ntfnObj ko"; clarsimp simp: isIdleNtfn_def isActiveNtfn_def obj_at'_def)
-  done
-
-lemma finaliseCap_True_sch_act_simple[wp]:
-  "finaliseCap (cteCap x) y True \<lbrace>sch_act_simple\<rbrace>"
-  unfolding finaliseCap_def Let_def
-  apply (wpsimp wp: cancelAllIPC_sch_act_simple cancelAllSignals_sch_act_simple
-                    hoare_drop_imp hoare_vcg_all_lift
-              comb: sch_act_simple_lift
-              simp: if_fun_split)
-  done
-
-lemma cteDeleteOne_sch_act_simple[wp]:
-  "cteDeleteOne cte_ptr \<lbrace>sch_act_simple\<rbrace>"
-  unfolding cteDeleteOne_def finaliseCapTrue_standin_simple_def
-  apply (wpsimp wp: haskell_assert_inv comb: sch_act_simple_lift)
-  done
-
-crunch deletingIRQHandler, unbindFromSC, schedContextSetInactive, schedContextUnbindYieldFrom,
-         schedContextUnbindReply
-  for sch_act_simple[wp]: sch_act_simple
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma finaliseCap_False_sch_act_simple[wp]:
-  "finaliseCap (cteCap x) y False \<lbrace>sch_act_simple\<rbrace>"
-  unfolding finaliseCap_def Let_def
-  apply (wpsimp wp: cancelAllIPC_sch_act_simple cancelAllSignals_sch_act_simple
-                    hoare_drop_imp hoare_vcg_all_lift
-              comb: sch_act_simple_lift
-              simp: if_fun_split)
-  done
-
 lemma finaliseSlot_invs':
   assumes finaliseCap:
     "\<And>cap final sl. \<lbrace>no_cte_prop Pr and invs' and sch_act_simple
@@ -6195,7 +6208,7 @@ proof (induct arbitrary: P p rule: finalise_spec_induct2)
         apply (wp hyps)
 
           apply ((wp preemptionPoint_invE preemptionPoint_invR
-              | clarsimp simp: sch_act_simple_def ex_cte_cap_wp_to'_def
+              | clarsimp simp: sch_act_simple_def
               | simp cong: kernel_state.fold_congs machine_state.fold_congs)+)[1]
          apply (rule spec_strengthen_postE [OF reduceZombie_invs''[OF _ stuff]])
           prefer 2
@@ -6257,10 +6270,10 @@ proof (induct arbitrary: P p rule: finalise_spec_induct2)
         apply clarsimp
        apply (clarsimp simp: cte_wp_at_ctes_of capRemovable_def)
        apply (subgoal_tac "final_matters' (cteCap rv) \<and> \<not> isUntypedCap (cteCap rv)")
-        apply (intro conjI impI
-               ; clarsimp?
-               ; erule_tac x=p in ballE
-               ; clarsimp simp: pred_tcb_at'_def obj_at'_def)
+        apply clarsimp
+        apply (rule conjI)
+         apply clarsimp
+        apply clarsimp
        apply (case_tac "cteCap rv",
               simp_all add: isCap_simps final_matters'_def)[1]
       apply (wp isFinalCapability_inv hoare_weak_lift_imp | simp | wp (once) isFinal[where x=sl])+
@@ -6342,8 +6355,7 @@ lemma finaliseSlot_cte_wp_at:
 
 lemmas reduceZombie_invs'
     = reduceZombie_invs''[where Q=\<top>, simplified no_cte_prop_top simp_thms
-         finalise_prop_stuff_def irq_state_independent_H_def updateTimeStamp_independent_def
-         getCurrentTime_independent_H_def time_state_independent_H_def domain_time_independent_H_def,
+         finalise_prop_stuff_def irq_state_independent_H_def,
          OF drop_spec_validE TrueI,
          OF hoare_weaken_preE,
          OF finaliseSlot_invs'',
@@ -6400,19 +6412,15 @@ lemma cteDelete_invs':
 
 declare cases_simp_conj[simp]
 
-end
 crunch capSwapForDelete
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
   (wp: crunch_wps)
 
-crunch cteDelete
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (rule: cteDelete_preservation)
+lemma cteDelete_typ_at' [wp]:
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> cteDelete slot exposed \<lbrace>\<lambda>_ s. P (typ_at' T p s)\<rbrace>"
+  by (wp cteDelete_preservation | simp | fastforce)+
 
-global_interpretation cteDelete: typ_at_all_props' "cteDelete slot exposed"
-  by typ_at_props'
+lemmas cteDelete_typ_at'_lifts [wp] = typ_at_lifts [OF cteDelete_typ_at']
 
 lemma cteDelete_cte_at:
   "\<lbrace>\<top>\<rbrace> cteDelete slot bool \<lbrace>\<lambda>rv. cte_at' slot\<rbrace>"
@@ -6512,42 +6520,31 @@ lemma cteDelete_sch_act_simple:
     apply simp+
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+crunch emptySlot
+  for st_tcb_at'[wp]: "st_tcb_at' P t" (simp: case_Null_If)
 
-crunch "Arch.finaliseCap", unbindMaybeNotification, prepareThreadDelete,
-         schedContextMaybeUnbindNtfn, cleanReply
+crunch "Arch.finaliseCap", unbindMaybeNotification, prepareThreadDelete
   for st_tcb_at'[wp]: "st_tcb_at' P t"
-  (simp: crunch_simps wp: crunch_wps getObject_inv)
-
-lemma replyPop_st_tcb_at':
-  assumes x[simp]: "\<And>st. simple' st \<Longrightarrow> P st"
-  shows "replyPop a b \<lbrace>st_tcb_at' P t\<rbrace>"
-  unfolding replyPop_def
-  by (wpsimp wp: setThreadState_st_tcb_at'_test_unaffected replyUnlink_st_tcb_at'
-                 hoare_drop_imp hoare_vcg_if_lift2  )
-
-lemma replyRemove_st_tcb_at':
-  assumes x[simp]: "\<And>st. simple' st \<Longrightarrow> P st"
-  shows "replyRemove a b \<lbrace>st_tcb_at' P t\<rbrace>"
-  unfolding replyRemove_def
-  by (wpsimp wp: setThreadState_st_tcb_at'_test_unaffected replyPop_st_tcb_at'
-                 hoare_drop_imps hoare_vcg_if_lift2 replyUnlink_st_tcb_at')
+  (simp: crunch_simps wp: crunch_wps getObject_inv loadObject_default_inv)
+end
 
-lemma replyClear_st_tcb_at':
-  assumes x[simp]: "\<And>st. simple' st \<Longrightarrow> P st"
-  shows "replyClear a b \<lbrace>st_tcb_at' P t\<rbrace>"
-  unfolding replyClear_def
-  by (wpsimp wp: replyUnlink_st_tcb_at' replyRemove_st_tcb_at' cancelIPC_st_tcb_at hoare_drop_imp)
 
 lemma finaliseCap2_st_tcb_at':
   assumes x[simp]: "\<And>st. simple' st \<Longrightarrow> P st"
-  shows "finaliseCap cap final flag \<lbrace>st_tcb_at' P t\<rbrace>"
+  shows "\<lbrace>st_tcb_at' P t\<rbrace>
+     finaliseCap cap final flag
+   \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
   apply (simp add: finaliseCap_def Let_def
                    getThreadCSpaceRoot deletingIRQHandler_def
              cong: if_cong split del: if_split)
-  apply (wpsimp wp: cancelAllIPC_st_tcb_at cancelAllSignals_st_tcb_at
-                    replyClear_st_tcb_at' suspend_st_tcb_at' cteDeleteOne_st_tcb_at getCTE_wp'
-                    hoare_drop_imp hoare_vcg_if_lift2 hoare_vcg_all_lift)
+  apply (rule hoare_pre)
+   apply ((wp cancelAllIPC_st_tcb_at cancelAllSignals_st_tcb_at
+              prepareThreadDelete_st_tcb_at'
+              suspend_st_tcb_at' cteDeleteOne_st_tcb_at getCTE_wp'
+             | simp add: isCap_simps getSlotCap_def getIRQSlot_def
+                         locateSlot_conv getInterruptState_def
+                  split del: if_split
+             | wpc))+
   done
 
 crunch capSwapForDelete
@@ -6622,24 +6619,31 @@ lemma capSwap_rvk_prog:
   apply arith
   done
 
+lemmas setObject_ASID_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF setObject_ASID_ctes_of']
 lemmas cancelAllIPC_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF cancelAllIPC_ctes_of]
 lemmas cancelAllSignals_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF cancelAllSignals_ctes_of]
+lemmas setEndpoint_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_ep_ctes_of]
+lemmas setNotification_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_ntfn_ctes_of]
 
 lemmas emptySlot_rvk_prog' = emptySlot_rvk_prog[unfolded o_def]
 lemmas threadSet_ctesCaps_of = ctes_of_cteCaps_of_lift[OF threadSet_ctes_of]
 
+lemmas storePTE_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF storePTE_ctes]
+lemmas storePDE_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF storePDE_ctes]
+
+context begin interpretation Arch . (*FIXME: arch-split*)
+
 context
 notes option.case_cong_weak[cong]
 begin
 crunch finaliseCap
- for rvk_prog': "\<lambda>s. revoke_progress_ord m (\<lambda>x. option_map capToRPO (cteCaps_of s x))"
-  (wp: crunch_wps emptySlot_rvk_prog' threadSet_ctesCaps_of hoare_vcg_all_lift getObject_inv
+  for rvk_prog': "\<lambda>s. revoke_progress_ord m (\<lambda>x. option_map capToRPO (cteCaps_of s x))"
+  (wp: crunch_wps emptySlot_rvk_prog' threadSet_ctesCaps_of
+       getObject_inv loadObject_default_inv
    simp: crunch_simps unless_def o_def
    ignore: setCTE threadSet)
 end
 
-end
-
 lemmas finalise_induct3 = finaliseSlot'.induct[where P=
     "\<lambda>sl exp s. P sl (finaliseSlot' sl exp) s" for P]
 
@@ -6655,19 +6659,15 @@ proof (induct rule: finalise_induct3)
     apply (rule hoare_pre_spec_validE)
      apply wp
          apply ((wp | simp)+)[1]
-        apply (wp "1.hyps")
-            apply (unfold Let_def split_def fst_conv
-                          snd_conv haskell_fail_def
-                          case_Zombie_assert_fold)
-            apply (wp capSwap_rvk_prog | simp only: withoutPreemption_def)+
-          apply (wp preemptionPoint_inv)[1]
-               apply force
-              apply force
-             apply (clarsimp simp: updateTimeStamp_independent_def)
-            apply (clarsimp simp: getCurrentTime_independent_H_def)
-           apply (clarsimp simp: time_state_independent_H_def)
-          apply (clarsimp simp: domain_time_independent_H_def)
-         apply (wp capSwap_rvk_prog | simp only: withoutPreemption_def)+
+     apply (wp "1.hyps")
+          apply (unfold Let_def split_def fst_conv
+                        snd_conv haskell_fail_def
+                        case_Zombie_assert_fold)
+          apply (wp capSwap_rvk_prog | simp only: withoutPreemption_def)+
+        apply (wp preemptionPoint_inv)[1]
+        apply force
+        apply force
+        apply (wp capSwap_rvk_prog | simp only: withoutPreemption_def)+
            apply (wp getCTE_wp | simp)+
             apply (rule hoare_strengthen_post [OF emptySlot_rvk_prog[where m=m]])
             apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def o_def
@@ -6875,8 +6875,6 @@ lemmas rec_del_concrete_unfold
   = rec_del_concrete.simps red_zombie_will_fail.simps
     if_True if_False ball_simps simp_thms
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 lemma cap_relation_removables:
   "\<lbrakk> cap_relation cap cap'; isNullCap cap' \<or> isZombie cap';
       s \<turnstile> cap; cte_at slot s; invs s \<rbrakk>
@@ -6884,7 +6882,7 @@ lemma cap_relation_removables:
                \<and> cap_cyclic_zombie cap slot = capCyclicZombie cap' (cte_map slot)"
   apply (clarsimp simp: capRemovable_def isCap_simps
                         capCyclicZombie_def cap_cyclic_zombie_def
-                 split: cap_relation_split_asm  arch_cap.split_asm)
+                 split: cap_relation_split_asm arch_cap.split_asm)
   apply (rule iffD1 [OF conj_commute], rule context_conjI)
    apply (rule iffI)
     apply (clarsimp simp: cte_map_replicate)
@@ -6908,15 +6906,11 @@ lemma spec_corres_gen_asm2:
   unfolding spec_corres_def
   by (auto intro: corres_gen_asm2)
 
-end
-
 crunch reduceZombie
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
   (simp: crunch_simps wp: crunch_wps)
 
-global_interpretation reduceZombie: typ_at_all_props' "reduceZombie cap slot x"
-  by typ_at_props'
+lemmas reduceZombie_typ_ats[wp] = typ_at_lifts [OF reduceZombie_typ_at']
 
 lemma spec_corres_if:
   "\<lbrakk> G = G'; G \<Longrightarrow> spec_corres s r P P' a c; \<not> G \<Longrightarrow> spec_corres s r Q Q' b d\<rbrakk>
@@ -6929,6 +6923,20 @@ lemma spec_corres_liftME2:
       = spec_corres s (f \<oplus> (\<lambda>x. r x \<circ> fn)) P P' m m'"
   by (simp add: spec_corres_def)
 
+
+lemma rec_del_ReduceZombie_emptyable:
+  "\<lbrace>invs
+      and (cte_wp_at ((=) cap) slot and is_final_cap' cap
+      and (\<lambda>y. is_zombie cap)) and
+         (\<lambda>s. \<not> ex \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {}) slot s) and
+         emptyable slot and
+         (\<lambda>s. \<not> cap_removeable cap slot \<and> (\<forall>t\<in>obj_refs cap. halted_if_tcb t s))\<rbrace>
+   rec_del (ReduceZombieCall cap slot ex) \<lbrace>\<lambda>rv. emptyable slot\<rbrace>, -"
+  by (rule rec_del_emptyable [where args="ReduceZombieCall cap slot ex", simplified])
+
+crunch cteDelete
+  for sch_act_simple[wp]: sch_act_simple
+
 lemmas preemption_point_valid_list = preemption_point_inv'[where P="valid_list", simplified]
 
 lemma finaliseSlot_typ_at'[wp]:
@@ -6940,17 +6948,16 @@ lemmas finaliseSlot_typ_ats[wp] = typ_at_lifts[OF finaliseSlot_typ_at']
 lemmas rec_del_valid_list_irq_state_independent[wp] =
   rec_del_preservation[OF cap_swap_for_delete_valid_list set_cap_valid_list empty_slot_valid_list finalise_cap_valid_list preemption_point_valid_list]
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 lemma rec_del_corres:
   "\<forall>C \<in> rec_del_concrete args.
    spec_corres s (dc \<oplus> (case args of
                             FinaliseSlotCall _ _ \<Rightarrow> (\<lambda>r r'. fst r = fst r'
                                                            \<and> cap_relation (snd r) (snd r') )
                           | _ \<Rightarrow> dc))
-      (einvs and valid_machine_time and simple_sched_action
-            and valid_rec_del_call args and current_time_bounded
+      (einvs and simple_sched_action
+            and valid_rec_del_call args
             and cte_at (slot_rdcall args)
+            and emptyable (slot_rdcall args)
             and (\<lambda>s. \<not> exposed_rdcall args \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {}) (slot_rdcall args) s)
             and (\<lambda>s. case args of ReduceZombieCall cap sl ex \<Rightarrow>
                                      \<forall>t\<in>obj_refs cap. halted_if_tcb t s
@@ -6980,8 +6987,8 @@ proof (induct rule: rec_del.induct,
         apply (rule corres_when, simp)
         apply simp
         apply (rule emptySlot_corres)
-       apply (wpsimp wp: rec_del_invs rec_del_valid_list rec_del_valid_sched rec_del_cte_at
-                         finaliseSlot_invs hoare_drop_imps preemption_point_inv'
+       apply (wp rec_del_invs rec_del_valid_list rec_del_cte_at finaliseSlot_invs hoare_drop_imps
+                 preemption_point_inv'
             | simp)+
     done
 next
@@ -7045,31 +7052,22 @@ next
                    apply (rule "2.hyps"(2)[unfolded fun_app_def rec_del_concrete_unfold
                                                     finaliseSlot_def],
                           assumption+)
-                  apply ((wpsimp wp: preemption_point_valid_machine_time
-                                     preemption_point_valid_list
-                                     preemption_point_valid_sched)+)[1]
-                  apply (wpsimp wp: preemption_point_inv)
-                   apply (clarsimp simp: ex_cte_cap_wp_to_def)
+                  apply (wp preemption_point_inv')[1]
                   apply clarsimp+
                  apply (wp preemptionPoint_invR)
-                      apply simp
-                     apply clarsimp
-                    apply (clarsimp simp: sch_act_simple_def ex_cte_cap_wp_to'_def)
-                   apply (clarsimp simp: sch_act_simple_def ex_cte_cap_wp_to'_def)
-                  apply (clarsimp simp: sch_act_simple_def ex_cte_cap_wp_to'_def)
-                 apply (clarsimp simp: sch_act_simple_def ex_cte_cap_wp_to'_def)
-                apply (wpsimp wp: rec_del_invs rec_del_cte_at reduce_zombie_cap_somewhere
-                                  reduceZombie_invs reduce_zombie_cap_to
-                                  DetSchedSchedule_AI_det_ext.rec_del_valid_sched
-                       | strengthen invs_valid_objs invs_cur_sc_tcb invs_psp_aligned invs_distinct
-                                    valid_sched_active_scs_valid)+
-               apply ((wpsimp wp: reduceZombie_cap_to reduceZombie_sch_act_simple
-                                 reduceZombie_invs | strengthen invs_valid_objs')+)[1]
+                  apply simp
+                 apply clarsimp
+                apply simp
+                apply (wp rec_del_invs rec_del_cte_at reduce_zombie_cap_somewhere
+                          rec_del_ReduceZombie_emptyable
+                          reduceZombie_invs reduce_zombie_cap_to | simp)+
+               apply (wp reduceZombie_cap_to reduceZombie_sch_act_simple)+
               apply simp
               apply ((wp replace_cap_invs final_cap_same_objrefs
                         set_cap_cte_wp_at set_cap_cte_cap_wp_to
                         hoare_vcg_const_Ball_lift hoare_weak_lift_imp
-                         | simp add: conj_comms)+)[1]
+                         | simp add: conj_comms
+                         | erule finalise_cap_not_reply_master [simplified])+)[1]
                  apply (simp(no_asm_use))
              apply (wp make_zombie_invs' updateCap_cap_to'
                         updateCap_cte_wp_at_cases
@@ -7085,9 +7083,10 @@ next
             apply (clarsimp simp: conj_comms)
            apply (wp | simp)+
            apply (rule hoare_strengthen_post)
-            apply (rule_tac Q="\<lambda>fin s. einvs s \<and> valid_machine_time s  \<and> simple_sched_action s
-                                      \<and> replaceable s slot (fst fin) rv \<and> current_time_bounded s
+            apply (rule_tac Q="\<lambda>fin s. einvs s \<and> simple_sched_action s
+                                      \<and> replaceable s slot (fst fin) rv
                                       \<and> cte_wp_at ((=) rv) slot s \<and> s \<turnstile> fst fin
+                                      \<and> emptyable slot s
                                       \<and> (\<forall>t\<in>obj_refs (fst fin). halted_if_tcb t s)"
                        in hoare_vcg_conj_lift)
              apply (wp finalise_cap_invs finalise_cap_replaceable
@@ -7118,24 +7117,19 @@ next
            apply (clarsimp simp: capRemovable_def cte_wp_at_ctes_of)
           apply (clarsimp dest!: isCapDs simp: cte_wp_at_ctes_of)
           apply (case_tac "cteCap rv'",
-                 auto simp add: isCap_simps is_cap_simps final_matters'_def pred_tcb_at'_def
-                                obj_at'_def)[1]
-         apply (wpsimp wp: isFinal[where x="cte_map slot"]
-                     simp: is_final_cap_def)
-        apply (wpsimp wp: isFinalCapability_inv hoare_weak_lift_imp isFinal
-                    simp: is_final_cap_def)
-       apply (wpsimp wp: get_cap_wp)
-      apply (wpsimp wp: getCTE_wp')
+                 auto simp add: isCap_simps is_cap_simps final_matters'_def)[1]
+         apply (wp isFinalCapability_inv hoare_weak_lift_imp
+                 | simp add: is_final_cap_def conj_comms cte_wp_at_eq_simp)+
+       apply (rule isFinal[where x="cte_map slot"])
+      apply (wp get_cap_wp| simp add: conj_comms)+
+      apply (wp getCTE_wp')
      apply clarsimp
-     apply (frule(1) cte_wp_at_valid_objs_valid_cap[where P="(=) cap" for cap,
-                                                    OF _ invs_valid_objs])
-     supply split_paired_Ex[simp del]
-     apply (clarsimp simp: invs_def valid_state_def valid_pspace_def cte_wp_at_def)
-     apply (subst split_paired_Ex[symmetric])
-     apply (solves \<open>auto\<close>)[1]
-    apply (clarsimp simp: cte_wp_at_ctes_of invs'_def valid_pspace'_def sch_act_wf_weak)
-    apply (frule(1) ctes_of_valid')
-    apply fastforce
+     apply (frule cte_wp_at_valid_objs_valid_cap[where P="(=) cap" for cap])
+      apply fastforce
+     apply (fastforce simp: cte_wp_at_caps_of_state)
+    apply (clarsimp simp: cte_wp_at_ctes_of)
+    apply (frule ctes_of_valid', clarsimp)
+    apply ((clarsimp | rule conjI)+)[1]
     done
 
 next
@@ -7190,9 +7184,9 @@ next
         apply clarsimp
        apply (clarsimp simp: cte_wp_at_caps_of_state)
        apply (erule tcb_valid_nonspecial_cap, fastforce)
-        apply (clarsimp simp: ran_tcb_cap_cases is_cap_simps is_nondevice_page_cap_def
+        apply (clarsimp simp: ran_tcb_cap_cases is_cap_simps is_nondevice_page_cap_simps
                        split: Structures_A.thread_state.split)
-       apply (clarsimp simp: is_nondevice_page_cap_def)
+       apply (simp add: ran_tcb_cap_cases is_cap_simps is_nondevice_page_cap_simps)
       apply fastforce
      apply wp
     apply (rule no_fail_pre, wp)
@@ -7329,6 +7323,7 @@ next
      apply (frule cte_wp_valid_cap, clarsimp)
      apply (rule conjI, erule cte_at_nat_to_cref_zbits)
       apply simp
+     apply (simp add: halted_emptyable)
      apply (erule(1) zombie_is_cap_toE)
       apply simp
      apply simp
@@ -7359,8 +7354,7 @@ qed
 
 lemma cteDelete_corres:
   "corres (dc \<oplus> dc)
-      (einvs and valid_machine_time and simple_sched_action
-       and current_time_bounded and cte_at ptr)
+      (einvs and simple_sched_action and cte_at ptr and emptyable ptr)
       (invs' and sch_act_simple and cte_at' (cte_map ptr))
       (cap_delete ptr) (cteDelete (cte_map ptr) True)"
   unfolding cap_delete_def
@@ -7390,7 +7384,7 @@ termination cteRevoke
   apply (rule cteRevoke.termination)
    apply (rule wf_cteRevoke_recset)
   apply (clarsimp simp add: cteRevoke_recset_def in_monad
-                  dest!: in_getCTE)
+                  dest!: in_getCTE in_preempt')
   apply (frule use_validE_R [OF _ cteDelete_rvk_prog])
    apply (rule rpo_sym)
   apply (frule use_validE_R [OF _ cteDelete_deletes])
@@ -7401,41 +7395,34 @@ termination cteRevoke
    apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def capToRPO_def)
    apply (simp split: capability.split_asm)
    apply (case_tac rvb, clarsimp)
-  apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def capToRPO_def)
-  apply (erule (1) use_valid[OF _ preemptionPoint_ctes_of])
+  apply assumption
   done
 
 lemma cteRevoke_preservation':
   assumes x: "\<And>ptr. \<lbrace>P\<rbrace> cteDelete ptr True \<lbrace>\<lambda>rv. P\<rbrace>"
   assumes y: "\<And>f s. P (ksWorkUnitsCompleted_update f s) = P s"
-  assumes indep: "irq_state_independent_H P"
-                 "updateTimeStamp_independent P"
-                 "getCurrentTime_independent_H P"
-                 "time_state_independent_H P"
-                 "domain_time_independent_H P"
+  assumes irq: "irq_state_independent_H P"
   shows      "s \<turnstile> \<lbrace>P\<rbrace> cteRevoke ptr \<lbrace>\<lambda>rv. P\<rbrace>,\<lbrace>\<lambda>rv. P\<rbrace>"
 proof (induct rule: cteRevoke.induct)
   case (1 p s')
   show ?case
     apply (subst cteRevoke.simps)
     apply (wp "1.hyps")
-        apply (wp x y preemptionPoint_inv hoare_drop_imps indep | clarsimp)+
+        apply (wp x y preemptionPoint_inv hoare_drop_imps irq | clarsimp)+
     done
 qed
 
 lemmas cteRevoke_preservation =
        validE_valid [OF use_spec(2) [OF cteRevoke_preservation']]
 
-crunch cteRevoke
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (rule: cteRevoke_preservation)
+lemma cteRevoke_typ_at':
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> cteRevoke ptr \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
+  by (wp cteRevoke_preservation | clarsimp)+
 
 lemma cteRevoke_invs':
   "\<lbrace>invs' and sch_act_simple\<rbrace> cteRevoke ptr \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (rule_tac Q'="\<lambda>rv. invs' and sch_act_simple" in hoare_strengthen_post)
-   apply (wpsimp wp: cteRevoke_preservation cteDelete_invs' cteDelete_sch_act_simple
-               simp: sch_act_simple_def)+
+  apply (wpsimp wp: cteRevoke_preservation cteDelete_invs' cteDelete_sch_act_simple)+
   done
 
 declare cteRevoke.simps[simp del]
@@ -7606,7 +7593,7 @@ lemma cap_revoke_mdb_stuff4:
 
 lemma cteRevoke_corres':
   "spec_corres s (dc \<oplus> dc)
-      (einvs and valid_machine_time and simple_sched_action and cte_at ptr and current_time_bounded)
+      (einvs and simple_sched_action and cte_at ptr)
       (invs' and sch_act_simple and cte_at' (cte_map ptr))
       (cap_revoke ptr) (\<lambda>s. cteRevoke (cte_map ptr) s)"
 proof (induct rule: cap_revoke.induct)
@@ -7731,33 +7718,26 @@ proof (induct rule: cap_revoke.induct)
           apply (rule "1.hyps",
                    (simp add: cte_wp_at_def in_monad select_def next_revoke_cap_def select_ext_def
                      | assumption | rule conjI refl)+)[1]
-         apply (wpsimp
-                | wp preemptionPoint_invR preemption_point_inv')+
-          apply (clarsimp simp: sch_act_simple_def)+
-         apply (wpsimp wp: cteDelete_invs' cteDelete_sch_act_simple
-                | strengthen invs_valid_objs invs_cur_sc_tcb invs_psp_aligned invs_distinct
-                             valid_sched_active_scs_valid invs_valid_objs')+
+         apply (wp cap_delete_cte_at cteDelete_invs' cteDelete_sch_act_simple
+                   preemptionPoint_invR preemption_point_inv' | clarsimp)+
      apply (clarsimp simp: cte_wp_at_cte_at)
-     apply (drule next_childD, simp)
-     apply (clarsimp, drule child_descendant)
+     apply(drule next_childD, simp)
+     apply(clarsimp, drule child_descendant)
+     apply (fastforce simp: emptyable_def dest: reply_slot_not_descendant)
     apply (clarsimp elim!: cte_wp_at_weakenE')
     done
 qed
 
 lemmas cteRevoke_corres = use_spec_corres [OF cteRevoke_corres']
 
-end
-
 crunch invokeCNode
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
   (ignore: filterM finaliseSlot
      simp: crunch_simps filterM_mapM unless_def
            arch_recycleCap_improve_cases
        wp: crunch_wps undefined_valid finaliseSlot_preservation)
 
-global_interpretation invokeCNode: typ_at_all_props' "invokeCNode i"
-  by typ_at_props'
+lemmas invokeCNode_typ_ats [wp] = typ_at_lifts [OF invokeCNode_typ_at']
 
 crunch cteMove
   for st_tcb_at'[wp]: "st_tcb_at' P t"
@@ -7804,6 +7784,8 @@ lemma updateCap_valid_objs [wp]:
   apply (erule cte_at_cte_wp_atD)
   done
 
+end
+
 lemma (in mdb_move) [intro!]:
   shows "mdb_chain_0 m" using valid
   by (auto simp: valid_mdb_ctes_def)
@@ -7868,7 +7850,7 @@ lemma (in mdb_move) m'_cap:
 context mdb_move
 begin
 
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 
 lemma m_to_src:
   "m \<turnstile> p \<leadsto> src = (p \<noteq> 0 \<and> p = mdbPrev src_node)"
@@ -8383,11 +8365,23 @@ proof
     apply (clarsimp simp: weak_derived'_def)
     done
 
+  have "reply_masters_rvk_fb m" using valid ..
+  thus "reply_masters_rvk_fb m'" using neq parency
+    apply (simp add: m'_def n_def reply_masters_rvk_fb_def
+                     ball_ran_modify_map_eq)
+    apply (simp add: modify_map_apply m_p dest)
+    apply (intro ball_ran_fun_updI, simp_all)
+     apply (frule bspec, rule ranI, rule m_p)
+     apply (clarsimp simp: weak_derived'_def)
+     apply (drule master_eqE[where F=isReplyCap], simp add: isCap_Master)
+    apply (simp add: isCap_simps)+
+    done
+
 qed
 
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma cteMove_iflive'[wp]:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
@@ -8424,19 +8418,19 @@ lemma cteMove_valid_pspace' [wp]:
   apply (simp add: pred_conj_def valid_pspace'_def valid_mdb'_def)
   apply (wp sch_act_wf_lift valid_queues_lift
     cur_tcb_lift updateCap_no_0  updateCap_ctes_of_wp getCTE_wp | simp)+
-  apply (clarsimp simp: invs'_def)+
+  apply (clarsimp simp: invs'_def valid_state'_def)+
   apply (clarsimp dest!: cte_at_cte_wp_atD)
   apply (rule_tac x = cte in exI)
   apply clarsimp
   apply (clarsimp dest!: cte_at_cte_wp_atD)
   apply (rule_tac x = ctea in exI)
   apply (clarsimp simp: isCap_simps)
-  apply (rule conjI)
-   apply (fastforce)
+  apply rule
+   apply (clarsimp elim!: valid_mdb_ctesE)
   apply (case_tac ctea)
   apply (case_tac cte)
   apply (rule_tac old_dest_node = "cteMDBNode cte" and src_cap = "cteCap ctea" in
-                  mdb_move.cteMove_valid_mdb_helper)
+    mdb_move.cteMove_valid_mdb_helper)
   prefer 2
    apply (clarsimp simp: cte_wp_at_ctes_of weak_derived'_def isCap_simps simp del: not_ex)
   apply unfold_locales
@@ -8564,25 +8558,28 @@ crunch updateMDB
   for valid_bitmaps[wp]: valid_bitmaps
   (rule: valid_bitmaps_lift)
 
-(* FIXME: arch_split *)
+(* FIXME: arch-split *)
 lemma haskell_assert_inv:
   "haskell_assert Q L \<lbrace>P\<rbrace>"
   by wpsimp
 
 lemma cteMove_invs' [wp]:
-  "\<lbrace>\<lambda>s. invs' s \<and> ex_cte_cap_to' word2 s \<and>
-            cte_wp_at' (\<lambda>c. weak_derived' (cteCap c) capability) word1 s \<and>
-            cte_wp_at' (\<lambda>c. isUntypedCap (cteCap c) \<longrightarrow> capability = cteCap c) word1 s \<and>
-            cte_wp_at' (\<lambda>c. (cteCap c) \<noteq> NullCap) word1 s \<and>
-            s \<turnstile>' capability \<and>
-            cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) word2 s\<rbrace>
+  "\<lbrace>\<lambda>x. invs' x \<and> ex_cte_cap_to' word2 x \<and>
+            cte_wp_at' (\<lambda>c. weak_derived' (cteCap c) capability) word1 x \<and>
+            cte_wp_at' (\<lambda>c. isUntypedCap (cteCap c) \<longrightarrow> capability = cteCap c) word1 x \<and>
+            cte_wp_at' (\<lambda>c. (cteCap c) \<noteq> NullCap) word1 x \<and>
+            x \<turnstile>' capability \<and>
+            cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) word2 x\<rbrace>
      cteMove capability word1 word2
    \<lbrace>\<lambda>y. invs'\<rbrace>"
-  apply (simp add: invs'_def pred_conj_def valid_dom_schedule'_def)
-  apply (intro hoare_vcg_conj_lift_pre_fix
-          ; solves \<open>wpsimp wp: cteMove_urz cteMove_ifunsafe'
-                    | wpsimp simp: cteMove_def o_def
-                               wp: valid_queues_lift hoare_drop_imps\<close>)
+  apply (simp add: invs'_def valid_state'_def pred_conj_def)
+  apply (rule hoare_pre)
+   apply ((rule hoare_vcg_conj_lift, (wp cteMove_ifunsafe')[1])
+                  | rule hoare_vcg_conj_lift[rotated])+
+      apply (unfold cteMove_def)
+      apply (wp cur_tcb_lift valid_queues_lift haskell_assert_inv
+                sch_act_wf_lift ct_idle_or_in_cur_domain'_lift2 tcb_in_cur_domain'_lift)+
+  apply clarsimp
   done
 
 lemma cteMove_cte_wp_at:
@@ -8615,10 +8612,7 @@ lemma cteMove_ex:
   apply clarsimp
   done
 
-end
-
-global_interpretation cteMove: typ_at_all_props' "cteMove cap src dest"
-  by typ_at_props'
+lemmas cteMove_typ_at_lifts [wp] = typ_at_lifts [OF cteMove_typ_at']
 
 lemmas finalise_slot_corres'
     = rec_del_corres[where args="FinaliseSlotCall slot exp",
@@ -8626,7 +8620,8 @@ lemmas finalise_slot_corres'
                      simplified, folded finalise_slot_def] for slot exp
 lemmas finalise_slot_corres = use_spec_corres [OF finalise_slot_corres']
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+crunch updateCap
+  for ksMachine[wp]: "\<lambda>s. P (ksMachineState s)"
 
 lemma cap_relation_same:
   "\<lbrakk> cap_relation cap cap'; cap_relation cap cap'' \<rbrakk>
@@ -8635,89 +8630,141 @@ lemma cap_relation_same:
                       arch_cap.split_asm)
 
 crunch updateCap
- for gsUserPages[wp]: "\<lambda>s. P (gsUserPages s)"
+  for gsUserPages[wp]: "\<lambda>s. P (gsUserPages s)"
 crunch    updateCap
- for gsCNodes[wp]: "\<lambda>s. P (gsCNodes s)"
+  for gsCNodes[wp]: "\<lambda>s. P (gsCNodes s)"
 crunch updateCap
- for ksWorkUnitsCompleted[wp]: "\<lambda>s. P (ksWorkUnitsCompleted s)"
+  for ksWorkUnitsCompleted[wp]: "\<lambda>s. P (ksWorkUnitsCompleted s)"
 crunch updateCap
- for ksDomainTime[wp]: "\<lambda>s. P (ksDomainTime s)"
+  for ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
+crunch updateCap
+  for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+crunch updateCap
+  for ksDomainTime[wp]: "\<lambda>s. P (ksDomainTime s)"
 
 declare corres_False' [simp]
 
 lemma invokeCNode_corres:
   "cnodeinv_relation ci ci' \<Longrightarrow>
    corres (dc \<oplus> dc)
-     (einvs and valid_machine_time and simple_sched_action and valid_cnode_inv ci
-      and current_time_bounded)
+     (einvs and simple_sched_action and valid_cnode_inv ci)
      (invs' and sch_act_simple and valid_cnode_inv' ci')
      (invoke_cnode ci) (invokeCNode ci')"
   apply (simp add: invoke_cnode_def invokeCNode_def)
   apply (cases ci, simp_all)
+        apply clarsimp
+        apply (rule corres_guard_imp)
+          apply (rule cteInsert_corres)
+            apply simp+
+         apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
+                        elim!: cte_wp_at_cte_at)
+        apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
        apply clarsimp
        apply (rule corres_guard_imp)
-         apply (rule cteInsert_corres)
-           apply simp+
-        apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
-                       elim!: cte_wp_at_cte_at)
-       apply (clarsimp simp: invs'_def valid_pspace'_def)
-      apply clarsimp
-      apply (rule corres_guard_imp)
-        apply (erule cteMove_corres)
-       apply (clarsimp simp: cte_wp_at_caps_of_state real_cte_tcb_valid)
-      apply (clarsimp simp: cte_wp_at_ctes_of)
-     apply (rule cteRevoke_corres)
-    apply (rule corres_guard_imp [OF cteDelete_corres])
-     apply (clarsimp simp: cte_at_typ cap_table_at_typ)
-    apply simp
-   apply (rename_tac cap1 cap2 p1 p2 p3)
-   apply (elim conjE exE)
-   apply (intro impI conjI)
-    apply simp
-    apply (rule corres_guard_imp)
-      apply (rule_tac F="wellformed_cap cap1 \<and> wellformed_cap cap2"
-             in corres_gen_asm)
-      apply (erule (1) cteSwap_corres [OF refl refl], simp+)
-     apply (simp add: invs_def valid_state_def valid_pspace_def
-                      real_cte_tcb_valid valid_cap_def2)
-    apply (clarsimp simp: invs'_def valid_pspace'_def
-                          cte_wp_at_ctes_of weak_derived'_def)
-   apply (simp split del: if_split)
-   apply (rule_tac F = "cte_map p1 \<noteq> cte_map p3" in corres_req)
-    apply clarsimp
-    apply (drule (2) cte_map_inj_eq [OF _ cte_wp_at_cte_at cte_wp_at_cte_at])
+         apply (erule cteMove_corres)
+        apply (clarsimp simp: cte_wp_at_caps_of_state real_cte_tcb_valid)
+       apply (clarsimp simp: cte_wp_at_ctes_of)
+       apply (rule cteRevoke_corres)
+     apply (rule corres_guard_imp [OF cteDelete_corres])
+      apply (clarsimp simp: cte_at_typ cap_table_at_typ halted_emptyable)
+     apply simp
+    apply (rename_tac cap1 cap2 p1 p2 p3)
+    apply (elim conjE exE)
+    apply (intro impI conjI)
+     apply simp
+     apply (rule corres_guard_imp)
+       apply (rule_tac F="wellformed_cap cap1 \<and> wellformed_cap cap2"
+              in corres_gen_asm)
+       apply (erule (1) cteSwap_corres [OF refl refl], simp+)
+      apply (simp add: invs_def valid_state_def valid_pspace_def
+                       real_cte_tcb_valid valid_cap_def2)
+     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
+                           cte_wp_at_ctes_of weak_derived'_def)
+    apply (simp split del: if_split)
+    apply (rule_tac F = "cte_map p1 \<noteq> cte_map p3" in corres_req)
+     apply clarsimp
+     apply (drule (2) cte_map_inj_eq [OF _ cte_wp_at_cte_at cte_wp_at_cte_at])
+        apply clarsimp
        apply clarsimp
       apply clarsimp
-     apply clarsimp
+     apply simp
     apply simp
-   apply simp
-   apply (rule corres_guard_imp)
-     apply (rule corres_split)
+    apply (rule corres_guard_imp)
+      apply (rule corres_split)
+         apply (erule cteMove_corres)
         apply (erule cteMove_corres)
-       apply (erule cteMove_corres)
-      apply wp
-      apply (simp add: cte_wp_at_caps_of_state)
-      apply (wp cap_move_caps_of_state cteMove_cte_wp_at [simplified o_def])+
-    apply (simp add: real_cte_tcb_valid invs_def valid_state_def valid_pspace_def)
+       apply wp
+       apply (simp add: cte_wp_at_caps_of_state)
+       apply (wp cap_move_caps_of_state cteMove_cte_wp_at [simplified o_def])+
+     apply (simp add: real_cte_tcb_valid invs_def valid_state_def valid_pspace_def)
+     apply (elim conjE exE)
+     apply (drule(3) real_cte_weak_derived_not_reply_masterD)+
+     apply (clarsimp simp: cte_wp_at_caps_of_state
+                           ex_cte_cap_to_cnode_always_appropriate_strg
+                           cte_wp_at_conj)
+    apply (simp add: cte_wp_at_ctes_of)
     apply (elim conjE exE)
-    apply (clarsimp simp: cte_wp_at_caps_of_state
-                          ex_cte_cap_to_cnode_always_appropriate_strg
-                          cte_wp_at_conj)
-   apply (simp add: cte_wp_at_ctes_of)
-   apply (elim conjE exE)
-   apply (intro impI conjI)
-          apply fastforce
-         apply (fastforce simp: weak_derived'_def)
-        apply simp
-        apply (erule weak_derived_sym')
-       apply clarsimp
-      apply simp
+    apply (intro impI conjI)
+            apply fastforce
+           apply (fastforce simp: weak_derived'_def)
+          apply simp
+         apply (erule weak_derived_sym')
+        apply clarsimp
+       apply simp
       apply clarsimp
      apply simp
     apply clarsimp
    apply clarsimp
-  apply (rename_tac prod)
-  apply (case_tac "has_cancel_send_rights prod",
+   apply (rename_tac prod)
+   apply (simp add: getThreadCallerSlot_def locateSlot_conv objBits_simps)
+   apply (rule corres_guard_imp)
+     apply (rule corres_split[OF getCurThread_corres])
+       apply (subgoal_tac "thread + 2^cte_level_bits * tcbCallerSlot = cte_map (thread, tcb_cnode_index 3)")
+        prefer 2
+        apply (simp add: cte_map_def tcb_cnode_index_def tcbCallerSlot_def cte_level_bits_def objBits_defs)
+       apply (rule corres_split[OF getSlotCap_corres])
+          apply simp
+         apply (rule_tac P="\<lambda>s. (is_reply_cap cap \<or> cap = cap.NullCap) \<and>
+       (is_reply_cap cap \<longrightarrow>
+        (einvs and cte_at (threada, tcb_cnode_index 3) and
+         cte_wp_at (\<lambda>c. c = cap.NullCap) prod and
+         real_cte_at prod and valid_cap cap and
+         K ((threada, tcb_cnode_index 3) \<noteq> prod)) s)" and
+        P'="\<lambda>s. (isReplyCap rv' \<and> \<not> capReplyMaster rv') \<longrightarrow> (invs' and
+         cte_wp_at'
+          (\<lambda>c. weak_derived' rv' (cteCap c) \<and>
+               cteCap c \<noteq> capability.NullCap)
+          (cte_map (threada, tcb_cnode_index 3)) and
+         cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) (cte_map prod)) s" in corres_inst)
+         apply (case_tac cap, simp_all add: isCap_simps is_cap_simps split: bool.split)[1]
+         apply clarsimp
+         apply (rule corres_guard_imp)
+           apply (rule cteMove_corres)
+           apply (simp add: real_cte_tcb_valid)+
+        apply (wp get_cap_wp)
+       apply (simp add: getSlotCap_def)
+       apply (wp getCTE_wp)+
+    apply clarsimp
+    apply (rule conjI)
+     apply (rule tcb_at_cte_at)
+      apply fastforce
+     apply (simp add: tcb_cap_cases_def)
+    apply (clarsimp simp: cte_wp_at_cte_at)
+    apply (rule conjI)
+     apply (frule tcb_at_invs)
+     apply (frule_tac ref="tcb_cnode_index 3" and Q="is_reply_cap or (=) cap.NullCap"
+                   in tcb_cap_wp_at)
+        apply (clarsimp split: Structures_A.thread_state.split_asm)+
+     apply (clarsimp simp: cte_wp_at_def is_cap_simps all_rights_def)
+    apply clarsimp
+    apply (rule conjI, simp add: cte_wp_valid_cap invs_valid_objs)
+    apply (clarsimp simp: cte_wp_at_def is_cap_simps all_rights_def)
+   apply clarsimp
+   apply (rule conjI, fastforce)
+   apply (rule conjI, fastforce)
+   apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
+  apply clarsimp
+  apply (case_tac "has_cancel_send_rights x7",
                 frule has_cancel_send_rights_ep_cap,
                 simp add: is_cap_simps)
    apply (clarsimp simp: when_def unless_def isCap_simps)
@@ -8743,14 +8790,14 @@ lemma updateCap_noop_irq_handlers:
 
 crunch updateCap
   for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and cur_tcb'[wp]: "cur_tcb'"
   (rule: ct_idle_or_in_cur_domain'_lift2)
 
 lemma updateCap_noop_invs:
   "\<lbrace>invs' and cte_wp_at' (\<lambda>cte. cteCap cte = cap) slot\<rbrace>
      updateCap slot cap
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def valid_pspace'_def valid_mdb'_def)
+  apply (simp add: invs'_def valid_state'_def
+                   valid_pspace'_def valid_mdb'_def)
   apply (rule hoare_pre)
    apply (wp updateCap_ctes_of_wp updateCap_iflive'
              updateCap_ifunsafe' updateCap_idle'
@@ -8761,7 +8808,7 @@ lemma updateCap_noop_invs:
   apply (strengthen untyped_ranges_zero_delta[where xs=Nil, mk_strg I E])
   apply (case_tac cte)
   apply (clarsimp simp: fun_upd_idem cteCaps_of_def modify_map_apply
-                        valid_mdb'_def o_def)
+                        valid_mdb'_def)
   apply (frule(1) ctes_of_valid')
   apply (frule(1) valid_global_refsD_with_objSize)
   apply clarsimp
@@ -8776,44 +8823,89 @@ lemmas make_zombie_or_noop_or_arch_invs
    hoare_vcg_disj_lift [OF make_zombie_invs' arch_update_updateCap_invs],
    simplified]
 
-crunch cteMove
-  for sc_at'_n[wp]: "sc_at'_n n p"
-  (simp: crunch_simps wp: crunch_wps)
-
 lemma invokeCNode_invs' [wp]:
   "\<lbrace>invs' and sch_act_simple and valid_cnode_inv' cinv\<rbrace>
     invokeCNode cinv \<lbrace>\<lambda>y. invs'\<rbrace>"
   unfolding invokeCNode_def
   apply (wpsimp wp: cteRevoke_invs' cteInsert_invs cteMove_ex cteMove_cte_wp_at
-                    getCTE_wp cteDelete_invs'
-              simp: unless_def getSlotCap_def locateSlot_conv
+getCTE_wp cteDelete_invs'
+            simp: unless_def getSlotCap_def getThreadCallerSlot_def locateSlot_conv
          split_del: if_split)
   apply (cases cinv; clarsimp)
-    apply (clarsimp simp: cte_wp_at_ctes_of is_derived'_def isCap_simps badge_derived'_def)
-    apply (erule(1) valid_irq_handlers_ctes_ofD)
-    apply (clarsimp simp: invs'_def)
-   apply (clarsimp simp: cte_wp_at_ctes_of)
-   apply (intro conjI impI; clarsimp elim!: weak_derived_sym')
+     apply (clarsimp simp: cte_wp_at_ctes_of is_derived'_def isCap_simps badge_derived'_def)
+     apply (erule(1) valid_irq_handlers_ctes_ofD)
+     apply (clarsimp simp: invs'_def valid_state'_def)
+    apply (clarsimp simp: cte_wp_at_ctes_of)
+    apply (intro conjI impI; clarsimp elim!: weak_derived_sym')
+   apply (clarsimp simp: cte_wp_at_ctes_of elim!: weak_derived_sym')
   apply (clarsimp simp: cte_wp_at_ctes_of elim!: weak_derived_sym')
+  apply (fastforce dest: ctes_of_valid')
   done
 
 declare withoutPreemption_lift [wp]
 
 crunch capSwapForDelete
-  for irq_states' [wp]: valid_irq_states'
+  for irq_states'[wp]: valid_irq_states'
+
 
 crunch finaliseCap
-  for irq_states' [wp]: valid_irq_states'
+  for irq_states'[wp]: valid_irq_states'
   (wp: crunch_wps unless_wp getASID_wp no_irq
        no_irq_invalidateLocalTLB_ASID no_irq_setHardwareASID
        no_irq_set_current_pd no_irq_invalidateLocalTLB_VAASID
-       no_irq_cleanByVA_PoU hoare_vcg_all_lift
+       no_irq_cleanByVA_PoU
    simp: crunch_simps armv_contextSwitch_HWASID_def o_def setCurrentPD_to_abs)
 
+lemma finaliseSlot_IRQInactive':
+  "s \<turnstile> \<lbrace>valid_irq_states'\<rbrace> finaliseSlot' a b
+  \<lbrace>\<lambda>_. valid_irq_states'\<rbrace>, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+proof (induct rule: finalise_spec_induct)
+  case (1 sl exp s)
+  show ?case
+    apply (rule hoare_pre_spec_validE)
+     apply (subst finaliseSlot'_simps_ext)
+     apply (simp only: split_def)
+     apply (wp "1.hyps")
+            apply (unfold Let_def split_def fst_conv snd_conv
+                          case_Zombie_assert_fold haskell_fail_def)
+            apply (wp getCTE_wp' preemptionPoint_invR| simp add: o_def irq_state_independent_HI)+
+            apply (rule hoare_post_imp[where Q'="\<lambda>_. valid_irq_states'"])
+             apply simp
+            apply wp[1]
+           apply (rule spec_strengthen_postE)
+            apply (rule "1.hyps", (assumption|rule refl)+)
+           apply simp
+          apply (wp hoare_drop_imps hoare_vcg_all_lift | simp add: locateSlot_conv)+
+    done
+qed
+
+lemma finaliseSlot_IRQInactive:
+  "\<lbrace>valid_irq_states'\<rbrace> finaliseSlot a b
+  -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply (unfold validE_E_def)
+  apply (rule hoare_strengthen_postE)
+  apply (rule use_spec(2) [OF finaliseSlot_IRQInactive', folded finaliseSlot_def])
+   apply (rule TrueI)
+  apply assumption
+  done
+
 lemma finaliseSlot_irq_states':
   "\<lbrace>valid_irq_states'\<rbrace> finaliseSlot a b \<lbrace>\<lambda>rv. valid_irq_states'\<rbrace>"
   by (wp finaliseSlot_preservation | clarsimp)+
 
+lemma cteDelete_IRQInactive:
+  "\<lbrace>valid_irq_states'\<rbrace> cteDelete x y
+  -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply (simp add: cteDelete_def split_def)
+  apply (wp whenE_wp)
+   apply (rule hoare_strengthen_postE)
+     apply (rule validE_E_validE)
+     apply (rule finaliseSlot_IRQInactive)
+    apply simp
+   apply simp
+  apply assumption
+  done
+
 lemma cteDelete_irq_states':
   "\<lbrace>valid_irq_states'\<rbrace> cteDelete x y
   \<lbrace>\<lambda>rv. valid_irq_states'\<rbrace>"
@@ -8827,6 +8919,47 @@ lemma cteDelete_irq_states':
   apply assumption
   done
 
+lemma preemptionPoint_IRQInactive_spec:
+  "s \<turnstile> \<lbrace>valid_irq_states'\<rbrace> preemptionPoint
+  \<lbrace>\<lambda>_. valid_irq_states'\<rbrace>, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply wp
+  apply (rule hoare_pre, wp preemptionPoint_invR)
+   apply clarsimp+
+  done
+
+lemma cteRevoke_IRQInactive':
+  "s \<turnstile> \<lbrace>valid_irq_states'\<rbrace> cteRevoke x
+  \<lbrace>\<lambda>_. \<top>\<rbrace>, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+proof (induct rule: cteRevoke.induct)
+  case (1 p s')
+  show ?case
+    apply (subst cteRevoke.simps)
+    apply (wp "1.hyps" unlessE_wp whenE_wp preemptionPoint_IRQInactive_spec
+              cteDelete_IRQInactive cteDelete_irq_states' getCTE_wp')+
+    apply clarsimp
+    done
+qed
+
+lemma cteRevoke_IRQInactive:
+  "\<lbrace>valid_irq_states'\<rbrace> cteRevoke x
+  -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply (unfold validE_E_def)
+  apply (rule use_spec)
+  apply (rule cteRevoke_IRQInactive')
+  done
+
+lemma inv_cnode_IRQInactive:
+  "\<lbrace>valid_irq_states'\<rbrace> invokeCNode cnode_inv
+  -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply (simp add: invokeCNode_def)
+  apply (rule hoare_pre)
+   apply (wp cteRevoke_IRQInactive finaliseSlot_IRQInactive
+             cteDelete_IRQInactive
+             whenE_wp
+           | wpc
+           | simp add:  split_def)+
+  done
+
 end
 
 end
diff --git a/proof/refine/ARM/CSpace1_R.thy b/proof/refine/ARM/CSpace1_R.thy
index ffed3d374e..c6ec4df343 100644
--- a/proof/refine/ARM/CSpace1_R.thy
+++ b/proof/refine/ARM/CSpace1_R.thy
@@ -11,9 +11,10 @@
 theory CSpace1_R
 imports
   CSpace_I
+  "AInvs.ArchDetSchedSchedule_AI"
 begin
 
-context Arch begin global_naming ARM_A (*FIXME: arch_split*)
+context Arch begin global_naming ARM_A (*FIXME: arch-split*)
 
 lemmas final_matters_def = final_matters_def[simplified final_matters_arch_def]
 
@@ -24,7 +25,7 @@ lemmas final_matters_simps[simp]
 
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma isMDBParentOf_CTE1:
   "isMDBParentOf (CTE cap node) cte =
@@ -136,7 +137,7 @@ lemma obj_size_relation:
   "\<lbrakk> cap_relation c c'; capClass c' = PhysicalClass \<rbrakk> \<Longrightarrow>
   obj_size c = capUntypedSize c'"
   apply (cases c, simp_all add: objBits_simps' zbits_map_def
-                                cte_level_bits_def min_sched_context_bits_def
+                                cte_level_bits_def
                          split: option.splits sum.splits)
   apply (rename_tac arch_cap)
   apply (case_tac arch_cap,
@@ -145,14 +146,25 @@ lemma obj_size_relation:
   done
 
 lemma same_region_as_relation:
-  "\<lbrakk> cap_relation c d; cap_relation c' d' \<rbrakk> \<Longrightarrow> same_region_as c c' = sameRegionAs d d'"
+    "\<lbrakk> cap_relation c d; cap_relation c' d' \<rbrakk> \<Longrightarrow>
+  same_region_as c c' = sameRegionAs d d'"
   apply (cases c)
-               apply clarsimp
-              apply (clarsimp simp: sameRegionAs_def isCap_simps Let_def is_phyiscal_relation)
-              apply (auto simp: obj_ref_of_relation obj_size_relation cong: conj_cong)[1]
-             apply ((cases c', auto simp: sameRegionAs_def isCap_simps Let_def)+)[11]
-  apply (cases c'; (clarsimp simp: same_arch_region_as_relation|
-                      clarsimp simp: sameRegionAs_def isCap_simps Let_def)+)
+            apply clarsimp
+           apply (clarsimp simp: sameRegionAs_def isCap_simps Let_def is_phyiscal_relation)
+           apply (auto simp: obj_ref_of_relation obj_size_relation cong: conj_cong)[1]
+          apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def)[1]
+         apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def)[1]
+        apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def)[1]
+       apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def bits_of_def)[1]
+      apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def)[1]
+     apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def)[1]
+    apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def)[1]
+   apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def)[1]
+   apply (cases c', auto simp: sameRegionAs_def isCap_simps Let_def)[1]
+  apply simp
+  apply (cases c')
+  apply (clarsimp simp: same_arch_region_as_relation|
+         clarsimp simp: sameRegionAs_def isCap_simps Let_def)+
   done
 
 lemma can_be_is:
@@ -180,20 +192,23 @@ lemma can_be_is:
   apply (auto simp: Let_def)[1]
   done
 
-lemma no_ofail_cte_wp_at'_readObject[simp]:
-  "no_ofail (cte_wp_at' (P::cte \<Rightarrow> bool) p) (readObject p::cte kernel_r)"
-  by (clarsimp simp: cte_wp_at'_def getObject_def readObject_def obind_def omonad_defs split_def
-                     no_ofail_def gets_the_def gets_def get_def bind_def
-                     return_def assert_opt_def fail_def
-              split: option.splits)
-
-lemma no_fail_getObject [wp]:
-  "no_fail (cte_at' p) (getObject p::cte kernel)"
-  by (clarsimp simp: getCTE_def getObject_def no_ofail_gets_the)
-
 lemma no_fail_getCTE [wp]:
   "no_fail (cte_at' p) (getCTE p)"
-  by (wpsimp simp: getCTE_def)
+  apply (simp add: getCTE_def getObject_def split_def
+                   loadObject_cte alignCheck_def unless_def
+                   alignError_def is_aligned_mask[symmetric]
+             cong: kernel_object.case_cong)
+  apply (rule no_fail_pre, (wp | wpc)+)
+  apply (clarsimp simp: cte_wp_at'_def getObject_def
+                        loadObject_cte split_def in_monad
+                 dest!: in_singleton
+             split del: if_split)
+  apply (clarsimp simp: in_monad typeError_def objBits_simps
+                        magnitudeCheck_def
+                 split: kernel_object.split_asm if_split_asm option.split_asm
+             split del: if_split)
+       apply simp+
+  done
 
 lemma tcb_cases_related:
   "tcb_cap_cases ref = Some (getF, setF, restr) \<Longrightarrow>
@@ -215,7 +230,7 @@ lemma pspace_relation_cte_wp_at:
    apply (simp add: unpleasant_helper)
    apply (drule spec, drule mp, erule domI)
    apply (clarsimp simp: cte_relation_def)
-   apply (drule(2) aligned'_distinct'_ko_at'I[where 'a=cte], simp)
+   apply (drule(2) aligned_distinct_obj_atI'[where 'a=cte])
     apply simp
    apply (drule ko_at_imp_cte_wp_at')
    apply (clarsimp elim!: cte_wp_at_weakenE')
@@ -223,7 +238,7 @@ lemma pspace_relation_cte_wp_at:
   apply (drule(1) pspace_relation_absD)
   apply (clarsimp simp: tcb_relation_cut_def)
   apply (simp split: kernel_object.split_asm)
-  apply (drule(2) aligned'_distinct'_ko_at'I[where 'a=tcb], simp)
+  apply (drule(2) aligned_distinct_obj_atI'[where 'a=tcb])
    apply simp
   apply (drule tcb_cases_related)
   apply (clarsimp simp: obj_at'_def projectKOs objBits_simps)
@@ -350,7 +365,8 @@ proof (induct rule: resolveAddressBits.induct)
     apply (elim exE conjE)
     apply (simp only: split: if_split_asm)
      apply (clarsimp simp: in_monad locateSlot_conv stateAssert_def)
-     apply (cases cap; simp add: isCap_defs)
+     apply (cases cap)
+       apply (simp_all add: isCap_defs)[12]
      apply (clarsimp simp add: valid_cap'_def objBits_simps' cte_level_bits_def
                         split: option.split_asm)
     apply (simp only: in_bindE_R K_bind_def)
@@ -360,7 +376,8 @@ proof (induct rule: resolveAddressBits.induct)
      apply (simp only: in_bindE_R K_bind_def)
      apply (frule (12) 1 [OF refl], (assumption | rule refl)+)
      apply (clarsimp simp: in_monad locateSlot_conv objBits_simps stateAssert_def)
-     apply (cases cap; simp add: isCap_defs)
+     apply (cases cap)
+       apply (simp_all add: isCap_defs)[12]
      apply (frule in_inv_by_hoareD [OF getSlotCap_inv])
      apply simp
      apply (frule (1) post_by_hoare [OF getSlotCap_valid_cap])
@@ -369,7 +386,8 @@ proof (induct rule: resolveAddressBits.induct)
      apply (drule (1) bspec)
      apply simp
     apply (clarsimp simp: in_monad locateSlot_conv objBits_simps stateAssert_def)
-    apply (cases cap; simp add: isCap_defs)
+    apply (cases cap)
+     apply (simp_all add: isCap_defs)[12]
     apply (frule in_inv_by_hoareD [OF getSlotCap_inv])
     apply (clarsimp simp: valid_cap'_def cte_level_bits_def objBits_defs)
     done
@@ -410,15 +428,17 @@ proof -
   } note x = this
   from assms
   show ?thesis
-  apply (cases c; simp add: simps)
-   defer
+  apply (cases c)
+            apply (simp_all add: simps)[5]
+       defer
+       apply (simp_all add: simps)[4]
    apply (clarsimp simp: simps the_arch_cap_def)
    apply (rename_tac arch_cap)
    apply (case_tac arch_cap)
-        apply (simp_all add: arch_update_cap_data_def
+        apply (simp_all add: simps arch_update_cap_data_def
                              ARM_H.updateCapData_def)[5]
   \<comment> \<open>CNodeCap\<close>
-  apply (simp add: word_bits_def the_cnode_cap_def andCapRights_def
+  apply (simp add: simps word_bits_def the_cnode_cap_def andCapRights_def
                    rightsFromWord_def data_to_rights_def nth_ucast cteRightsBits_def
                    cteGuardBits_def)
   apply (insert x)
@@ -431,7 +451,6 @@ proof -
   done
 qed
 
-end
 
 lemma cte_map_shift:
   assumes bl: "to_bl cref' = zs @ cref"
@@ -586,8 +605,8 @@ proof (induct a arbitrary: c' cref' bits rule: resolve_address_bits'.induct)
         apply (simp add: caps isCap_defs Let_def whenE_bindE_throwError_to_if)
         apply (subst cnode_cap_case_if)
         apply (corresKsimp search: getSlotCap_corres IH
-                              wp: get_cap_wp getSlotCap_valid hoare_drop_imps
-                            simp: locateSlot_conv stateAssert_def)
+                              wp: get_cap_wp getSlotCap_valid no_fail_stateAssert
+                            simp: locateSlot_conv)
         apply (simp add: drop_postfix_eq)
         apply clarsimp
         apply (prop_tac "is_aligned ptr (cte_level_bits + cbits) \<and> cbits \<le> word_bits - cte_level_bits")
@@ -618,15 +637,15 @@ proof (induct a arbitrary: c' cref' bits rule: resolve_address_bits'.induct)
             apply (erule (2) valid_CNodeCapE)
             apply (erule (3) cte_map_shift')
             apply simp
-           apply (erule (1) cte_map_shift; assumption?)
-           subgoal by simp
-          apply (clarsimp simp: cte_level_bits_def)
-          apply (rule conjI)
-           apply (clarsimp simp: valid_cap_def cap_table_at_gsCNodes isCap_simps)
-          apply (rule and_mask_less_size, simp add: word_bits_def word_size cte_level_bits_def)
-          apply (clarsimp split: if_splits)
-          done
-        done
+              apply (erule (1) cte_map_shift; assumption?)
+              subgoal by simp
+              apply (clarsimp simp: cte_level_bits_def)
+           apply (rule conjI)
+             apply (clarsimp simp: valid_cap_def cap_table_at_gsCNodes isCap_simps)
+             apply (rule and_mask_less_size, simp add: word_bits_def word_size cte_level_bits_def)
+           apply (clarsimp split: if_splits)
+           done
+         done
     }
     ultimately
     show ?thesis by fast
@@ -707,7 +726,7 @@ lemma lookupSlotForThread_corres:
    prefer 2
    apply (rule hoare_weaken_preE)
     apply (rule resolveAddressBits_cte_at')
-   apply (simp add: invs'_def valid_pspace'_def)
+   apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
   apply (simp add: returnOk_def split_def)
   done
 
@@ -744,9 +763,9 @@ lemma lookupCap_corres:
 lemma setObject_cte_obj_at_tcb':
   assumes x: "\<And>tcb f. P (tcbCTable_update f tcb) = P tcb"
              "\<And>tcb f. P (tcbVTable_update f tcb) = P tcb"
+             "\<And>tcb f. P (tcbReply_update f tcb) = P tcb"
+             "\<And>tcb f. P (tcbCaller_update f tcb) = P tcb"
              "\<And>tcb f. P (tcbIPCBufferFrame_update f tcb) = P tcb"
-             "\<And>tcb f. P (tcbFaultHandler_update f tcb) = P tcb"
-             "\<And>tcb f. P (tcbTimeoutHandler_update f tcb) = P tcb"
   shows
   "\<lbrace>\<lambda>s. P' (obj_at' (P :: tcb \<Rightarrow> bool) p s)\<rbrace>
   setObject c (cte::cte)
@@ -763,12 +782,17 @@ lemma setObject_cte_obj_at_tcb':
                         Structures_H.kernel_object.split_asm)
   done
 
-crunch setCTE
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
+lemma setCTE_typ_at':
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> setCTE c cte \<lbrace>\<lambda>_ s. P (typ_at' T p s)\<rbrace>"
+  by (clarsimp simp add: setCTE_def) (wp setObject_typ_at')
+
+lemmas setObject_typ_at [wp] = setObject_typ_at' [where P=id, simplified]
+
+lemma setCTE_typ_at [wp]:
+  "\<lbrace>typ_at' T p\<rbrace> setCTE c cte \<lbrace>\<lambda>_. typ_at' T p\<rbrace>"
+  by (clarsimp simp add: setCTE_def) wp
 
-global_interpretation setCTE: typ_at_all_props' "setCTE p v"
-  by typ_at_props'
+lemmas setCTE_typ_ats [wp] = typ_at_lifts [OF setCTE_typ_at']
 
 lemma setObject_cte_ksCurDomain[wp]:
   "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> setObject ptr (cte::cte) \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
@@ -868,7 +892,13 @@ lemma cap_insert_objs' [wp]:
    cteInsert cap src dest \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   including no_pre
   apply (simp add: cteInsert_def updateCap_def setUntypedCapAsFull_def bind_assoc split del: if_split)
-  apply (wpsimp wp: setCTE_valid_objs | rule hoare_drop_imp)+
+  apply (wp setCTE_valid_objs)
+      apply simp
+      apply wp+
+      apply (clarsimp simp: updateCap_def)
+      apply (wp|simp)+
+    apply (rule hoare_drop_imp)+
+    apply wp+
   apply (rule hoare_strengthen_post[OF getCTE_sp])
   apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps
                  dest!: ctes_of_valid_cap'')
@@ -884,7 +914,11 @@ lemma cteInsert_weak_cte_wp_at:
   apply (wp setCTE_weak_cte_wp_at updateMDB_weak_cte_wp_at hoare_weak_lift_imp | simp)+
    apply (wp getCTE_ctes_wp)+
    apply (clarsimp simp: isCap_simps split:if_split_asm| rule conjI)+
-  done
+done
+
+lemma setCTE_valid_cap:
+  "\<lbrace>valid_cap' c\<rbrace> setCTE ptr cte \<lbrace>\<lambda>r. valid_cap' c\<rbrace>"
+  by (rule typ_at_lifts, rule setCTE_typ_at')
 
 lemma set_is_modify:
   "m p = Some cte \<Longrightarrow>
@@ -926,8 +960,6 @@ abbreviation
 abbreviation
   "revokable' a b \<equiv> global.isCapRevocable b a"
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 declare arch_is_cap_revocable_def[simp] ARM_H.isCapRevocable_def[simp]
 
 lemmas revokable_def = is_cap_revocable_def is_cap_revocable_def[split_simps cap.split]
@@ -1207,7 +1239,10 @@ definition
   capBadge cap = capBadge cap' \<and>
   capASID cap = capASID cap' \<and>
   cap_asid_base' cap = cap_asid_base' cap' \<and>
-  cap_vptr' cap = cap_vptr' cap'"
+  cap_vptr' cap = cap_vptr' cap' \<and>
+  \<comment> \<open>check all fields of ReplyCap except capReplyCanGrant\<close>
+  (isReplyCap cap \<longrightarrow> capTCBPtr cap = capTCBPtr cap' \<and>
+                     capReplyMaster cap = capReplyMaster cap')"
 
 lemma capASID_update [simp]:
   "capASID (RetypeDecls_H.updateCapData P x c) = capASID c"
@@ -1262,10 +1297,14 @@ lemma updateCapData_Reply:
   done
 
 lemma weak_derived_updateCapData:
-  "\<lbrakk> updateCapData P x c \<noteq> NullCap; weak_derived' c c';
-     capBadge (updateCapData P x c) = capBadge c' \<rbrakk>
+  "\<lbrakk> (updateCapData P x c) \<noteq> NullCap; weak_derived' c c';
+      capBadge (updateCapData P x c) = capBadge c' \<rbrakk>
   \<Longrightarrow> weak_derived' (updateCapData P x c) c'"
-  by (clarsimp simp add: weak_derived'_def updateCapData_Master)
+  apply (clarsimp simp add: weak_derived'_def updateCapData_Master)
+  apply (clarsimp elim: impE dest!: iffD1[OF updateCapData_Reply])
+  apply (clarsimp simp: isCap_simps)
+  apply (clarsimp simp: Let_def isCap_simps updateCapData_def)
+  done
 
 lemma maskCapRights_Reply[simp]:
   "isReplyCap (maskCapRights r c) = isReplyCap c"
@@ -1659,35 +1698,41 @@ 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_relation (kheap s) (ksPSpace s')"
+  "pspace_relations (ekheap s) (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_relation (kheap t) (ksPSpace t')"
+             pspace_relations (ekheap t) (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)
+   apply (clarsimp simp: lookupAround2_char1 pspace_relations_def)
    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 gets_the_def)
-   apply (erule(2) pspace_relation_update_tcbs)
-   apply (simp add: c)
-  apply clarsimp
+                         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 (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 fail_def return_def
-                        set_object_def get_def put_def domI gets_the_def
-                        a_type_def[split_simps kernel_object.split arch_kernel_obj.split])
+                        set_object_def get_def put_def domI a_type_def[split_simps kernel_object.split arch_kernel_obj.split])
   apply (erule(1) valid_objsE)
   apply (clarsimp simp: valid_obj_def valid_cs_def valid_cs_size_def exI)
   apply (intro conjI impI)
@@ -1705,6 +1750,9 @@ lemma set_cap_not_quite_corres_prequel:
      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: wf_cs_insert)
   done
 
@@ -1717,20 +1765,15 @@ lemma setCTE_pspace_only:
 
 lemma set_cap_not_quite_corres:
   assumes cr:
-  "pspace_relation (kheap s) (ksPSpace s')"
+  "pspace_relations (ekheap s) (kheap s) (ksPSpace s')"
   "cur_thread s = ksCurThread s'"
   "idle_thread s = ksIdleThread s'"
-  "idle_sc_ptr = ksIdleSC s'"
   "machine_state s = ksMachineState s'"
   "work_units_completed s = ksWorkUnitsCompleted s'"
   "domain_index s = ksDomScheduleIdx s'"
   "domain_list s = ksDomSchedule s'"
   "cur_domain s = ksCurDomain s'"
   "domain_time s = ksDomainTime s'"
-  "consumed_time s = ksConsumedTime s'"
-  "cur_time s = ksCurTime s'"
-  "cur_sc s = ksCurSc s'"
-  "reprogram_timer s = ksReprogramTimer s'"
   "(x,t') \<in> fst (updateCap p' c' s')"
   "valid_objs s" "pspace_aligned s" "pspace_distinct s" "cte_at p s"
   "pspace_aligned' s'" "pspace_distinct' s'"
@@ -1739,30 +1782,24 @@ 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_relation (kheap t) (ksPSpace t') \<and>
+             pspace_relations (ekheap t) (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>
-             release_queue t = release_queue s \<and>
              is_original_cap t = is_original_cap s \<and>
              interrupt_state_relation (interrupt_irq_node t) (interrupt_states t)
                               (ksInterruptState t') \<and>
              (arch_state t, ksArchState t') \<in> arch_state_relation \<and>
              cur_thread t = ksCurThread t' \<and>
              idle_thread t = ksIdleThread t' \<and>
-             idle_sc_ptr = ksIdleSC t' \<and>
              machine_state t = ksMachineState t' \<and>
              work_units_completed t = ksWorkUnitsCompleted t' \<and>
              domain_index t = ksDomScheduleIdx t' \<and>
              domain_list t = ksDomSchedule t' \<and>
              cur_domain t = ksCurDomain t' \<and>
-             domain_time t = ksDomainTime t' \<and>
-             consumed_time t = ksConsumedTime t' \<and>
-             cur_time t = ksCurTime t' \<and>
-             cur_sc t = ksCurSc t' \<and>
-             reprogram_timer t = ksReprogramTimer t' \<and>
-             sc_replies_of t = sc_replies_of s"
+             domain_time t = ksDomainTime t'"
   using cr
   apply (clarsimp simp: updateCap_def in_monad)
   apply (drule use_valid [OF _ getCTE_sp[where P="\<lambda>s. s2 = s" for s2], OF _ refl])
@@ -1774,12 +1811,9 @@ lemma set_cap_not_quite_corres:
   apply (erule exEI)
   apply clarsimp
   apply (frule setCTE_pspace_only)
-  apply (prop_tac "sc_replies_of x = sc_replies_of s")
-   apply (erule use_valid[OF _ set_cap.valid_sched_pred], simp)
   apply (clarsimp simp: set_cap_def split_def in_monad set_object_def
-                        get_object_def)
-  apply (rename_tac obj ps' x' obj' kobj)
-  apply (case_tac obj; clarsimp simp: fail_def return_def split: if_split_asm)
+                        get_object_def
+                 split: Structures_A.kernel_object.split_asm if_split_asm)
   done
 
 lemma descendants_of_eq':
@@ -1803,54 +1837,46 @@ lemma descendants_of_eq':
   apply simp
   done
 
-\<comment>\<open>
-  This turned out to be the least-annoying way to deal with
-  the subgoal @{term
-    "ps' |> reply_of' |> replyNext_of = replyNexts_of s'"
-  } which shows up in the proof of `updateCap_corres`.
+lemma setObject_cte_tcbSchedPrevs_of_use_valid_ksPSpace:
+  assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
+  assumes pre: "P (tcbSchedPrevs_of s)"
+  shows "P (ps |> tcb_of' |> tcbSchedPrev)"
+  using use_valid[OF step setObject_cte_tcbSchedPrevs_of(1)] pre
+  by auto
 
-  `ps'` here comes from `ksPSpace s''`, where `s''` is the new state
-  after `setObject`. Unforutnately, @{thm setObject_cte_replies_of'} is
-  specified in terms of `replies_of'`, which uses `ksPSpace` as an
-  accessor and so can't be used for a goal that refers to the PSpace
-  directly.
-\<close>
-lemma setObject_cte_replies_of'_use_valid_ksPSpace:
+lemma setObject_cte_tcbSchedNexts_of_use_valid_ksPSpace:
   assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
-      and pre: "P (replies_of' s)"
-  shows "P (ps |> reply_of')"
-  using use_valid[OF step setObject_cte_replies_of'] pre
+  assumes pre: "P (tcbSchedNexts_of s)"
+  shows "P (ps |> tcb_of' |> tcbSchedNext)"
+  using use_valid[OF step setObject_cte_tcbSchedNexts_of(1)] pre
   by auto
 
-lemma setObject_cte_scs_of'_use_valid_ksPSpace:
+lemma setObject_cte_inQ_of_use_valid_ksPSpace:
   assumes step: "(x, s\<lparr>ksPSpace := ps\<rparr>) \<in> fst (setObject p (cte :: cte) s)"
-      and pre: "P (scs_of' s)"
-  shows "P (ps |> sc_of')"
-  using use_valid[OF step setObject_scs_of'(1)] pre
+  assumes pre: "P (inQ domain priority |< tcbs_of' s)"
+  shows "P (inQ domain priority |< (ps |> tcb_of'))"
+  using use_valid[OF step setObject_cte_inQ(1)] pre
   by auto
 
 lemma updateCap_stuff:
   assumes "(x, s'') \<in> fst (updateCap p cap s')"
-  shows "ctes_of s'' = modify_map (ctes_of s') p (cteCap_update (K cap)) \<and>
+  shows "(ctes_of s'' = modify_map (ctes_of s') p (cteCap_update (K cap))) \<and>
          gsUserPages s'' = gsUserPages s' \<and>
          gsCNodes s'' = gsCNodes s' \<and>
          ksMachineState s'' = ksMachineState s' \<and>
          ksWorkUnitsCompleted s'' = ksWorkUnitsCompleted s' \<and>
          ksCurThread s'' = ksCurThread s' \<and>
          ksIdleThread s'' = ksIdleThread s' \<and>
-         ksIdleSC s'' = ksIdleSC s' \<and>
          ksReadyQueues s'' = ksReadyQueues s' \<and>
-         ksReleaseQueue s'' = ksReleaseQueue s' \<and>
          ksSchedulerAction s'' = ksSchedulerAction s' \<and>
          (ksArchState s'' = ksArchState s') \<and>
          (pspace_aligned' s' \<longrightarrow> pspace_aligned' s'') \<and>
          (pspace_distinct' s' \<longrightarrow> pspace_distinct' s'') \<and>
-         replyPrevs_of s'' = replyPrevs_of s' \<and>
-         scReplies_of s'' = scReplies_of s' \<and>
-         ksConsumedTime s'' = ksConsumedTime s' \<and>
-         ksCurTime s'' = ksCurTime s' \<and>
-         ksCurSc s'' = ksCurSc s' \<and>
-         ksReprogramTimer s'' = ksReprogramTimer s'" using assms
+         tcbSchedPrevs_of s'' = tcbSchedPrevs_of s' \<and>
+         tcbSchedNexts_of s'' = tcbSchedNexts_of s' \<and>
+         (\<forall>domain priority.
+            (inQ domain priority |< tcbs_of' s'') = (inQ domain priority |< tcbs_of' s'))"
+  using assms
   apply (clarsimp simp: updateCap_def in_monad)
   apply (drule use_valid [where P="\<lambda>s. s2 = s" for s2, OF _ getCTE_sp refl])
   apply (rule conjI)
@@ -1859,16 +1885,11 @@ lemma updateCap_stuff:
   apply (frule setCTE_pspace_only)
   apply (clarsimp simp: setCTE_def)
   apply (intro conjI impI)
-     apply (erule use_valid [OF _ setObject_aligned])
-      apply (clarsimp simp: updateObject_cte in_monad typeError_def
-                            in_magnitude_check objBits_simps
-                     split: kernel_object.split_asm if_split_asm)
-    apply (erule use_valid [OF _ setObject_distinct])
-     apply (clarsimp simp: updateObject_cte in_monad typeError_def
-                           in_magnitude_check objBits_simps
-                    split: kernel_object.split_asm if_split_asm)
-   apply (erule setObject_cte_replies_of'_use_valid_ksPSpace; simp)
-  apply (erule setObject_cte_scs_of'_use_valid_ksPSpace; simp)
+      apply (erule(1) use_valid [OF _ setObject_aligned])
+     apply (erule(1) use_valid [OF _ setObject_distinct])
+    apply (erule setObject_cte_tcbSchedPrevs_of_use_valid_ksPSpace; simp)
+   apply (erule setObject_cte_tcbSchedNexts_of_use_valid_ksPSpace; simp)
+  apply (fastforce elim: setObject_cte_inQ_of_use_valid_ksPSpace)
   done
 
 (* FIXME: move *)
@@ -2185,33 +2206,24 @@ lemma ctes_of_valid:
   apply (fastforce)
   done
 
-lemma readObject_cte_at'[simplified]:
-  "bound (readObject p s :: cte option) \<Longrightarrow> cte_at' p s"
-  unfolding cte_wp_at'_def getObject_def
-  by (clarsimp simp: omonad_defs split_def gets_the_def exec_gets return_def)
-
-lemma readObject_cte_ko_at':
-  "readObject p s = Some (cte :: cte) \<Longrightarrow> cte_wp_at' ((=) cte) p s"
-  unfolding cte_wp_at'_def getObject_def
-  by (clarsimp simp: omonad_defs split_def gets_the_def exec_gets return_def)
-
-lemma no_fail_setObject_cte [wp]:
-  "no_fail (cte_at' t) (setObject t (t'::cte))"
-  unfolding setObject_def
-  apply (clarsimp simp: updateObject_cte gets_the_def alignCheck_def is_aligned_mask[symmetric]
-             split del: if_split cong: kernel_object.case_cong)
-  apply (wp|wpc)+
-  apply (clarsimp simp: cte_wp_at'_def getObject_def split_def
-                        in_monad loadObject_cte readObject_def omonad_defs
-                 dest!: in_singleton split: option.splits split del: if_split)
-  by (fastforce simp: read_typeError_def objBits_simps
-                      read_magnitudeCheck_def ohaskell_assert_def
-               split: kernel_object.split_asm if_split_asm
-           split del: if_split)
-
 lemma no_fail_setCTE [wp]:
   "no_fail (cte_at' p) (setCTE p c)"
-  unfolding setCTE_def by wp
+  apply (clarsimp simp: setCTE_def setObject_def split_def unless_def
+                        updateObject_cte alignCheck_def alignError_def
+                        typeError_def is_aligned_mask[symmetric]
+                  cong: kernel_object.case_cong)
+  apply (wp|wpc)+
+  apply (clarsimp simp: cte_wp_at'_def getObject_def split_def
+                        in_monad loadObject_cte
+                 dest!: in_singleton
+             split del: if_split)
+  apply (clarsimp simp: typeError_def alignCheck_def alignError_def
+                        in_monad is_aligned_mask[symmetric] objBits_simps
+                        magnitudeCheck_def
+                 split: kernel_object.split_asm if_split_asm option.splits
+             split del: if_split)
+    apply simp_all
+  done
 
 lemma no_fail_updateCap [wp]:
   "no_fail (cte_at' p) (updateCap p cap')"
@@ -2264,20 +2276,23 @@ lemma is_final_untyped_ptrs:
   done
 
 lemma capClass_ztc_relation:
-  "\<lbrakk> is_zombie c \<or> is_cnode_cap c \<or> is_thread_cap c; cap_relation c c' \<rbrakk>
-   \<Longrightarrow> capClass c' = PhysicalClass"
+  "\<lbrakk> is_zombie c \<or> is_cnode_cap c \<or> is_thread_cap c;
+       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>
-   \<Longrightarrow> corres dc (\<lambda>s. invs s
-                      \<and> cte_wp_at
-                          (\<lambda>c. (is_zombie c \<or> is_cnode_cap c \<or> is_thread_cap c)
-                            \<and> is_final_cap' c s
-                            \<and> obj_ref_of c = obj_ref_of cap
-                            \<and> obj_size c = obj_size cap)
-                          slot s)
+   \<Longrightarrow> corres dc (\<lambda>s. invs s \<and>
+                      cte_wp_at (\<lambda>c. (is_zombie c \<or> is_cnode_cap c \<or>
+                                      is_thread_cap c) \<and>
+                                     is_final_cap' c s \<and>
+                                     obj_ref_of c = obj_ref_of cap \<and>
+                                     obj_size c = obj_size cap) slot s)
                  invs'
                  (set_cap cap slot) (updateCap (cte_map slot) cap')"
   apply (rule corres_stronger_no_failI)
@@ -2290,30 +2305,39 @@ 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)
+  apply (clarsimp simp: in_set_cap_cte_at_swp pspace_relations_def)
   apply (drule updateCap_stuff)
-  apply (rename_tac abs conc conc' abs')
-
-  (* FIXME RT: replace this with whatever comes out of VER-1248. *)
+  apply simp
   apply (extract_conjunct \<open>match conclusion in "ghost_relation _ _ _" \<Rightarrow> -\<close>)
    apply (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def)
-
-  apply (extract_conjunct \<open>match conclusion in "sched_act_relation _ _" \<Rightarrow> -\<close>)
-   apply clarsimp
-
-  apply (extract_conjunct \<open>match conclusion in "cdt_relation _ _ _" \<Rightarrow> -\<close>)
-   apply (case_tac "ctes_of conc (cte_map slot)")
-    apply (simp add: modify_map_None)
-   apply (simp add: modify_map_apply)
-   apply (simp add: cdt_relation_def del: split_paired_All)
+  apply (rule conjI)
+   prefer 2
+   apply (rule conjI)
+    apply (unfold cdt_list_relation_def)[1]
+    apply (intro allI impI)
+    apply (erule_tac x=c in allE)
+    apply (auto elim!: modify_map_casesE)[1]
+   apply (unfold revokable_relation_def)[1]
+   apply (drule set_cap_caps_of_state_monad)
+   apply (simp add: cte_wp_at_caps_of_state del: split_paired_All)
    apply (intro allI impI)
-   apply (rule use_update_ztc_one [OF descendants_of_update_ztc])
+   apply (erule_tac x=c in allE)
+   apply (erule impE[where P="\<exists>y. v = Some y" for v])
+    apply (clarsimp simp: null_filter_def is_zombie_def split: if_split_asm)
+   apply (auto elim!: modify_map_casesE del: disjE)[1]
+  apply (case_tac "ctes_of b (cte_map slot)")
+   apply (simp add: modify_map_None)
+  apply (simp add: modify_map_apply)
+  apply (simp add: cdt_relation_def del: split_paired_All)
+  apply (intro allI impI)
+  apply (rule use_update_ztc_one [OF descendants_of_update_ztc])
          apply simp
         apply assumption
        apply (auto simp: is_cap_simps isCap_simps)[1]
@@ -2331,45 +2355,21 @@ lemma updateCap_corres:
    apply (drule cte_wp_at_norm, clarsimp)
    apply (drule(1) pspace_relation_ctes_ofI, clarsimp+)
    apply (simp add: is_cap_simps, elim disjE exE, simp_all add: isCap_simps)[1]
-   apply clarsimp
-
-  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation _ _" \<Rightarrow> -\<close>)
-   apply (case_tac "ctes_of conc (cte_map slot)")
-    apply (simp add: modify_map_None)
-   apply (simp add: modify_map_apply)
-
-  apply (extract_conjunct \<open>match conclusion in "cdt_list_relation _ _ _" \<Rightarrow> -\<close>)
-   apply (unfold cdt_list_relation_def)[1]
-   apply (intro allI impI)
-   apply (erule_tac x=c in allE)
-   apply (auto elim!: modify_map_casesE)[1]
-
-  apply (extract_conjunct \<open>match conclusion in "revokable_relation _ _ _" \<Rightarrow> -\<close>)
-   apply (unfold revokable_relation_def)[1]
-   apply (drule set_cap_caps_of_state_monad)
-   apply (simp add: cte_wp_at_caps_of_state del: split_paired_All)
-   apply (intro allI impI)
-   apply (erule_tac x=c in allE)
-   apply (erule impE[where P="\<exists>y. v = Some y" for v])
-    apply (clarsimp simp: null_filter_def is_zombie_def split: if_split_asm)
-   apply (auto elim!: modify_map_casesE del: disjE)[1]
-
-  apply (extract_conjunct \<open>match conclusion in "release_queue_relation _ _" \<Rightarrow> -\<close>)
-   apply (clarsimp simp: release_queue_relation_def
-                  elim!: use_valid[OF _ set_cap.valid_sched_pred])
-
-  apply (clarsimp simp: sc_replies_relation_def)
+  apply clarsimp
   done
 
+lemma exst_set_cap:
+  "(x,s') \<in> fst (set_cap p c s) \<Longrightarrow> exst s' = exst s"
+  by (clarsimp simp: set_cap_def in_monad split_def get_object_def set_object_def
+               split: if_split_asm Structures_A.kernel_object.splits)
+
 lemma updateMDB_eqs:
   assumes "(x, s'') \<in> fst (updateMDB p f s')"
   shows "ksMachineState s'' = ksMachineState s' \<and>
          ksWorkUnitsCompleted s'' = ksWorkUnitsCompleted s' \<and>
          ksCurThread s'' = ksCurThread s' \<and>
          ksIdleThread s'' = ksIdleThread s' \<and>
-         ksIdleSC s'' = ksIdleSC s' \<and>
          ksReadyQueues s'' = ksReadyQueues s' \<and>
-         ksReleaseQueue s'' = ksReleaseQueue s' \<and>
          ksInterruptState s'' = ksInterruptState s' \<and>
          ksArchState s'' = ksArchState s' \<and>
          ksSchedulerAction s'' = ksSchedulerAction s' \<and>
@@ -2434,6 +2434,24 @@ 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)"
@@ -2448,52 +2466,70 @@ lemma updateMDB_ctes_of:
   done
 
 crunch updateMDB
-  for replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
-  and scs_of'[wp]: "\<lambda>s. P (scs_of' s)"
-  and ksConsumedTime[wp]: "\<lambda>s. P (ksConsumedTime s)"
-  and ksCurTime[wp]: "\<lambda>s. P (ksCurTime s)"
-  and ksCurSc[wp]: "\<lambda>s. P (ksCurSc s)"
-  and ksReprogramTimer[wp]: "\<lambda>s. P (ksReprogramTimer s)"
-  and aligned[wp]: pspace_aligned'
-  and pdistinct[wp]: pspace_distinct'
+  for aligned[wp]: "pspace_aligned'"
+crunch updateMDB
+  for pdistinct[wp]: "pspace_distinct'"
+crunch updateMDB
+  for tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+crunch updateMDB
+  for tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+crunch updateMDB
+  for inQ_opt_pred[wp]: "\<lambda>s. P (inQ d p |< tcbs_of' s)"
+crunch updateMDB
+  for inQ_opt_pred'[wp]: "\<lambda>s. P (\<lambda>d p. inQ d p |< tcbs_of' s)"
+crunch updateMDB
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
   (wp: crunch_wps simp: crunch_simps setObject_def updateObject_cte)
 
+lemma setCTE_rdyq_projs[wp]:
+  "setCTE p f \<lbrace>\<lambda>s. P (ksReadyQueues s) (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                      (\<lambda>d p. inQ d p |< tcbs_of' s)\<rbrace>"
+  apply (rule hoare_lift_Pf2[where f=ksReadyQueues])
+   apply (rule hoare_lift_Pf2[where f=tcbSchedNexts_of])
+    apply (rule hoare_lift_Pf2[where f=tcbSchedPrevs_of])
+     apply wpsimp+
+  done
+
+crunch updateMDB
+  for rdyq_projs[wp]:"\<lambda>s. P (ksReadyQueues s) (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                             (\<lambda>d p. inQ d p |< tcbs_of' s)"
+
 lemma updateMDB_the_lot:
   assumes "(x, s'') \<in> fst (updateMDB p f s')"
-  assumes "pspace_relation (kheap s) (ksPSpace s')"
+  assumes "pspace_relations (ekheap s) (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>
          ksCurThread s'' = ksCurThread s' \<and>
          ksIdleThread s'' = ksIdleThread s' \<and>
-         ksIdleSC s'' = ksIdleSC s' \<and>
          ksReadyQueues s'' = ksReadyQueues s' \<and>
-         ksReleaseQueue s'' = ksReleaseQueue s' \<and>
          ksSchedulerAction s'' = ksSchedulerAction s' \<and>
          ksInterruptState s'' = ksInterruptState s' \<and>
          ksArchState s'' = ksArchState s' \<and>
          gsUserPages s'' = gsUserPages s' \<and>
          gsCNodes s'' = gsCNodes s' \<and>
-         pspace_relation (kheap s) (ksPSpace s'') \<and>
+         pspace_relations (ekheap s) (kheap s) (ksPSpace s'') \<and>
          pspace_aligned' s'' \<and> pspace_distinct' s'' \<and>
          no_0 (ctes_of s'') \<and>
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
          ksDomainTime s''     = ksDomainTime s' \<and>
-         ksConsumedTime s''   = ksConsumedTime s' \<and>
-         ksCurTime s''        = ksCurTime s' \<and>
-         ksCurSc s''          = ksCurSc s' \<and>
-         ksReprogramTimer s'' = ksReprogramTimer s' \<and>
-         replyPrevs_of s'' = replyPrevs_of s' \<and>
-         scReplies_of s'' = scReplies_of s'"
-  using assms
-  apply (simp add: updateMDB_eqs updateMDB_pspace_relation split del: if_split)
+         tcbSchedNexts_of s'' = tcbSchedNexts_of s' \<and>
+         tcbSchedPrevs_of s'' = tcbSchedPrevs_of s' \<and>
+         (\<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 (frule (1) updateMDB_ctes_of)
   apply clarsimp
-  apply (erule use_valid, wp)
-  apply simp
+  apply (rule conjI)
+   apply (erule use_valid)
+    apply wp
+   apply simp
+  apply (erule use_valid, wpsimp wp: hoare_vcg_all_lift)
+  apply (simp add: comp_def)
   done
 
 lemma revokable_eq:
@@ -2630,7 +2666,20 @@ lemma subtree_next_0:
 definition
   "isArchCap P cap \<equiv> case cap of ArchObjectCap acap \<Rightarrow> P acap | _ \<Rightarrow> False"
 
-lemmas isArchCap_simps[simp] = isArchCap_def[split_simps capability.split]
+lemma isArchCap_simps[simp]:
+  "isArchCap P (capability.ThreadCap xc) = False"
+  "isArchCap P capability.NullCap = False"
+  "isArchCap P capability.DomainCap = False"
+  "isArchCap P (capability.NotificationCap xca xba xaa xd) = False"
+  "isArchCap P (capability.EndpointCap xda xcb xbb xab xe xi) = False"
+  "isArchCap P (capability.IRQHandlerCap xf) = False"
+  "isArchCap P (capability.Zombie xbc xac xg) = False"
+  "isArchCap P (capability.ArchObjectCap xh) = P xh"
+  "isArchCap P (capability.ReplyCap xad xi xia) = False"
+  "isArchCap P (capability.UntypedCap d xae xj f) = False"
+  "isArchCap P (capability.CNodeCap xfa xea xdb xcc) = False"
+  "isArchCap P capability.IRQControlCap = False"
+  by (simp add: isArchCap_def)+
 
 definition
   vsCapRef :: "capability \<Rightarrow> vs_ref list option"
@@ -2678,6 +2727,8 @@ definition
   badge_derived' cap' cap \<and>
   (isUntypedCap cap \<longrightarrow> descendants_of' p m = {}) \<and>
   (isReplyCap cap = isReplyCap cap') \<and>
+  (isReplyCap cap \<longrightarrow> capReplyMaster cap) \<and>
+  (isReplyCap cap' \<longrightarrow> \<not> capReplyMaster cap') \<and>
   (vsCapRef cap = vsCapRef cap' \<or> isArchCap isPageCap cap') \<and>
   ((isArchCap isPageTableCap cap \<or> isArchCap isPageDirectoryCap cap)
         \<longrightarrow> capASID cap = capASID cap' \<and> capASID cap \<noteq> None)"
@@ -2703,12 +2754,19 @@ lemma capBadge_ordering_relation:
   "\<lbrakk> cap_relation c c'; cap_relation d d' \<rbrakk> \<Longrightarrow>
   ((capBadge c', capBadge d') \<in> capBadge_ordering f) =
   ((cap_badge c, cap_badge d) \<in> capBadge_ordering f)"
-  by (cases c, auto simp add: cap_badge_def capBadge_ordering_def split: cap.splits)
+  apply (cases c)
+   apply (auto simp add: cap_badge_def capBadge_ordering_def split: cap.splits)
+  done
 
 lemma is_reply_cap_relation:
-  "cap_relation c c' \<Longrightarrow> is_reply_cap c = (isReplyCap c')"
+  "cap_relation c c' \<Longrightarrow> is_reply_cap c = (isReplyCap c' \<and> \<not> capReplyMaster c')"
   by (cases c, auto simp: is_cap_simps isCap_simps)
 
+lemma is_reply_master_relation:
+  "cap_relation c c' \<Longrightarrow>
+   is_master_reply_cap c = (isReplyCap c' \<and> capReplyMaster c')"
+  by (cases c, auto simp add: is_cap_simps isCap_simps)
+
 lemma cap_asid_cap_relation:
   "cap_relation c c' \<Longrightarrow> capASID c' = cap_asid c"
   by (auto simp: capASID_def cap_asid_def split: cap.splits arch_cap.splits)
@@ -2727,28 +2785,30 @@ lemma is_derived_eq:
   apply (rule conjI)
    apply (clarsimp simp: is_cap_simps isCap_simps)
    apply (cases c, auto simp: isCap_simps cap_master_cap_def capMasterCap_def)[1]
-    apply (simp add:vsCapRef_def)
-   apply (simp add:vs_cap_ref_def)
-  apply (cases "isIRQControlCap d'")
+  apply (simp add:vsCapRef_def)
+  apply (simp add:vs_cap_ref_def)
+  apply (case_tac "isIRQControlCap d'")
    apply (frule(1) master_cap_relation)
    apply (clarsimp simp: isCap_simps cap_master_cap_def
-                         is_zombie_def is_reply_cap_def
+                         is_zombie_def is_reply_cap_def is_master_reply_cap_def
                   split: cap_relation_split_asm arch_cap.split_asm)[1]
   apply (frule(1) master_cap_relation)
   apply (frule(1) cap_badge_relation)
   apply (frule cap_asid_cap_relation)
   apply (frule(1) capBadge_ordering_relation)
-  apply (case_tac d; simp add: isCap_simps is_cap_simps cap_master_cap_def
-                               vs_cap_ref_def vsCapRef_def capMasterCap_def
-                          split: cap_relation_split_asm arch_cap.split_asm)
-      apply ((auto split:arch_cap.splits arch_capability.splits)[3])
-   apply (clarsimp split:option.splits arch_cap.splits arch_capability.splits)
-   apply (intro conjI|clarsimp)+
-     apply fastforce
-    apply clarsimp+
+  apply (case_tac d)
+   apply (simp_all add: isCap_simps is_cap_simps cap_master_cap_def
+     vs_cap_ref_def vsCapRef_def capMasterCap_def
+     split: cap_relation_split_asm arch_cap.split_asm)
+   apply fastforce
+  apply ((auto split:arch_cap.splits arch_capability.splits)[3])
   apply (clarsimp split:option.splits arch_cap.splits arch_capability.splits)
   apply (intro conjI|clarsimp)+
-  apply fastforce
+    apply fastforce
+   apply clarsimp+
+  apply (clarsimp split:option.splits arch_cap.splits arch_capability.splits)
+  apply (intro conjI|clarsimp)+
+   apply fastforce
   done
 end
 
@@ -2756,7 +2816,7 @@ locale masterCap =
   fixes cap cap'
   assumes master: "capMasterCap cap = capMasterCap cap'"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 
 lemma isZombie [simp]:
   "isZombie cap' = isZombie cap" using master
@@ -3339,7 +3399,7 @@ locale mdb_insert_sib = mdb_insert_der +
            (mdbRevocable_update (\<lambda>a. revokable' src_cap c')
            (mdbPrev_update (\<lambda>a. src) src_node))))"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 
 (* If dest is inserted as sibling, src can not have had children.
    If it had had children, then dest_node which is just a derived copy
@@ -3486,7 +3546,7 @@ lemma descendants:
   by (rule set_eqI) (simp add: descendants_of'_def parent_n_eq)
 
 end
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma mdb_None:
   assumes F: "\<And>p'. cte_map p \<in> descendants_of' p' m' \<Longrightarrow> False"
   assumes R: "cdt_relation (swp cte_at s) (cdt s) m'"
@@ -3681,6 +3741,7 @@ 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+
@@ -3691,26 +3752,41 @@ 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 (rename_tac abs conc conc' abs')
-
-  (* FIXME RT: replace this with whatever comes out of VER-1248. *)
-  apply (extract_conjunct \<open>match conclusion in "ghost_relation _ _ _" \<Rightarrow> -\<close>)
+  apply (rule conjI)
+   apply (frule setCTE_pspace_only)
+   apply (clarsimp simp: set_cap_def in_monad split_def get_object_def set_object_def
+                    split: if_split_asm Structures_A.kernel_object.splits)
+  apply (extract_conjunct \<open>match conclusion in "ready_queues_relation _ _" \<Rightarrow> -\<close>)
+   apply (clarsimp simp: ready_queues_relation_def Let_def)
+   apply (rule use_valid[OF _ setCTE_tcbSchedPrevs_of], assumption)
+   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 clarsimp
+  apply (rule conjI)
    apply (frule setCTE_pspace_only)
    apply (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def)
-
-  apply (extract_conjunct \<open>match conclusion in "cdt_list_relation _ _ _" \<Rightarrow> -\<close>)
-   apply (frule mdb_set_cap, frule exst_set_cap)
-   apply (erule use_valid [OF _ setCTE_ctes_of_wp])
-   apply (clarsimp simp: cdt_list_relation_def cte_wp_at_ctes_of split: if_split_asm)
-
-  apply (extract_conjunct \<open>match conclusion in "revokable_relation _ _ _" \<Rightarrow> -\<close>)
+  apply (rule conjI)
+   prefer 2
+   apply (rule conjI)
+    apply (frule mdb_set_cap, frule exst_set_cap)
+    apply (erule use_valid [OF _ setCTE_ctes_of_wp])
+    apply (clarsimp simp: cdt_list_relation_def cte_wp_at_ctes_of split: if_split_asm)
+   apply (rule conjI)
+    prefer 2
+    apply (frule setCTE_pspace_only)
+    apply clarsimp
+    apply (clarsimp simp: set_cap_def in_monad split_def get_object_def set_object_def
+                    split: if_split_asm Structures_A.kernel_object.splits)
    apply (frule set_cap_caps_of_state_monad)
    apply (drule is_original_cap_set_cap)
    apply clarsimp
    apply (erule use_valid [OF _ setCTE_ctes_of_wp])
    apply (clarsimp simp: revokable_relation_def simp del: fun_upd_apply)
-   apply (rename_tac oref cidx cap' cap'' node)
    apply (clarsimp split: if_split_asm)
     apply (frule cte_map_inj_eq)
          prefer 2
@@ -3723,41 +3799,26 @@ lemma setCTE_UntypedCap_corres:
      apply fastforce
     apply clarsimp
     apply (simp add: null_filter_def split: if_split_asm)
-    apply (erule_tac x=oref in allE, erule_tac x=cidx in allE)
+    apply (erule_tac x=aa in allE, erule_tac x=bb in allE)
     apply (case_tac cte)
     apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps isCap_simps cte_wp_at_ctes_of)
    apply (simp add: null_filter_def cte_wp_at_caps_of_state split: if_split_asm)
-   apply (erule_tac x=oref in allE, erule_tac x=cidx in allE)
+   apply (erule_tac x=aa in allE, erule_tac x=bb in allE)
    apply (clarsimp)
-
-  apply (extract_conjunct \<open>match conclusion in "cdt_relation _ _ _" \<Rightarrow> -\<close>)
-   apply (clarsimp simp: cdt_relation_def)
-   apply (rename_tac oref cidx)
-   apply (frule set_cap_caps_of_state_monad)
-   apply (frule mdb_set_cap)
-   apply clarsimp
-   apply (erule use_valid [OF _ setCTE_ctes_of_wp])
-   apply (frule cte_wp_at_norm)
-   apply (clarsimp simp:cte_wp_at_ctes_of simp del: fun_upd_apply)
-   apply (drule_tac slot = "cte_map (oref, cidx)" in updateUntypedCap_descendants_of)
-    apply (clarsimp simp:isCap_simps)
-   apply (drule_tac x = oref in spec)
-   apply (drule_tac x = cidx in spec)
-   apply (erule impE)
-    apply (clarsimp simp: cte_wp_at_caps_of_state split:if_splits)
-   apply auto[1]
-
-  apply (extract_conjunct \<open>match conclusion in "sc_replies_relation _ _" \<Rightarrow> -\<close>)
-   apply (clarsimp simp: sc_replies_relation_def
-                  elim!: use_valid[OF _ set_cap.valid_sched_pred])
-   apply (rule use_valid[OF _ setCTE_replies_of'], assumption)
-   apply (rule use_valid[OF _ setCTE_scs_of'], assumption)
-   apply clarsimp
-
-  apply (frule setCTE_pspace_only)
-  apply (clarsimp simp: set_cap_def in_monad split_def get_object_def set_object_def)
-  apply (rename_tac obj ps' s'' obj' kobj; case_tac obj;
-         simp add: fail_def return_def split: if_split_asm)
+  apply (clarsimp simp: cdt_relation_def)
+  apply (frule set_cap_caps_of_state_monad)
+  apply (frule mdb_set_cap)
+  apply clarsimp
+  apply (erule use_valid [OF _ setCTE_ctes_of_wp])
+  apply (frule cte_wp_at_norm)
+  apply (clarsimp simp:cte_wp_at_ctes_of simp del: fun_upd_apply)
+  apply (drule_tac slot = "cte_map (aa,bb)" in updateUntypedCap_descendants_of)
+   apply (clarsimp simp:isCap_simps)
+  apply (drule_tac x = aa in spec)
+  apply (drule_tac x = bb in spec)
+  apply (erule impE)
+   apply (clarsimp simp: cte_wp_at_caps_of_state split:if_splits)
+  apply auto
   done
 
 lemma getCTE_get:
@@ -3797,7 +3858,20 @@ lemma setUntypedCapAsFull_corres:
   done
 
 (* FIXME: SELFOUR-421 move *)
-lemmas isUntypedCap_simps[simp] = isUntypedCap_def[split_simps capability.split]
+lemma isUntypedCap_simps[simp]:
+  "isUntypedCap (capability.UntypedCap uu uv uw ux) = True"
+  "isUntypedCap (capability.NullCap) = False"
+  "isUntypedCap (capability.EndpointCap v va vb vc vd ve) = False"
+  "isUntypedCap (capability.NotificationCap v va vb vc) = False"
+  "isUntypedCap (capability.ReplyCap v1 v2 v3) = False"
+  "isUntypedCap (capability.CNodeCap x1 x2 x3 x4) = False"
+  "isUntypedCap (capability.ThreadCap v) = False"
+  "isUntypedCap (capability.DomainCap) = False"
+  "isUntypedCap (capability.IRQControlCap) = False"
+  "isUntypedCap (capability.IRQHandlerCap y1) = False"
+  "isUntypedCap (capability.Zombie v va1 vb1) = False"
+  "isUntypedCap (capability.ArchObjectCap z) = False"
+  by (simp_all add: isUntypedCap_def split: capability.splits)
 
 lemma cap_relation_masked_as_full:
   "\<lbrakk>cap_relation src_cap src_cap';cap_relation c c'\<rbrakk> \<Longrightarrow>
@@ -4307,7 +4381,6 @@ lemma irq_control_preserve:
   apply (simp add:dom misc)+
   done
 end
-
 locale mdb_inv_preserve =
   fixes m m'
   assumes dom: "\<And>x. (x\<in> dom m)  = (x\<in> dom m')"
@@ -4315,6 +4388,7 @@ locale mdb_inv_preserve =
   isUntypedCap (cteCap cte) = isUntypedCap (cteCap cte')
   \<and> isNullCap (cteCap cte) = isNullCap (cteCap cte')
   \<and> isReplyCap (cteCap cte) = isReplyCap (cteCap cte')
+  \<and> (isReplyCap (cteCap cte) \<longrightarrow> capReplyMaster (cteCap cte) = capReplyMaster (cteCap cte'))
   \<and> isNotificationCap (cteCap cte)  = isNotificationCap (cteCap cte')
   \<and> (isNotificationCap (cteCap cte) \<longrightarrow> (capNtfnBadge (cteCap cte) = capNtfnBadge (cteCap cte')))
   \<and> (isEndpointCap (cteCap cte) = isEndpointCap (cteCap cte'))
@@ -4333,7 +4407,7 @@ locale mdb_inv_preserve =
   \<and> (\<lambda>x. sameRegionAs x (cteCap cte)) = (\<lambda>x. sameRegionAs x (cteCap cte'))"
   assumes mdb_next:"\<And>p. mdb_next m p = mdb_next m' p"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 lemma preserve_stuff:
   "valid_dlist m = valid_dlist m'
  \<and> ut_revocable' m = ut_revocable' m'
@@ -4421,44 +4495,59 @@ lemma descendants_of:
   done
 
 lemma by_products:
-  "no_0 m = no_0 m' \<and> mdb_chain_0 m = mdb_chain_0 m'\<and> valid_nullcaps m = valid_nullcaps m'"
-  apply (intro conjI)
-    apply (clarsimp simp:no_0_def)
-    apply (rule ccontr)
-    apply (simp add:dom_in)
-    apply (subst (asm) dom[symmetric])
-    apply fastforce
+  "reply_masters_rvk_fb m = reply_masters_rvk_fb m'
+ \<and> no_0 m = no_0 m' \<and> mdb_chain_0 m = mdb_chain_0 m'
+ \<and> valid_nullcaps m = valid_nullcaps m'"
+apply (intro conjI)
+  apply (simp add:ran_dom reply_masters_rvk_fb_def mdb_inv_preserve_def dom misc sameRegion mdb_next)
+    apply (rule iffI)
+    apply clarsimp
+    apply (drule_tac x = y in bspec)
+     apply (rule iffD2[OF dom])
+     apply clarsimp
+    apply (frule iffD2[OF dom,OF domI],rotate_tac)
+    apply (clarsimp simp:misc)+
+    apply (drule_tac x = y in bspec)
+     apply (rule iffD1[OF dom])
+     apply clarsimp
+    apply (frule iffD1[OF dom,OF domI],rotate_tac)
+   apply (clarsimp simp:misc)+
+   apply (clarsimp simp:no_0_def)
+   apply (rule ccontr)
+   apply (simp add:dom_in)
+   apply (subst (asm) dom[symmetric])
+   apply fastforce
    apply (rule iffI)
-    apply (clarsimp simp:mdb_chain_0_def)
-    apply (drule_tac x =x in bspec)
-     apply (rule iffD2[OF dom],clarsimp)
-    apply (erule_tac iffD1[OF connect_eqv_singleE,rotated])
-    apply (cut_tac p = p in mdb_next)
-    apply (clarsimp simp: mdb_next_rel_def)
    apply (clarsimp simp:mdb_chain_0_def)
-   apply (drule_tac x =x in bspec)
-    apply (rule iffD1[OF dom],clarsimp)
-   apply (erule_tac iffD1[OF connect_eqv_singleE,rotated])
-   apply (cut_tac p = p in mdb_next)
-   apply (clarsimp simp: mdb_next_rel_def)
-  apply (simp add:valid_nullcaps_def)
-  apply (rule forall_eq,clarsimp)+
-  apply (rule iffI)
-   apply clarsimp
-   apply (frule iffD2[OF dom,OF domI])
-   apply (clarsimp)
-   apply (case_tac y)
-   apply (drule misc)
-    apply assumption
-   apply (clarsimp simp:isCap_simps)
-  apply clarsimp
-  apply (frule iffD1[OF dom,OF domI])
-  apply (clarsimp)
-  apply (case_tac y)
-  apply (drule misc)
-   apply assumption
-  apply (clarsimp simp:isCap_simps)
-  done
+      apply (drule_tac x =x in bspec)
+      apply (rule iffD2[OF dom],clarsimp)
+      apply (erule_tac iffD1[OF connect_eqv_singleE,rotated])
+      apply (cut_tac p = p in mdb_next)
+      apply (clarsimp simp: mdb_next_rel_def)
+    apply (clarsimp simp:mdb_chain_0_def)
+      apply (drule_tac x =x in bspec)
+      apply (rule iffD1[OF dom],clarsimp)
+      apply (erule_tac iffD1[OF connect_eqv_singleE,rotated])
+      apply (cut_tac p = p in mdb_next)
+      apply (clarsimp simp: mdb_next_rel_def)
+   apply (simp add:valid_nullcaps_def)
+   apply (rule forall_eq,clarsimp)+
+     apply (rule iffI)
+      apply clarsimp
+      apply (frule iffD2[OF dom,OF domI])
+      apply (clarsimp)
+      apply (case_tac y)
+      apply (drule misc)
+        apply assumption
+        apply (clarsimp simp:isCap_simps)
+     apply clarsimp
+     apply (frule iffD1[OF dom,OF domI])
+     apply (clarsimp)
+     apply (case_tac y)
+     apply (drule misc)
+       apply assumption
+       apply (clarsimp simp:isCap_simps)
+done
 
 end
 
@@ -4503,7 +4592,7 @@ lemma updateCap_cte_wp_at':
         updateCap ptr cap \<lbrace>\<lambda>rv s. Q (cte_wp_at' P' p s)\<rbrace>"
   apply (simp add:updateCap_def cte_wp_at_ctes_of)
   apply (wp setCTE_ctes_of_wp getCTE_wp)
-  apply (clarsimp simp: cte_wp_at_ctes_of)
+  apply (clarsimp simp: cte_wp_at_ctes_of split del: if_split)
   apply (case_tac cte, auto split: if_split)
   done
 
@@ -4603,6 +4692,22 @@ lemma updateCapFreeIndex_class_links:
     apply (clarsimp simp:cte_wp_at_ctes_of)+
 done
 
+lemma updateCapFreeIndex_reply_masters_rvk_fb:
+  assumes preserve:"\<And>m m'. mdb_inv_preserve m m' \<Longrightarrow> mdb_inv_preserve (Q m) (Q m')"
+  shows
+ "\<lbrace>\<lambda>s. P (reply_masters_rvk_fb (Q (ctes_of s))) \<and> cte_wp_at' (\<lambda>c. c = srcCTE \<and> isUntypedCap (cteCap c)) src s\<rbrace>
+  updateCap src (capFreeIndex_update (\<lambda>_. index) (cteCap srcCTE))
+ \<lbrace>\<lambda>r s. P (reply_masters_rvk_fb (Q (ctes_of s)))\<rbrace>"
+  apply (wp updateCap_ctes_of_wp)
+  apply (subgoal_tac "mdb_inv_preserve (Q (ctes_of s)) (Q (modify_map (ctes_of s) src
+              (cteCap_update (\<lambda>_. capFreeIndex_update (\<lambda>_. index) (cteCap srcCTE)))))")
+    apply (drule mdb_inv_preserve.by_products)
+    apply simp
+  apply (rule preserve)
+  apply (rule mdb_inv_preserve_updateCap)
+    apply (clarsimp simp:cte_wp_at_ctes_of)+
+done
+
 lemma updateCapFreeIndex_distinct_zombies:
   assumes preserve:"\<And>m m'. mdb_inv_preserve m m' \<Longrightarrow> mdb_inv_preserve (Q m) (Q m')"
   shows
@@ -4797,6 +4902,19 @@ setUntypedCapAsFull (cteCap srcCTE) cap src
   apply clarsimp
 done
 
+lemma setUntypedCapAsFull_reply_masters_rvk_fb:
+  assumes preserve:"\<And>m m'. mdb_inv_preserve m m' \<Longrightarrow> mdb_inv_preserve (Q m) (Q m')"
+  shows
+ "\<lbrace>\<lambda>s. P (reply_masters_rvk_fb (Q (ctes_of s))) \<and> cte_wp_at' (\<lambda>c. c = srcCTE) src s\<rbrace>
+setUntypedCapAsFull (cteCap srcCTE) cap src
+ \<lbrace>\<lambda>r s. P (reply_masters_rvk_fb (Q (ctes_of s)))\<rbrace>"
+  apply (clarsimp simp:setUntypedCapAsFull_def split:if_splits,intro conjI impI)
+    apply (wp updateCapFreeIndex_reply_masters_rvk_fb)
+    apply (clarsimp simp:cte_wp_at_ctes_of preserve)+
+  apply wp
+  apply clarsimp
+done
+
 lemma modify_map_eq[simp]:
   "\<lbrakk>m slot = Some srcCTE; cap = cteCap srcCTE\<rbrakk>
    \<Longrightarrow>(modify_map m slot (cteCap_update (\<lambda>_. cap))) = m"
@@ -4823,10 +4941,11 @@ lemma setUntypedCapAsFull_valid_cap:
   "\<lbrace>valid_cap' cap and cte_wp_at' ((=) srcCTE) slot\<rbrace>
    setUntypedCapAsFull (cteCap srcCTE) c slot
    \<lbrace>\<lambda>r. valid_cap' cap\<rbrace>"
-  apply (clarsimp simp:setUntypedCapAsFull_def updateCap_def split:if_splits)
+  apply (clarsimp simp:setUntypedCapAsFull_def split:if_splits)
   apply (intro conjI impI)
-   apply wpsimp+
-  done
+    apply (clarsimp simp:updateCap_def)
+  apply (wp|clarsimp)+
+done
 
 lemma cteCap_update_simps:
   "cteCap_update f srcCTE = CTE (f (cteCap srcCTE)) (cteMDBNode srcCTE)"
@@ -4910,43 +5029,44 @@ crunch set_untyped_cap_as_full
 
 lemma updateMDB_the_lot':
   assumes "(x, s'') \<in> fst (updateMDB p f s')"
-  assumes "pspace_relation (kheap s) (ksPSpace s')"
-  assumes "pspace_aligned' s'" "pspace_distinct' s'" "no_0 (ctes_of 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"
   shows "ctes_of s'' = modify_map (ctes_of s') p (cteMDBNode_update f) \<and>
          ksMachineState s'' = ksMachineState s' \<and>
          ksWorkUnitsCompleted s'' = ksWorkUnitsCompleted s' \<and>
          ksCurThread s'' = ksCurThread s' \<and>
          ksIdleThread s'' = ksIdleThread s' \<and>
-         ksIdleSC s'' = ksIdleSC s' \<and>
          ksReadyQueues s'' = ksReadyQueues s' \<and>
-         ksReleaseQueue s'' = ksReleaseQueue s' \<and>
          ksSchedulerAction s'' = ksSchedulerAction s' \<and>
          ksInterruptState s'' = ksInterruptState s' \<and>
          ksArchState s'' = ksArchState s' \<and>
          gsUserPages s'' = gsUserPages s' \<and>
          gsCNodes s'' = gsCNodes s' \<and>
-         pspace_relation (kheap s) (ksPSpace s'') \<and>
+         pspace_relations (ekheap s) (kheap s) (ksPSpace s'') \<and>
          pspace_aligned' s'' \<and> pspace_distinct' s'' \<and>
          no_0 (ctes_of s'') \<and>
          ksDomScheduleIdx s'' = ksDomScheduleIdx s' \<and>
          ksDomSchedule s''    = ksDomSchedule s' \<and>
          ksCurDomain s''      = ksCurDomain s' \<and>
          ksDomainTime s''     = ksDomainTime s' \<and>
-         ksConsumedTime s''   = ksConsumedTime s' \<and>
-         ksCurTime s''        = ksCurTime s' \<and>
-         ksCurSc s''          = ksCurSc s' \<and>
-         ksReprogramTimer s'' = ksReprogramTimer s' \<and>
-         replyPrevs_of s'' = replyPrevs_of s' \<and>
-         scReplies_of s'' = scReplies_of s'"
-  by (rule updateMDB_the_lot; fastforce intro: assms)
+         tcbSchedNexts_of s'' = tcbSchedNexts_of s' \<and>
+         tcbSchedPrevs_of s'' = tcbSchedPrevs_of s' \<and>
+         (\<forall>domain priority.
+            (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)+
+   done
 
 lemma cte_map_inj_eq':
-  "\<lbrakk> cte_map p = cte_map p';
-     cte_at p s \<and> cte_at p' s \<and> valid_objs s \<and> pspace_aligned s \<and> pspace_distinct s\<rbrakk>
+  "\<lbrakk>(cte_map p = cte_map p');
+   cte_at p s \<and> cte_at p' s \<and>
+   valid_objs s \<and> pspace_aligned s \<and> pspace_distinct s\<rbrakk>
   \<Longrightarrow> p = p'"
-  by (rule cte_map_inj_eq; fastforce)
+  apply (rule cte_map_inj_eq; fastforce)
+  done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma cteInsert_corres:
   notes split_paired_All[simp del] split_paired_Ex[simp del]
         trans_state_update'[symmetric,simp]
@@ -5000,12 +5120,13 @@ 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 (22) set_cap_not_quite_corres)
-              apply fastforce
+            apply (drule (1) pspace_relationsD)
+            apply (drule (18) set_cap_not_quite_corres)
              apply (rule refl)
             apply (elim conjE exE)
             apply (rule bind_execI, assumption)
-            apply (prop_tac "mdb_insert_abs (cdt a) src dest")
+            apply (subgoal_tac "mdb_insert_abs (cdt a) src dest")
+             prefer 2
              apply (erule mdb_insert_abs.intro)
               apply (rule mdb_Null_None)
                apply (simp add: op_equal)
@@ -5013,34 +5134,32 @@ lemma cteInsert_corres:
              apply (rule mdb_Null_descendants)
               apply (simp add: op_equal)
              apply simp
-            apply (prop_tac "no_mloop (cdt a)")
+            apply (subgoal_tac "no_mloop (cdt a)")
+             prefer 2
              apply (simp add: valid_mdb_def)
-            apply (clarsimp simp: exec_gets update_cdt_def bind_assoc
-                                  set_cdt_def exec_get exec_put set_original_def modify_def
+            apply (clarsimp simp: exec_gets update_cdt_def bind_assoc set_cdt_def
+                                  exec_get exec_put set_original_def modify_def
                         simp del: fun_upd_apply
-                   | (rule bind_execI[where f="cap_insert_ext x y z i p" for x y z i p],
-                      clarsimp simp: exec_gets exec_get put_def
-                                     mdb_insert_abs.cap_insert_ext_det_def2 update_cdt_list_def
-                                     set_cdt_list_def,
-                      rule refl))+
+                   | (rule bind_execI[where f="cap_insert_ext x y z i p" for x y z i p], clarsimp simp: exec_gets exec_get put_def mdb_insert_abs.cap_insert_ext_det_def2 update_cdt_list_def set_cdt_list_def, rule refl))+
             apply (clarsimp simp: put_def state_relation_def)
             apply (drule updateCap_stuff)
             apply clarsimp
             apply (drule (3) updateMDB_the_lot', simp, simp, elim conjE)
             apply (drule (3) updateMDB_the_lot', simp, simp, elim conjE)
-            apply (drule (3) updateMDB_the_lot', simp, simp, elim conjE)
+            apply (drule (3) updateMDB_the_lot', simp, simp,  elim conjE)
             apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def
                              prev_update_modify_mdb_relation)
-            apply (prop_tac "cte_map dest \<noteq> 0")
-             apply (clarsimp simp: valid_mdb'_def
-                              valid_mdb_ctes_def no_0_def)
-            apply (prop_tac "cte_map src \<noteq> 0")
-             apply (clarsimp simp: valid_mdb'_def
-                              valid_mdb_ctes_def no_0_def)
+            apply (subgoal_tac "cte_map dest \<noteq> 0")
+             prefer 2
+             apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
+            apply (subgoal_tac "cte_map src \<noteq> 0")
+             prefer 2
+             apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
             apply (thin_tac "ksMachineState t = p" for p t)+
             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)
@@ -5055,11 +5174,13 @@ lemma cteInsert_corres:
               apply (case_tac "rv'")
               apply (rename_tac dest_node)
               apply (clarsimp simp: in_set_cap_cte_at_swp)
-              apply (prop_tac "cte_at src a \<and> is_derived (cdt a) src c src_cap")
+              apply (subgoal_tac "cte_at src a \<and> is_derived (cdt a) src c src_cap")
+               prefer 2
                apply (fastforce simp: cte_wp_at_def)
               apply (erule conjE)
-              apply (prop_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node
+              apply (subgoal_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node
                                  (cte_map dest) NullCap dest_node")
+               prefer 2
                apply (rule mdb_insert.intro)
                  apply (rule mdb_ptr.intro)
                   apply (rule vmdb.intro, simp add: valid_mdb_ctes_def)
@@ -5125,7 +5246,8 @@ lemma cteInsert_corres:
                  subgoal by(fastforce)
                 apply(simp)
                 apply(rule impI)
-                apply(prop_tac "cte_at ca a")
+                apply(subgoal_tac "cte_at ca a")
+                 prefer 2
                  apply(rule cte_at_next_slot)
                     apply(simp_all)[4]
                 apply(clarsimp simp: modify_map_def const_def)
@@ -5211,7 +5333,7 @@ lemma cteInsert_corres:
                   apply (subst is_derived_eq[symmetric]; assumption)
                  apply assumption
                 subgoal by (clarsimp simp: cte_wp_at_def is_derived_def is_cap_simps cap_master_cap_simps
-                                    dest!: cap_master_cap_eqDs)
+                                    dest!:cap_master_cap_eqDs)
                apply (subgoal_tac "is_original_cap a src = mdbRevocable src_node")
                 apply (frule(4) iffD1[OF is_derived_eq])
                 apply (drule_tac src_cap' = src_cap' in
@@ -5222,8 +5344,7 @@ lemma cteInsert_corres:
                apply simp
                apply (erule impE)
                 apply (clarsimp simp: null_filter_def cte_wp_at_caps_of_state split: if_splits)
-                subgoal by (clarsimp simp: masked_as_full_def is_cap_simps free_index_update_def
-                                    split: if_splits)
+                subgoal by (clarsimp simp: masked_as_full_def is_cap_simps free_index_update_def split: if_splits)
                apply(simp)
 
               apply(subgoal_tac "cdt_list (a) src = []")
@@ -5271,9 +5392,12 @@ lemma cteInsert_corres:
                    apply(case_tac z)
                    apply(erule_tac x="(aa, bb)" in allE)+
                    subgoal by(fastforce)
-                  apply(drule cte_map_inj_eq'; simp)
-                 apply(drule cte_map_inj_eq'; simp)
-                apply(drule cte_map_inj_eq'; simp)
+                  apply(drule cte_map_inj_eq')
+                   apply(simp_all)[2]
+                 apply(drule cte_map_inj_eq')
+                  apply(simp_all)[2]
+                apply(drule cte_map_inj_eq')
+                 apply(simp_all)[2]
                apply(erule_tac x="(aa, bb)" in allE)+
                subgoal by(fastforce)
 
@@ -5332,7 +5456,8 @@ lemma cteInsert_corres:
              apply (clarsimp simp: revokable_relation_def  split: if_split)
              apply (rule conjI)
               apply clarsimp
-              apply (prop_tac "mdbRevocable node = revokable' (cteCap srcCTE) c'")
+              apply (subgoal_tac "mdbRevocable node = revokable' (cteCap srcCTE) c'")
+               prefer 2
                apply (case_tac rv')
                subgoal by (clarsimp simp add: const_def modify_map_def split: if_split_asm)
               apply simp
@@ -5343,12 +5468,13 @@ lemma cteInsert_corres:
                 apply assumption
                apply assumption
               subgoal by (clarsimp simp: cap_master_cap_simps cte_wp_at_def is_derived_def is_cap_simps
-                                  split: if_splits dest!:cap_master_cap_eqDs)
+                                  split:if_splits dest!:cap_master_cap_eqDs)
              apply clarsimp
              apply (case_tac srcCTE)
              apply (case_tac rv')
              apply clarsimp
-             apply (prop_tac "\<exists>cap' node'. ctes_of b (cte_map (aa,bb)) = Some (CTE cap' node')")
+             apply (subgoal_tac "\<exists>cap' node'. ctes_of b (cte_map (aa,bb)) = Some (CTE cap' node')")
+              prefer 2
               apply (clarsimp simp: modify_map_def split: if_split_asm)
               apply (case_tac z)
               subgoal by clarsimp
@@ -5356,11 +5482,11 @@ lemma cteInsert_corres:
              apply (drule set_cap_caps_of_state_monad)+
              apply (subgoal_tac "null_filter (caps_of_state a) (aa,bb) \<noteq> None")
               prefer 2
-              subgoal by (clarsimp simp: cte_wp_at_caps_of_state null_filter_def
-                                  split: if_splits)
+              subgoal by (clarsimp simp: cte_wp_at_caps_of_state null_filter_def split: if_splits)
 
              apply clarsimp
-             apply (prop_tac "cte_at (aa,bb) a")
+             apply (subgoal_tac "cte_at (aa,bb) a")
+              prefer 2
               apply (drule null_filter_caps_of_stateD)
               apply (erule cte_wp_at_weakenE, rule TrueI)
              apply (subgoal_tac "mdbRevocable node = mdbRevocable node'")
@@ -5368,7 +5494,6 @@ lemma cteInsert_corres:
              apply (subgoal_tac "cte_map (aa,bb) \<noteq> cte_map dest")
               subgoal by (clarsimp simp: modify_map_def split: if_split_asm)
              apply (erule (5) cte_map_inj)
-
             apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb
                set_untyped_cap_as_full_cte_wp_at setUntypedCapAsFull_valid_cap
                setUntypedCapAsFull_cte_wp_at | clarsimp simp: cte_wp_at_caps_of_state| wps)+
@@ -5385,11 +5510,13 @@ lemma cteInsert_corres:
   apply (case_tac "rv'")
   apply (rename_tac dest_node)
   apply (clarsimp simp: in_set_cap_cte_at_swp)
-  apply (prop_tac "cte_at src a \<and> is_derived (cdt a) src c src_cap")
+  apply (subgoal_tac "cte_at src a \<and> is_derived (cdt a) src c src_cap")
+   prefer 2
    subgoal by (fastforce simp: cte_wp_at_def)
   apply (erule conjE)
-  apply (prop_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node
+  apply (subgoal_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node
                                  (cte_map dest) NullCap dest_node")
+   prefer 2
    apply (rule mdb_insert.intro)
      apply (rule mdb_ptr.intro)
       subgoal by (rule vmdb.intro, simp add: valid_mdb_ctes_def)
@@ -5408,10 +5535,12 @@ lemma cteInsert_corres:
    apply (rule mdb_insert_der_axioms.intro)
    apply (simp add: is_derived_eq)
   apply (simp (no_asm_simp) add: cdt_relation_def split: if_split)
-  apply (prop_tac "descendants_of dest (cdt a) = {}")
+  apply (subgoal_tac "descendants_of dest (cdt a) = {}")
+   prefer 2
    apply (drule mdb_insert.dest_no_descendants)
-   subgoal by (fastforce simp add: cdt_relation_def)
-  apply (prop_tac "mdb_insert_abs (cdt a) src dest")
+   subgoal by (fastforce simp add: cdt_relation_def simp del: split_paired_All)
+  apply (subgoal_tac "mdb_insert_abs (cdt a) src dest")
+   prefer 2
    apply (erule mdb_insert_abs.intro)
     apply (rule mdb_None)
       apply (erule(1) mdb_insert.descendants_not_dest)
@@ -5444,11 +5573,11 @@ lemma cteInsert_corres:
                           dest!:cap_master_cap_eqDs)
     apply (subgoal_tac "is_original_cap a src = mdbRevocable src_node")
      prefer 2
-     apply (simp add: revokable_relation_def)
+     apply (simp add: revokable_relation_def del: split_paired_All)
      apply (erule_tac x=src in allE)
      apply (erule impE)
       apply (clarsimp simp: null_filter_def cte_wp_at_caps_of_state cap_master_cap_simps
-                     split: if_splits dest!:cap_master_cap_eqDs)
+       split: if_splits dest!:cap_master_cap_eqDs)
       subgoal by (clarsimp simp: masked_as_full_def is_cap_simps free_index_update_def split: if_splits)
      subgoal by simp
     subgoal by clarsimp
@@ -5458,7 +5587,7 @@ lemma cteInsert_corres:
           prefer 2
           apply assumption
          apply (simp_all)[6]
-   apply (simp add: cdt_relation_def split: if_split)
+   apply (simp add: cdt_relation_def split: if_split del: split_paired_All)
    apply clarsimp
    apply (drule (5) cte_map_inj)+
    apply simp
@@ -5486,7 +5615,7 @@ lemma cteInsert_corres:
                         dest!:cap_master_cap_eqDs)
    apply (subgoal_tac "is_original_cap a src = mdbRevocable src_node")
     subgoal by simp
-   apply (simp add: revokable_relation_def)
+   apply (simp add: revokable_relation_def del: split_paired_All)
    apply (erule_tac x=src in allE)
    apply (erule impE)
     apply (clarsimp simp: null_filter_def cte_wp_at_caps_of_state split: if_splits)
@@ -5496,13 +5625,12 @@ lemma cteInsert_corres:
   apply (frule_tac p="(aa, bb)" in in_set_cap_cte_at)
   apply (rule conjI)
    apply (clarsimp simp: descendants_of_eq')
-   subgoal by (simp add: cdt_relation_def)
+   subgoal by (simp add: cdt_relation_def del: split_paired_All)
   apply (clarsimp simp: descendants_of_eq')
-  subgoal by (simp add: cdt_relation_def)
+  subgoal by (simp add: cdt_relation_def del: split_paired_All)
   done
 
-(* FIXME RT: This is the sort of crap we should get rid of when possible, or
-   at least make it more localised. VER-1250 *)
+
 declare if_split [split]
 
 lemma updateCap_no_0:
@@ -6468,10 +6596,10 @@ lemma cteSwap_corres:
   apply (clarsimp simp: corres_underlying_def in_monad
                         state_relation_def)
   apply (clarsimp simp: valid_mdb'_def)
-  apply (drule (16) set_cap_not_quite_corres)
-          apply fastforce
-         apply (erule cte_wp_at_weakenE, rule TrueI)
-        apply assumption+
+  apply (drule(1) pspace_relationsD)
+  apply (drule (12) set_cap_not_quite_corres)
+      apply (erule cte_wp_at_weakenE, rule TrueI)
+     apply assumption+
    apply (rule refl)
   apply (elim exE conjE)
   apply (rule bind_execI, assumption)
@@ -6489,9 +6617,8 @@ lemma cteSwap_corres:
                          use_valid [OF _ set_cap_distinct]
                          cte_wp_at_weakenE)
   apply (elim conjE)
-  apply (drule (18) set_cap_not_quite_corres)
-        apply simp
-       apply fastforce
+  apply (drule (14) set_cap_not_quite_corres)
+       apply simp
       apply assumption+
    apply (rule refl)
   apply (elim exE conjE)
@@ -6505,19 +6632,20 @@ 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 (erule (1) impE, assumption)
+    apply (fastforce simp only: no_0_modify_map)
+   apply assumption
   apply (elim conjE TrueE, simp only:)
-  apply (drule (2) updateMDB_the_lot', assumption, fastforce simp only: no_0_modify_map)
-  apply (drule in_getCTE, clarsimp)
-  apply (drule (2) updateMDB_the_lot', assumption, fastforce simp only: no_0_modify_map)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
+  apply (drule in_getCTE, elim conjE, simp only:)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
   apply (elim conjE TrueE, simp only:)
-  apply (drule (2) updateMDB_the_lot', assumption, fastforce simp only: no_0_modify_map)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
   apply (elim conjE TrueE, simp only:)
-  apply (drule (2) updateMDB_the_lot', assumption, fastforce simp only: no_0_modify_map)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
   apply (elim conjE TrueE, simp only:)
-  apply (drule (2) updateMDB_the_lot', assumption, fastforce simp only: no_0_modify_map)
-  apply (simp only: refl)
+  apply (drule (2) updateMDB_the_lot', fastforce, simp only: no_0_modify_map, assumption)
+  apply (simp only: pspace_relations_def refl)
   apply (rule conjI, rule TrueI)+
   apply (thin_tac "ksMachineState t = p" for t p)+
   apply (thin_tac "ksCurThread t = p" for t p)+
@@ -6551,7 +6679,6 @@ lemma cteSwap_corres:
      apply (erule weak_derived_sym')
     apply (erule weak_derived_sym')
    apply assumption
-
   apply (rule conjI)
    subgoal by (simp only: simp_thms ghost_relation_typ_at set_cap_a_type_inv ARM.data_at_def)
   apply (thin_tac "ksMachineState t = p" for t p)+
@@ -6569,6 +6696,7 @@ 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)+
@@ -6577,6 +6705,7 @@ 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(subst conj_assoc[symmetric])
@@ -6718,35 +6847,54 @@ lemma cteSwap_corres:
     apply(fastforce split: option.split)
    apply(simp)
   apply(frule finite_depth)
-  apply(frule mdb_swap.n_next; (simp (no_asm_simp))?)
+  apply(frule mdb_swap.n_next)
+   apply(simp)
   apply(case_tac "(aa, bb)=src")
    apply(case_tac "next_slot dest (cdt_list (a)) (cdt a) = Some src")
     apply(simp)
     apply(erule_tac x="fst dest" in allE, erule_tac x="snd dest" in allE)
     apply(simp)
    apply(simp)
-   apply(case_tac "next_slot dest (cdt_list (a)) (cdt a)"; (simp (no_asm_simp))?)
+   apply(case_tac "next_slot dest (cdt_list (a)) (cdt a)")
+    apply(simp)
+   apply(simp)
    apply(erule_tac x="fst dest" in allE, erule_tac x="snd dest" in allE)
    apply(simp)
    apply(subgoal_tac "mdbNext dest_node \<noteq> cte_map src")
     apply(simp)
    apply(simp)
-   apply(rule_tac s=a in cte_map_inj; (simp (no_asm_simp))?)
-    apply(rule cte_at_next_slot'; (simp (no_asm_simp))?)
-   apply(erule cte_wp_at_weakenE, rule TrueI)
+   apply(rule_tac s=a in cte_map_inj)
+        apply(simp)
+       apply(rule cte_at_next_slot')
+          apply(simp)
+         apply(simp)
+        apply(simp)
+       apply(simp)
+      apply(erule cte_wp_at_weakenE, rule TrueI)
+     apply(simp_all)[3]
   apply(case_tac "(aa, bb)=dest")
    apply(case_tac "next_slot src (cdt_list (a)) (cdt a) = Some dest")
     apply(simp)
     apply(erule_tac x="fst src" in allE, erule_tac x="snd src" in allE)
     apply(simp)
    apply(simp)
-   apply(case_tac "next_slot src (cdt_list (a)) (cdt a)"; (simp (no_asm_simp))?)
+   apply(case_tac "next_slot src (cdt_list (a)) (cdt a)")
+    apply(simp)
+   apply(simp)
    apply(erule_tac x="fst src" in allE, erule_tac x="snd src" in allE)
    apply(simp)
-   apply(subgoal_tac "mdbNext src_node \<noteq> cte_map dest"; (simp (no_asm_simp))?)
-   apply(rule_tac s=a in cte_map_inj; (simp (no_asm_simp))?)
-    apply(rule cte_at_next_slot'; (simp (no_asm_simp))?)
-   apply(erule cte_wp_at_weakenE, rule TrueI)
+   apply(subgoal_tac "mdbNext src_node \<noteq> cte_map dest")
+    apply(simp)
+   apply(simp)
+   apply(rule_tac s=a in cte_map_inj)
+        apply(simp)
+       apply(rule cte_at_next_slot')
+          apply(simp)
+         apply(simp)
+        apply(simp)
+       apply(simp)
+      apply(erule cte_wp_at_weakenE, rule TrueI)
+     apply(simp_all)[3]
   apply(case_tac "next_slot (aa, bb) (cdt_list (a)) (cdt a) = Some src")
    apply(simp)
    apply(erule_tac x=aa in allE, erule_tac x=bb in allE)
@@ -6757,20 +6905,24 @@ lemma cteSwap_corres:
                         cte_map (aa, bb) = mdbPrev src_node")
      apply(clarsimp)
     apply(rule conjI)
-     apply(rule cte_map_inj; (simp (no_asm_simp))?)
+     apply(rule cte_map_inj)
+          apply(simp_all)[6]
      apply(erule cte_wp_at_weakenE, simp)
     apply(rule conjI)
-     apply(rule cte_map_inj; (simp (no_asm_simp))?)
-     apply(erule cte_wp_at_weakenE, simp (no_asm_simp))
-    apply(frule mdb_swap.m_exists, simp (no_asm_simp))
+     apply(rule cte_map_inj)
+          apply(simp_all)[6]
+     apply(erule cte_wp_at_weakenE, simp)
+    apply(frule mdb_swap.m_exists)
+     apply(simp)
     apply(clarsimp)
     apply(frule_tac cte="CTE cap' node'" in valid_mdbD1')
       apply(clarsimp)
-     apply(simp (no_asm_simp) add: valid_mdb'_def)
+     apply(simp add: valid_mdb'_def)
     apply(clarsimp)
-   apply(rule cte_at_next_slot; simp (no_asm_simp))
+   apply(rule cte_at_next_slot)
+      apply(simp_all)[4]
   apply(case_tac "next_slot (aa, bb) (cdt_list (a)) (cdt a) = Some dest")
-   apply(simp (no_asm_simp))
+   apply(simp)
    apply(erule_tac x=aa in allE, erule_tac x=bb in allE)
    apply(simp)
    apply(subgoal_tac "cte_at (aa, bb) a")
@@ -6781,22 +6933,25 @@ lemma cteSwap_corres:
       apply(clarsimp)
      apply(clarsimp simp: mdb_swap.prev_dest_src)
     apply(rule conjI)
-     apply(rule cte_map_inj; (simp (no_asm_simp))?)
-     apply(erule cte_wp_at_weakenE, simp (no_asm_simp))
+     apply(rule cte_map_inj)
+          apply(simp_all)[6]
+     apply(erule cte_wp_at_weakenE, simp)
     apply(rule conjI)
-     apply(rule cte_map_inj; (simp (no_asm_simp))?)
-     apply(erule cte_wp_at_weakenE, simp (no_asm_simp))
+     apply(rule cte_map_inj)
+          apply(simp_all)[6]
+     apply(erule cte_wp_at_weakenE, simp)
     apply(frule mdb_swap.m_exists)
-     apply(simp (no_asm_simp))
+     apply(simp)
     apply(clarsimp)
     apply(frule_tac cte="CTE cap' node'" in valid_mdbD1')
       apply(clarsimp)
-     apply(simp (no_asm_simp) add: valid_mdb'_def)
+     apply(simp add: valid_mdb'_def)
     apply(clarsimp)
-   apply(rule cte_at_next_slot; (simp (no_asm_simp))?)
-  apply(simp (no_asm_simp))
+   apply(rule cte_at_next_slot)
+      apply(simp_all)[4]
+  apply(simp)
   apply(case_tac "next_slot (aa, bb) (cdt_list (a)) (cdt a)")
-   apply(simp (no_asm_simp))
+   apply(simp)
   apply(clarsimp)
   apply(erule_tac x=aa in allE, erule_tac x=bb in allE)
   apply(simp)
@@ -6807,37 +6962,39 @@ lemma cteSwap_corres:
                       cte_map (aa, bb) \<noteq> mdbPrev dest_node")
     apply(clarsimp)
    apply(rule conjI)
-    apply(rule cte_map_inj; (simp (no_asm_simp))?)
-    apply(erule cte_wp_at_weakenE, simp (no_asm_simp))
+    apply(rule cte_map_inj)
+         apply(simp_all)[6]
+    apply(erule cte_wp_at_weakenE, simp)
    apply(rule conjI)
-    apply(rule cte_map_inj; (simp (no_asm_simp))?)
-    apply(erule cte_wp_at_weakenE, simp (no_asm_simp))
+    apply(rule cte_map_inj)
+         apply simp_all[6]
+    apply(erule cte_wp_at_weakenE, simp)
    apply(rule conjI)
     apply(frule mdb_swap.m_exists)
-     apply(simp (no_asm_simp))
+     apply(simp)
     apply(clarsimp)
      apply(frule_tac cte="CTE src_cap src_node" in valid_mdbD2')
-     subgoal by (clarsimp)
-     apply(simp (no_asm_simp) add: valid_mdb'_def)
+      subgoal by (clarsimp)
+     apply(simp add: valid_mdb'_def)
     apply(clarsimp)
-    apply(drule cte_map_inj_eq; (simp (no_asm_simp))?)
-      apply(rule cte_at_next_slot'; simp (no_asm_simp))
-     apply(erule cte_wp_at_weakenE, simp (no_asm_simp))
-    apply simp
+    apply(drule cte_map_inj_eq)
+         apply(rule cte_at_next_slot')
+            apply(simp_all)[9]
+    apply(erule cte_wp_at_weakenE, simp)
    apply(frule mdb_swap.m_exists)
-    apply(simp (no_asm_simp))
+    apply(simp)
    apply(clarsimp)
    apply(frule_tac cte="CTE dest_cap dest_node" in valid_mdbD2')
      apply(clarsimp)
-    apply(simp (no_asm_simp) add: valid_mdb'_def)
+    apply(simp add: valid_mdb'_def)
    apply(clarsimp)
-   apply(drule cte_map_inj_eq; (simp (no_asm_simp))?)
-     apply(rule cte_at_next_slot'; simp (no_asm_simp))
-    apply(erule cte_wp_at_weakenE)
-    apply (simp (no_asm_simp))
-   apply simp
+   apply(drule cte_map_inj_eq)
+         apply(rule cte_at_next_slot')
+           apply(simp_all)[9]
+    apply(erule cte_wp_at_weakenE, simp)
   by (rule cte_at_next_slot; simp)
 
+
 lemma capSwapForDelete_corres:
   assumes "src' = cte_map src" "dest' = cte_map dest"
   shows "corres dc
@@ -6891,7 +7048,7 @@ lemma subtree_no_parent:
   shows "False" using assms
   by induct (auto simp: parentOf_def mdb_next_unfold)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma ensureNoChildren_corres:
   "p' = cte_map p \<Longrightarrow>
diff --git a/proof/refine/ARM/CSpace_I.thy b/proof/refine/ARM/CSpace_I.thy
index fe2cfdbb77..cfd89623cb 100644
--- a/proof/refine/ARM/CSpace_I.thy
+++ b/proof/refine/ARM/CSpace_I.thy
@@ -12,10 +12,23 @@ theory CSpace_I
 imports ArchAcc_R
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemmas capUntypedPtr_simps[simp] = capUntypedPtr_def[split_simps capability.split, simplified PPtr_def id_def]
-lemmas arch_capUntypedPtr_simps[simp] = ARM_H.capUntypedPtr_def[split_simps arch_capability.split, simplified PPtr_def id_def]
+context begin interpretation Arch . (*FIXME: arch-split*)
+
+lemma capUntypedPtr_simps [simp]:
+  "capUntypedPtr (ThreadCap r) = r"
+  "capUntypedPtr (NotificationCap r badge a b) = r"
+  "capUntypedPtr (EndpointCap r badge a b c d) = r"
+  "capUntypedPtr (Zombie r bits n) = r"
+  "capUntypedPtr (ArchObjectCap x) = Arch.capUntypedPtr x"
+  "capUntypedPtr (UntypedCap d r n f) = r"
+  "capUntypedPtr (CNodeCap r n g n2) = r"
+  "capUntypedPtr (ReplyCap r m a) = r"
+  "Arch.capUntypedPtr (ARM_H.ASIDPoolCap r asid) = r"
+  "Arch.capUntypedPtr (ARM_H.PageCap d r rghts sz mapdata) = r"
+  "Arch.capUntypedPtr (ARM_H.PageTableCap r mapdata2) = r"
+  "Arch.capUntypedPtr (ARM_H.PageDirectoryCap r mapdata3) = r"
+  by (auto simp: capUntypedPtr_def
+                 ARM_H.capUntypedPtr_def)
 
 lemma rights_mask_map_UNIV [simp]:
   "rights_mask_map UNIV = allRights"
@@ -32,6 +45,14 @@ lemma maskCapRights_allRights [simp]:
 lemma getCTE_inv [wp]: "\<lbrace>P\<rbrace> getCTE addr \<lbrace>\<lambda>rv. P\<rbrace>"
   by (simp add: getCTE_def) wp
 
+lemma getEndpoint_inv [wp]:
+  "\<lbrace>P\<rbrace> getEndpoint ptr \<lbrace>\<lambda>rv. P\<rbrace>"
+  by (simp add: getEndpoint_def getObject_inv loadObject_default_inv)
+
+lemma getNotification_inv [wp]:
+  "\<lbrace>P\<rbrace> getNotification ptr \<lbrace>\<lambda>rv. P\<rbrace>"
+  by (simp add: getNotification_def getObject_inv loadObject_default_inv)
+
 lemma getSlotCap_inv [wp]: "\<lbrace>P\<rbrace> getSlotCap addr \<lbrace>\<lambda>rv. P\<rbrace>"
   by (simp add: getSlotCap_def, wp)
 
@@ -499,6 +520,7 @@ lemma isPhysicalCap[simp]:
   by (simp add: isPhysicalCap_def ARM_H.isPhysicalCap_def
          split: capability.split arch_capability.split)
 
+(* FIXME instead of a definition and then a simp rule in the simp set, we should use fun *)
 definition
   capMasterCap :: "capability \<Rightarrow> capability"
 where
@@ -507,7 +529,7 @@ where
  | NotificationCap ref bdg s r \<Rightarrow> NotificationCap ref 0 True True
  | CNodeCap ref bits gd gs \<Rightarrow> CNodeCap ref bits 0 0
  | ThreadCap ref \<Rightarrow> ThreadCap ref
- | ReplyCap ref g \<Rightarrow> ReplyCap ref True
+ | ReplyCap ref master g \<Rightarrow> ReplyCap ref True True
  | UntypedCap d ref n f \<Rightarrow> UntypedCap d ref n 0
  | ArchObjectCap acap \<Rightarrow> ArchObjectCap (case acap of
       PageCap d ref rghts sz mapdata \<Rightarrow>
@@ -521,7 +543,29 @@ where
     | _ \<Rightarrow> acap)
  | _ \<Rightarrow> cap"
 
-lemmas capMasterCap_simps[simp] = capMasterCap_def[split_simps capability.split arch_capability.split]
+lemma capMasterCap_simps[simp]:
+  "capMasterCap (EndpointCap ref bdg s r g gr) = EndpointCap ref 0 True True True True"
+  "capMasterCap (NotificationCap ref bdg s r) = NotificationCap ref 0 True True"
+  "capMasterCap (CNodeCap ref bits gd gs) = CNodeCap ref bits 0 0"
+  "capMasterCap (ThreadCap ref) = ThreadCap ref"
+  "capMasterCap capability.NullCap = capability.NullCap"
+  "capMasterCap capability.DomainCap = capability.DomainCap"
+  "capMasterCap (capability.IRQHandlerCap irq) = capability.IRQHandlerCap irq"
+  "capMasterCap (capability.Zombie word zombie_type n) = capability.Zombie word zombie_type n"
+  "capMasterCap (capability.ArchObjectCap (arch_capability.ASIDPoolCap word1 word2)) =
+            capability.ArchObjectCap (arch_capability.ASIDPoolCap word1 0)"
+  "capMasterCap (capability.ArchObjectCap arch_capability.ASIDControlCap) =
+         capability.ArchObjectCap arch_capability.ASIDControlCap"
+  "capMasterCap (capability.ArchObjectCap (arch_capability.PageCap d word vmrights vmpage_size pdata)) =
+            capability.ArchObjectCap (arch_capability.PageCap d word VMReadWrite vmpage_size None)"
+  "capMasterCap (capability.ArchObjectCap (arch_capability.PageTableCap word ptdata)) =
+            capability.ArchObjectCap (arch_capability.PageTableCap word None)"
+  "capMasterCap (capability.ArchObjectCap (arch_capability.PageDirectoryCap word pddata)) =
+            capability.ArchObjectCap (arch_capability.PageDirectoryCap word None)"
+  "capMasterCap (capability.UntypedCap d word n f) = capability.UntypedCap d word n 0"
+  "capMasterCap capability.IRQControlCap = capability.IRQControlCap"
+  "capMasterCap (capability.ReplyCap word m g) = capability.ReplyCap word True True"
+  by (simp_all add: capMasterCap_def)
 
 lemma capMasterCap_eqDs1:
   "capMasterCap cap = EndpointCap ref bdg s r g gr
@@ -534,10 +578,6 @@ lemma capMasterCap_eqDs1:
      \<Longrightarrow> gd = 0 \<and> gs = 0 \<and> (\<exists>gd gs. cap = CNodeCap ref bits gd gs)"
   "capMasterCap cap = ThreadCap ref
      \<Longrightarrow> cap = ThreadCap ref"
-  "capMasterCap cap = SchedContextCap ref n
-     \<Longrightarrow> cap =  SchedContextCap ref n"
-  "capMasterCap cap = SchedControlCap
-     \<Longrightarrow> cap = SchedControlCap"
   "capMasterCap cap = NullCap
      \<Longrightarrow> cap = NullCap"
   "capMasterCap cap = DomainCap
@@ -550,8 +590,8 @@ lemma capMasterCap_eqDs1:
      \<Longrightarrow> cap = Zombie ref tp n"
   "capMasterCap cap = UntypedCap d ref bits 0
      \<Longrightarrow> \<exists>f. cap = UntypedCap d ref bits f"
-  "capMasterCap cap = ReplyCap ref g
-     \<Longrightarrow> g \<and> (\<exists>g. cap = ReplyCap ref g)"
+  "capMasterCap cap = ReplyCap ref master g
+     \<Longrightarrow> master \<and> g \<and> (\<exists>master g. cap = ReplyCap ref master g)"
   "capMasterCap cap = ArchObjectCap (PageCap d ref rghts sz mapdata)
      \<Longrightarrow> rghts = VMReadWrite \<and> mapdata = None
           \<and> (\<exists>rghts mapdata. cap = ArchObjectCap (PageCap d ref rghts sz mapdata))"
@@ -583,13 +623,11 @@ lemma capBadge_simps[simp]:
  "capBadge (NotificationCap ref badge s r)    = Some badge"
  "capBadge (CNodeCap ref bits gd gs)          = None"
  "capBadge (ThreadCap ref)                    = None"
- "capBadge (SchedContextCap ref n)            = None"
- "capBadge (SchedControlCap)                  = None"
  "capBadge (Zombie ref b n)                   = None"
  "capBadge (ArchObjectCap cap)                = None"
  "capBadge (IRQControlCap)                    = None"
  "capBadge (IRQHandlerCap irq)                = None"
- "capBadge (ReplyCap tcb g)                   = None"
+ "capBadge (ReplyCap tcb master g)            = None"
   by (simp add: capBadge_def isCap_defs)+
 
 lemma capClass_Master:
@@ -613,8 +651,6 @@ lemma isCap_Master:
   "isCNodeCap (capMasterCap cap) = isCNodeCap cap"
   "isNotificationCap (capMasterCap cap) = isNotificationCap cap"
   "isEndpointCap (capMasterCap cap) = isEndpointCap cap"
-  "isSchedContextCap (capMasterCap cap) = isSchedContextCap cap"
-  "isSchedControlCap (capMasterCap cap) = isSchedControlCap cap"
   "isUntypedCap (capMasterCap cap) = isUntypedCap cap"
   "isReplyCap (capMasterCap cap) = isReplyCap cap"
   "isIRQControlCap (capMasterCap cap) = isIRQControlCap cap"
@@ -667,7 +703,7 @@ lemma sameRegionAs_def2:
            split del: if_split cong: if_cong)
   apply (clarsimp simp: capRange_def Let_def)
   apply (simp add: range_subset_eq2 cong: conj_cong)
-  by (auto simp add: conj_comms)
+  by (simp add: conj_comms)
 
 lemma sameObjectAs_def2:
  "sameObjectAs cap cap' = (\<lambda>cap cap'.
@@ -746,9 +782,7 @@ lemma capUntypedSize_simps [simp]:
   "capUntypedSize (ArchObjectCap x) = Arch.capUntypedSize x"
   "capUntypedSize (UntypedCap d r n f) = 1 << n"
   "capUntypedSize (CNodeCap r n g n2) = 1 << (objBits (undefined::cte) + n)"
-  "capUntypedSize (ReplyCap r a) = 1 << objBits (undefined :: reply)"
-  "capUntypedSize (SchedContextCap sc sz) = 1 << sz"
-  "capUntypedSize SchedControlCap = 1"
+  "capUntypedSize (ReplyCap r m a) = 1 << objBits (undefined :: tcb)"
   "capUntypedSize IRQControlCap = 1"
   "capUntypedSize (IRQHandlerCap irq) = 1"
   by (auto simp add: capUntypedSize_def isCap_simps objBits_simps
@@ -813,9 +847,14 @@ lemma capBadge_maskCapRights[simp]:
 
 lemma getObject_cte_det:
   "(r::cte,s') \<in> fst (getObject p s) \<Longrightarrow> fst (getObject p s) = {(r,s)} \<and> s' = s"
-  by (clarsimp simp: getObject_def in_monad split_def obind_def gets_def get_def
-                     readObject_def omonad_defs bind_def return_def gets_the_def assert_opt_def
-              split: option.splits)
+  apply (clarsimp simp add: getObject_def bind_def get_def gets_def
+                            return_def loadObject_cte split_def)
+  apply (clarsimp split: kernel_object.split_asm if_split_asm option.split_asm
+                   simp: in_monad typeError_def alignError_def magnitudeCheck_def)
+       apply (simp_all add: bind_def return_def assert_opt_def split_def
+                            alignCheck_def is_aligned_mask[symmetric]
+                            unless_def when_def magnitudeCheck_def)
+  done
 
 lemma cte_wp_at_obj_cases':
   "cte_wp_at' P p s =
@@ -823,7 +862,7 @@ lemma cte_wp_at_obj_cases':
   apply (simp add: cte_wp_at_cases' obj_at'_def)
   apply (rule iffI)
    apply (erule disjEI
-           | clarsimp simp: objBits_simps' cte_level_bits_def projectKOs word_bits_def
+           | clarsimp simp: objBits_simps' cte_level_bits_def projectKOs
            | rule rev_bexI, erule domI)+
   apply fastforce
   done
@@ -867,14 +906,6 @@ lemma valid_capAligned:
   "valid_cap' c s \<Longrightarrow> capAligned c"
   by (simp add: valid_cap'_def)
 
-lemma valid_SchedContextCap_sc_at':
-  "\<lbrakk>valid_cap' (SchedContextCap sc_ptr n) s\<rbrakk> \<Longrightarrow> sc_at' sc_ptr s"
-  apply (clarsimp simp: valid_cap'_def obj_at'_real_def)
-  apply (rule ko_wp_at'_weakenE)
-   apply (fastforce simp: objBits_simps
-                   split: kernel_object.splits)+
-  done
-
 lemma caps_no_overlap'_no_region:
   "\<lbrakk> caps_no_overlap' m (capRange cap); valid_objs' s;
     m = ctes_of s; s \<turnstile>' cap; fresh_virt_cap_class (capClass cap) m \<rbrakk> \<Longrightarrow>
@@ -1484,7 +1515,7 @@ lemma no_mdb_not_target:
   apply (simp add: no_mdb_def)
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma valid_dlist_init:
   "\<lbrakk> valid_dlist m; m p = Some cte; no_mdb cte \<rbrakk> \<Longrightarrow>
   valid_dlist (m (p \<mapsto> CTE cap initMDBNode))"
@@ -1682,7 +1713,7 @@ lemma untyped_inc_init:
     apply (rule untypedRange_in_capRange)+
   apply (simp add:Int_ac)
   done
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma valid_nullcaps_init:
   "\<lbrakk> valid_nullcaps m; cap \<noteq> NullCap \<rbrakk> \<Longrightarrow> valid_nullcaps (m(p \<mapsto> CTE cap initMDBNode))"
   by (simp add: valid_nullcaps_def initMDBNode_def nullPointer_def)
@@ -1742,7 +1773,7 @@ lemma distinct_zombies_copyE:
 lemmas distinct_zombies_sameE
     = distinct_zombies_copyE [where y=x and x=x for x, simplified,
                               OF _ _ _ _ _]
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma capBits_Master:
   "capBits (capMasterCap cap) = capBits cap"
   by (clarsimp simp: capMasterCap_def split: capability.split arch_capability.split)
@@ -1892,16 +1923,20 @@ lemma valid_mdb_ctes_init:
    apply clarsimp
    apply (case_tac ctea, clarsimp)
    apply (rule valid_capAligned, erule(1) ctes_of_valid_cap')
-  apply (erule (1) irq_control_init)
+  apply (rule conjI)
+   apply (erule (1) irq_control_init)
+  apply (simp add: ran_def reply_masters_rvk_fb_def)
+  apply (auto simp: initMDBNode_def)[1]
   done
 
 lemma setCTE_state_refs_of'[wp]:
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace> setCTE p cte \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   unfolding setCTE_def
   apply (rule setObject_state_refs_of_eq)
-   by (clarsimp simp: updateObject_cte in_monad typeError_def
-                         in_magnitude_check objBits_simps
-                  split: kernel_object.split_asm if_split_asm)+
+  apply (clarsimp simp: updateObject_cte in_monad typeError_def
+                        in_magnitude_check objBits_simps
+                 split: kernel_object.split_asm if_split_asm)
+  done
 
 lemma setCTE_valid_mdb:
   fixes cap
@@ -1926,11 +1961,12 @@ lemma setCTE_valid_objs'[wp]:
   unfolding setCTE_def
   apply (rule setObject_valid_objs')
    apply (clarsimp simp: prod_eq_iff lookupAround2_char1 updateObject_cte objBits_simps)
-   by (clarsimp simp: prod_eq_iff lookupAround2_char1
+   apply (clarsimp simp: prod_eq_iff lookupAround2_char1
                          updateObject_cte in_monad typeError_def
                          valid_obj'_def valid_tcb'_def valid_cte'_def
                          tcb_cte_cases_def
-                  split: kernel_object.split_asm if_split_asm)+
+                  split: kernel_object.split_asm if_split_asm)
+  done
 
 lemma getCTE_cte_wp_at:
   "\<lbrace>\<top>\<rbrace> getCTE p \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>c. c = rv) p\<rbrace>"
@@ -1978,6 +2014,10 @@ lemma setCTE_no_0_obj' [wp]:
 
 declare mresults_fail[simp]
 
+crunch get_object
+  for idle[wp]: "valid_idle"
+  (wp: crunch_wps simp: crunch_simps)
+
 end
 
 
diff --git a/proof/refine/ARM/CSpace_R.thy b/proof/refine/ARM/CSpace_R.thy
index f19d6f755e..78933b0531 100644
--- a/proof/refine/ARM/CSpace_R.thy
+++ b/proof/refine/ARM/CSpace_R.thy
@@ -12,8 +12,10 @@ theory CSpace_R
 imports CSpace1_R
 begin
 
-lemma setCTE_pred_tcb_at'[wp]:
-  "setCTE c cte \<lbrace>pred_tcb_at' proj P t\<rbrace>"
+lemma setCTE_pred_tcb_at':
+  "\<lbrace>pred_tcb_at' proj P t\<rbrace>
+     setCTE c cte
+   \<lbrace>\<lambda>rv. pred_tcb_at' proj P t\<rbrace>"
   unfolding pred_tcb_at'_def setCTE_def
   apply (rule setObject_cte_obj_at_tcb')
    apply (simp add: tcb_to_itcb'_def)+
@@ -51,7 +53,7 @@ locale mdb_move =
   modify_map n (mdbNext src_node)
                (cteMDBNode_update (mdbPrev_update (\<lambda>_. dest)))"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 
 
 lemmas src = m_p
@@ -677,7 +679,8 @@ lemma updateCap_dynamic_duo:
        \<Longrightarrow> pspace_aligned' s' \<and> pspace_distinct' s'"
   unfolding updateCap_def
   apply (rule conjI)
-   by (erule use_valid | wpsimp)+
+   apply (erule use_valid | wp | assumption)+
+  done
 
 declare const_apply[simp]
 
@@ -690,20 +693,16 @@ lemma next_slot_eq2:
 
 lemma set_cap_not_quite_corres':
   assumes cr:
-  "pspace_relation (kheap s) (ksPSpace s')"
+  "pspace_relations (ekheap (a)) (kheap s) (ksPSpace s')"
+  "ekheap (s)      = ekheap (a)"
   "cur_thread s    = ksCurThread s'"
   "idle_thread s   = ksIdleThread s'"
-  "idle_sc_ptr     = ksIdleSC s'"
   "machine_state s = ksMachineState s'"
   "work_units_completed s = ksWorkUnitsCompleted s'"
   "domain_index s  = ksDomScheduleIdx s'"
   "domain_list s   = ksDomSchedule s'"
   "cur_domain s    = ksCurDomain s'"
   "domain_time s   = ksDomainTime s'"
-  "consumed_time s = ksConsumedTime s'"
-  "cur_time s = ksCurTime s'"
-  "cur_sc s = ksCurSc s'"
-  "reprogram_timer s = ksReprogramTimer s'"
   "(x,t') \<in> fst (updateCap p' c' s')"
   "valid_objs s" "pspace_aligned s" "pspace_distinct s" "cte_at p s"
   "pspace_aligned' s'" "pspace_distinct' s'"
@@ -712,34 +711,29 @@ 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_relation (kheap t) (ksPSpace t') \<and>
+             pspace_relations (ekheap t) (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>
-             release_queue t = release_queue s \<and>
              is_original_cap t  = is_original_cap s \<and>
              interrupt_state_relation (interrupt_irq_node t) (interrupt_states t)
                               (ksInterruptState t') \<and>
              (arch_state t, ksArchState t') \<in> arch_state_relation \<and>
              cur_thread t    = ksCurThread t' \<and>
              idle_thread t   = ksIdleThread t' \<and>
-             idle_sc_ptr     = ksIdleSC t' \<and>
              machine_state t = ksMachineState t' \<and>
              work_units_completed t = ksWorkUnitsCompleted t' \<and>
              domain_index t  = ksDomScheduleIdx t' \<and>
              domain_list t   = ksDomSchedule t' \<and>
              cur_domain t    = ksCurDomain t' \<and>
-             domain_time t   = ksDomainTime t' \<and>
-             consumed_time t = ksConsumedTime t' \<and>
-             cur_time t = ksCurTime t' \<and>
-             cur_sc t = ksCurSc t' \<and>
-             reprogram_timer t = ksReprogramTimer t' \<and>
-             sc_replies_of t = sc_replies_of s"
-  using cr
-  by (rule set_cap_not_quite_corres; fastforce simp: c p)
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+             domain_time t   = ksDomainTime t'"
+  apply (rule set_cap_not_quite_corres)
+                using cr
+                apply (fastforce simp: c p pspace_relations_def)+
+                done
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma cteMove_corres:
   assumes cr: "cap_relation cap cap'"
   notes trans_state_update'[symmetric,simp]
@@ -808,6 +802,7 @@ 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
@@ -858,7 +853,7 @@ lemma cteMove_corres:
                         set_original_def bind_assoc modify_def
          |(rule bind_execI[where f="cap_move_ext x y z x'" for x y z x'], clarsimp simp: mdb_move_abs'.cap_move_ext_det_def2 update_cdt_list_def set_cdt_list_def put_def) | rule refl )+
   apply (clarsimp simp: put_def)
-  apply (clarsimp simp: invs'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def)
   apply (frule updateCap_dynamic_duo, fastforce, fastforce)
   apply (frule(2) updateCap_dynamic_duo [OF _ conjunct1 conjunct2])
   apply (subgoal_tac "no_0 (ctes_of b)")
@@ -867,7 +862,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 (4) updateMDB_the_lot', 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)
@@ -897,6 +892,7 @@ lemma cteMove_corres:
      apply fastforce
     apply fastforce
    apply fastforce
+  apply (clarsimp simp: pspace_relations_def)
   apply (rule conjI)
    apply (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def)
   apply (thin_tac "gsCNodes t = p" for t p)+
@@ -923,6 +919,7 @@ lemma cteMove_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 "ghost_relation s t p" for s t p)+
@@ -945,12 +942,14 @@ lemma cteMove_corres:
      subgoal by (clarsimp simp: cte_wp_at_caps_of_state null_filter_def split: if_split_asm)
     apply simp
    apply clarsimp
-   apply (prop_tac "null_filter (caps_of_state a) (aa,bb) \<noteq> None")
+   apply (subgoal_tac "null_filter (caps_of_state a) (aa,bb) \<noteq> None")
+    prefer 2
     subgoal by (clarsimp simp only: null_filter_def cap.simps option.simps
                                fun_upd_def simp_thms
           split: if_splits)
    apply clarsimp
-   apply (prop_tac "cte_at (aa,bb) a")
+   apply (subgoal_tac "cte_at (aa,bb) a")
+    prefer 2
     apply (drule null_filter_caps_of_stateD)
     apply (erule cte_wp_cte_at)
    apply (frule_tac p="(aa,bb)" and p'="ptr'" in cte_map_inj, assumption+)
@@ -965,7 +964,8 @@ lemma cteMove_corres:
      apply fastforce
     apply clarsimp
    subgoal by (simp add: null_filter_def split: if_splits)
-  apply (prop_tac "mdb_move (ctes_of b) (cte_map ptr) src_cap src_node (cte_map ptr') cap' old_dest_node")
+  apply (subgoal_tac "mdb_move (ctes_of b) (cte_map ptr) src_cap src_node (cte_map ptr') cap' old_dest_node")
+   prefer 2
    apply (rule mdb_move.intro)
     apply (rule mdb_ptr.intro)
      apply (rule vmdb.intro)
@@ -973,8 +973,8 @@ lemma cteMove_corres:
     apply (erule mdb_ptr_axioms.intro)
    apply (rule mdb_move_axioms.intro)
         apply assumption
-       apply (simp (no_asm_simp) add: nullPointer_def)
-      apply (simp (no_asm_simp) add: nullPointer_def)
+       apply (simp add: nullPointer_def)
+      apply (simp add: nullPointer_def)
      apply (erule weak_derived_sym')
     apply clarsimp
    apply assumption
@@ -986,19 +986,22 @@ lemma cteMove_corres:
     apply (rule mdb_move_abs.intro)
        apply fastforce
       apply (fastforce elim!: cte_wp_at_weakenE)
-     apply (simp (no_asm_simp))
-    apply (simp (no_asm_simp))
+     apply simp
+    apply simp
    apply (case_tac "(aa,bb) = ptr", simp)
-   apply (prop_tac "cte_map (aa,bb) \<noteq> cte_map ptr")
+   apply (subgoal_tac "cte_map (aa,bb) \<noteq> cte_map ptr")
+    prefer 2
     apply (erule (2) cte_map_inj, fastforce, fastforce, fastforce)
    apply (case_tac "(aa,bb) = ptr'")
     apply (simp add: cdt_relation_def del: split_paired_All)
-   apply (prop_tac "cte_map (aa,bb) \<noteq> cte_map ptr'")
+   apply (subgoal_tac "cte_map (aa,bb) \<noteq> cte_map ptr'")
+    prefer 2
     apply (erule (2) cte_map_inj, fastforce, fastforce, fastforce)
    apply (simp only: if_False)
    apply simp
-   apply (prop_tac "descendants_of' (cte_map (aa, bb)) (ctes_of b) =
+   apply (subgoal_tac "descendants_of' (cte_map (aa, bb)) (ctes_of b) =
                        cte_map ` descendants_of (aa, bb) (cdt a)")
+    prefer 2
     subgoal by (simp add: cdt_relation_def del: split_paired_All)
    apply simp
    apply (rule conjI)
@@ -1060,8 +1063,6 @@ lemma cteMove_corres:
   apply(erule_tac x=aa in allE, erule_tac x=bb in allE)
   by(clarsimp simp: cte_map_inj_eq valid_pspace_def split: if_split_asm)
 
-end
-
 lemmas cur_tcb_lift =
   hoare_lift_Pf [where f = ksCurThread and P = tcb_at', folded cur_tcb'_def]
 
@@ -1111,19 +1112,12 @@ crunch cteInsert
   and norq[wp]:  "\<lambda>s. P (ksReadyQueues s)"
   and norqL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
   and norqL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
-  and norlq[wp]: "\<lambda>s. P (ksReleaseQueue s)"
   and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
   (wp: updateObject_cte_inv crunch_wps ignore_del: setObject)
 
-global_interpretation updateMDB: typ_at_all_props' "updateMDB slot f"
-  by typ_at_props'
-
-global_interpretation updateCap: typ_at_all_props' "updateCap slot newCap"
-  by typ_at_props'
-
-global_interpretation cteInsert: typ_at_all_props' "cteInsert newCap srcSlot destSlot"
-  by typ_at_props'
+lemmas updateMDB_typ_ats [wp] = typ_at_lifts [OF updateMDB_typ_at']
+lemmas updateCap_typ_ats [wp] = typ_at_lifts [OF updateCap_typ_at']
+lemmas cteInsert_typ_ats [wp] = typ_at_lifts [OF cteInsert_typ_at']
 
 lemma setObject_cte_ct:
   "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setObject t (v::cte) \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
@@ -1132,10 +1126,10 @@ lemma setObject_cte_ct:
 crunch cteInsert
   for ct[wp]: "\<lambda>s. P (ksCurThread s)"
   (wp: setObject_cte_ct hoare_drop_imps)
-
+end
 context mdb_insert
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 lemma n_src_dest:
   "n \<turnstile> src \<leadsto> dest"
   by (simp add: n_direct_eq)
@@ -1655,7 +1649,7 @@ lemma untyped_inc_prev_update:
 lemma is_derived_badge_derived':
   "is_derived' m src cap cap' \<Longrightarrow> badge_derived' cap cap'"
   by (simp add: is_derived'_def)
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma cteInsert_mdb_chain_0:
   "\<lbrace>valid_mdb' and pspace_aligned' and pspace_distinct' and (\<lambda>s. src \<noteq> dest) and
     (\<lambda>s. cte_wp_at' (is_derived' (ctes_of s) src cap \<circ> cteCap) src s)\<rbrace>
@@ -2174,7 +2168,7 @@ lemma cteInsert_mdb' [wp]:
         setUntypedCapAsFull_valid_dlist setUntypedCapAsFull_distinct_zombies
         setUntypedCapAsFull_valid_badges setUntypedCapAsFull_caps_contained
         setUntypedCapAsFull_valid_nullcaps setUntypedCapAsFull_ut_revocable
-        setUntypedCapAsFull_class_links
+        setUntypedCapAsFull_class_links setUntypedCapAsFull_reply_masters_rvk_fb
         mdb_inv_preserve_fun_upd
         mdb_inv_preserve_modify_map getCTE_wp| simp del:fun_upd_apply)+
   apply (clarsimp simp:cte_wp_at_ctes_of simp del:fun_upd_apply)
@@ -2221,6 +2215,7 @@ proof -
      and class_links: "class_links ?m"
      and distinct_zombies: "distinct_zombies ?m"
      and irq: "irq_control ?m"
+     and reply_masters_rvk_fb: "reply_masters_rvk_fb ?m"
      and vn: "valid_nullcaps ?m"
      and ut_rev:"ut_revocable' ?m"
 
@@ -2284,36 +2279,37 @@ proof -
     w2ned[symmetric] srcdest srcdest[symmetric]
 
   have mdb_next_disj:
-    "\<And>p p'. (?C \<turnstile> p \<leadsto> p' \<Longrightarrow>
+   "\<And>p p'. (?C \<turnstile> p \<leadsto> p' \<Longrightarrow>
    ?m \<turnstile> p \<leadsto> p' \<and> p \<noteq> src \<and> p'\<noteq> dest \<and> (p' = word1 \<longrightarrow> p' = 0)
    \<or> p = src \<and> p' = dest \<or> p = dest \<and> p' = word1)"
-    apply (case_tac "p = src")
-     apply (clarsimp simp:mdb_next_unfold modify_map_cases)
-    apply (case_tac "p = dest")
-     apply (clarsimp simp:mdb_next_unfold modify_map_cases)+
-    using cofs cofd vd no0
-    apply (case_tac "p = word1")
-     apply clarsimp
-     apply (intro conjI)
-      apply clarsimp
-      apply (frule_tac p = "word1" and m = "?m" in valid_dlist_nextD)
-        apply clarsimp+
-     apply (frule_tac p = "mdbNext node" and m = "?m" in valid_dlist_nextD)
-       apply clarsimp+
-     apply (frule_tac p = "mdbNext node" in no_loops_no_l2_loop[OF _ no_loop])
-       apply simp+
+   apply (case_tac "p = src")
+   apply (clarsimp simp:mdb_next_unfold modify_map_cases)
+   apply (case_tac "p = dest")
+   apply (clarsimp simp:mdb_next_unfold modify_map_cases)+
+   using cofs cofd vd no0
+   apply -
+   apply (case_tac "p = word1")
+    apply clarsimp
     apply (intro conjI)
      apply clarsimp
-     apply (frule_tac p = p and m = "?m" in valid_dlist_nextD)
-       apply (clarsimp+)[3]
-    apply (intro impI)
-    apply (rule ccontr)
-    apply clarsimp
-    apply (frule_tac p = src and m = "?m" in valid_dlist_nextD)
+     apply (frule_tac p = "word1" and m = "?m" in valid_dlist_nextD)
       apply clarsimp+
-    apply (frule_tac p = p and m = "?m" in valid_dlist_nextD)
+     apply (frule_tac p = "mdbNext node" and m = "?m" in valid_dlist_nextD)
       apply clarsimp+
-    done
+    apply (frule_tac p = "mdbNext node" in no_loops_no_l2_loop[OF _ no_loop])
+     apply simp+
+  apply (intro conjI)
+   apply clarsimp
+    apply (frule_tac p = p and m = "?m" in valid_dlist_nextD)
+     apply (clarsimp+)[3]
+  apply (intro impI)
+  apply (rule ccontr)
+  apply clarsimp
+    apply (frule_tac p = src and m = "?m" in valid_dlist_nextD)
+  apply clarsimp+
+    apply (frule_tac p = p and m = "?m" in valid_dlist_nextD)
+  apply clarsimp+
+  done
 
   have ctes_ofD:
    "\<And>p cte. \<lbrakk>?C p = Some cte; p\<noteq> dest; p\<noteq> src\<rbrakk> \<Longrightarrow> \<exists>cteb. (?m p = Some cteb \<and> cteCap cte = cteCap cteb)"
@@ -2321,160 +2317,179 @@ proof -
 
 
   show "valid_badges ?C"
-    using srcdest badge cofs badges cofd
-    unfolding valid_badges_def
-    apply (intro impI allI)
-    apply (drule mdb_next_disj)
-    apply (elim disjE)
-      defer
-      apply (clarsimp simp:modify_map_cases dest0 src0)
-      apply (clarsimp simp:revokable'_def badge_derived'_def)
-      subgoal by (case_tac src_cap,auto simp:isCap_simps sameRegionAs_def)
-     apply (clarsimp simp:modify_map_cases valid_badges_def)
-     apply (frule_tac x=src in spec, erule_tac x=word1 in allE, erule allE, erule impE)
-      apply fastforce
-     apply simp
-     apply (clarsimp simp:mdb_next_unfold badge_derived'_def split: if_split_asm)
-     apply (thin_tac "All P" for P)
-     subgoal by (cases src_cap,
-                 auto simp:mdb_next_unfold isCap_simps sameRegionAs_def Let_def split: if_splits)
-    apply (case_tac "word1 = p'")
+  using srcdest badge cofs badges cofd
+  unfolding valid_badges_def
+  apply (intro impI allI)
+  apply (drule mdb_next_disj)
+  apply (elim disjE)
+    defer
+    apply (clarsimp simp:modify_map_cases dest0 src0)
+    apply (clarsimp simp:revokable'_def badge_derived'_def)
+    subgoal by (case_tac src_cap,auto simp:isCap_simps sameRegionAs_def)
+  apply (clarsimp simp:modify_map_cases valid_badges_def)
+    apply (frule_tac x=src in spec, erule_tac x=word1 in allE, erule allE, erule impE)
+    apply fastforce
+    apply simp
+    apply (clarsimp simp:mdb_next_unfold badge_derived'_def split: if_split_asm)
+    apply (thin_tac "All P" for P)
+    subgoal by (cases src_cap,
+       auto simp:mdb_next_unfold isCap_simps sameRegionAs_def Let_def split: if_splits)
+  apply (case_tac "word1 = p'")
      apply (clarsimp simp:modify_map_cases valid_badges_def mdb_next_unfold src0 dest0 no0)+
-    apply (case_tac "p = dest")
-     apply (clarsimp simp:dest0 src0 no0)+
-    apply (case_tac z)
-    apply (rename_tac capability mdbnode)
-    apply clarsimp
-    apply (drule_tac x = p in spec,drule_tac x = "mdbNext mdbnode" in spec)
-    by (auto simp:isCap_simps sameRegionAs_def)
+  apply (case_tac "p = dest")
+   apply (clarsimp simp:dest0 src0 no0)+
+  apply (case_tac z)
+  apply (rename_tac capability mdbnode)
+  apply clarsimp
+  apply (drule_tac x = p in spec,drule_tac x = "mdbNext mdbnode" in spec)
+  by (auto simp:isCap_simps sameRegionAs_def)
 
   from badge
   have isUntyped_eq: "isUntypedCap cap = isUntypedCap src_cap"
-    apply (clarsimp simp:badge_derived'_def)
-    apply (case_tac cap,auto simp:isCap_simps)
-    done
+   apply (clarsimp simp:badge_derived'_def)
+   apply (case_tac cap,auto simp:isCap_simps)
+   done
 
   from badge
   have [simp]: "capRange cap = capRange src_cap"
-    apply (clarsimp simp:badge_derived'_def)
-    apply (case_tac cap; clarsimp simp:isCap_simps capRange_def)
+   apply (clarsimp simp:badge_derived'_def)
+   apply (case_tac cap)
+     apply (clarsimp simp:isCap_simps capRange_def)+
+    (* 5 subgoals *)
     apply (rename_tac arch_capability)
-    apply (case_tac arch_capability; clarsimp simp:isCap_simps capRange_def)
-    done
+    apply (case_tac arch_capability)
+     (* 9 subgoals *)
+     apply (clarsimp simp:isCap_simps capRange_def)+
+   done
 
   have [simp]: "untypedRange cap = untypedRange src_cap"
-    using badge
-    apply (clarsimp simp:badge_derived'_def dest!:capMaster_untypedRange)
-    done
+     using badge
+     apply (clarsimp simp:badge_derived'_def dest!:capMaster_untypedRange)
+     done
 
   from contained badge srcdest cofs cofd is_der no0
   show "caps_contained' ?C"
-    apply (clarsimp simp add: caps_contained'_def)
-    apply (case_tac "p = dest")
-     apply (case_tac "p' = dest")
-      apply (clarsimp simp:modify_map_def split:if_splits)
-      apply (case_tac src_cap,auto)[1]
-     apply (case_tac "p' = src")
-      apply (clarsimp simp:modify_map_def split:if_splits)
-      apply (clarsimp simp:badge_derived'_def)
-      apply (case_tac src_cap,auto)[1]
-     apply (drule(2) ctes_ofD)
-     apply (clarsimp simp:modify_map_def split:if_splits)
-     apply (frule capRange_untyped)
-     apply (erule_tac x=src in allE, erule_tac x=p' in allE, simp)
-     apply (case_tac cteb)
-     apply (clarsimp)
-     apply blast
-    apply (case_tac "p' = dest")
-     apply (case_tac "p = src")
-      apply (clarsimp simp:modify_map_def split:if_splits)
-      apply (drule capRange_untyped)
-    subgoal by (case_tac cap,auto simp:isCap_simps badge_derived'_def)
+  apply (clarsimp simp add: caps_contained'_def)
+  apply (case_tac "p = dest")
+   apply (case_tac "p' = dest")
+    apply (clarsimp simp:modify_map_def split:if_splits)
+    apply (case_tac src_cap,auto)[1]
+   apply (case_tac "p' = src")
+    apply (clarsimp simp:modify_map_def split:if_splits)
+    apply (clarsimp simp:badge_derived'_def)
+    apply (case_tac src_cap,auto)[1]
+   apply (drule(2) ctes_ofD)
+   apply (clarsimp simp:modify_map_def split:if_splits)
+   apply (frule capRange_untyped)
+   apply (erule_tac x=src in allE, erule_tac x=p' in allE, simp)
+    apply (case_tac cteb)
+    apply (clarsimp)
+    apply blast
+   apply (case_tac "p' = dest")
+    apply (case_tac "p = src")
      apply (clarsimp simp:modify_map_def split:if_splits)
-      apply (drule_tac x = word1 in spec)
-      apply (drule_tac x = src in spec)
-      apply (case_tac z)
-      apply (clarsimp simp:isUntyped_eq)
-      apply blast
-     apply (drule_tac x = p in spec)
-     apply (drule_tac x = src in spec)
-     apply (frule capRange_untyped)
-     apply (clarsimp simp:isUntyped_eq)
-     apply blast
-    apply (drule_tac x = p in spec)
-    apply (drule_tac x = p' in spec)
+     apply (drule capRange_untyped)
+     subgoal by (case_tac cap,auto simp:isCap_simps badge_derived'_def)
     apply (clarsimp simp:modify_map_def split:if_splits)
-            apply ((case_tac z,fastforce)+)[5]
-    by fastforce+
-
-  show "valid_nullcaps ?C"
-    using is_der vn cofs vd no0
-    apply (simp add: valid_nullcaps_def)
-    apply (clarsimp simp:modify_map_def is_derived'_def)
-    apply (rule conjI)
-     apply (clarsimp simp: is_derived'_def badge_derived'_def)+
     apply (drule_tac x = word1 in spec)
+    apply (drule_tac x = src in spec)
     apply (case_tac z)
-    apply (clarsimp simp:nullMDBNode_def)
-    apply (drule(1) valid_dlist_nextD)
-     apply simp
-     apply clarsimp
-    apply (simp add:nullPointer_def src0)
-    done
+    apply (clarsimp simp:isUntyped_eq)
+    apply blast
+    apply (drule_tac x = p in spec)
+    apply (drule_tac x = src in spec)
+    apply (frule capRange_untyped)
+    apply (clarsimp simp:isUntyped_eq)
+    apply blast
+   apply (drule_tac x = p in spec)
+   apply (drule_tac x = p' in spec)
+   apply (clarsimp simp:modify_map_def split:if_splits)
+    apply ((case_tac z,fastforce)+)[5]
+   by fastforce+
+
+  show "valid_nullcaps ?C"
+  using is_der vn cofs vd no0
+  apply (simp add: valid_nullcaps_def srcdest [symmetric])
+  apply (clarsimp simp:modify_map_def is_derived'_def)
+  apply (rule conjI)
+    apply (clarsimp simp: is_derived'_def badge_derived'_def)+
+  apply (drule_tac x = word1 in spec)
+  apply (case_tac z)
+  apply (clarsimp simp:nullMDBNode_def)
+  apply (drule(1) valid_dlist_nextD)
+    apply simp
+   apply clarsimp
+  apply (simp add:nullPointer_def src0)
+  done
 
   from vmdb srcdest cofs ut_rev
   show "ut_revocable' ?C"
-    apply (clarsimp simp: valid_mdb_ctes_def ut_revocable'_def modify_map_def)
-    apply (rule conjI)
-     apply clarsimp
-     apply (clarsimp simp: revokable'_def isCap_simps)+
-    apply auto
-     apply (drule_tac x= src in spec)
-     apply clarsimp
-    apply (case_tac z)
-    apply clarsimp
-    done
+  apply (clarsimp simp: valid_mdb_ctes_def ut_revocable'_def modify_map_def)
+  apply (rule conjI)
+   apply clarsimp
+   apply (clarsimp simp: revokable'_def isCap_simps)+
+   apply auto
+  apply (drule_tac x= src in spec)
+   apply clarsimp
+  apply (case_tac z)
+   apply clarsimp
+  done
 
   from class_links srcdest badge cofs cofd no0 vd
   show "class_links ?C"
-    unfolding class_links_def
-    apply (intro allI impI)
-    apply (drule mdb_next_disj)
-    apply (elim disjE)
-      apply (clarsimp simp:modify_map_def mdb_next_unfold split:if_split_asm)
-     apply (clarsimp simp: badge_derived'_def modify_map_def
-                     split: if_split_asm)
-     apply (erule capMaster_capClass)
-    apply (clarsimp simp:modify_map_def split:if_splits)
-    apply (drule_tac x = src in spec)
-    apply (drule_tac x = word1 in spec)
-    apply (clarsimp simp:mdb_next_unfold)
-    apply (case_tac z)
-    apply (clarsimp simp:badge_derived'_def)
-    apply (drule capMaster_capClass)
-    apply simp
-    done
+  unfolding class_links_def
+  apply (intro allI impI)
+  apply (drule mdb_next_disj)
+  apply (elim disjE)
+    apply (clarsimp simp:modify_map_def mdb_next_unfold split:if_split_asm)
+   apply (clarsimp simp: badge_derived'_def modify_map_def
+    split: if_split_asm)
+   apply (erule capMaster_capClass)
+  apply (clarsimp simp:modify_map_def split:if_splits)
+  apply (drule_tac x = src in spec)
+  apply (drule_tac x = word1 in spec)
+  apply (clarsimp simp:mdb_next_unfold)
+  apply (case_tac z)
+   apply (clarsimp simp:badge_derived'_def)
+  apply (drule capMaster_capClass)
+  apply simp
+  done
 
-  from distinct_zombies badge
-  show "distinct_zombies ?C"
-    apply (simp add:distinct_zombies_nonCTE_modify_map)
-    apply (erule_tac distinct_zombies_copyMasterE[where x=src])
-      apply (rule cofs)
-     apply (simp add: masters)
-    apply (simp add: notZomb1 notZomb2)
-    done
+ from distinct_zombies badge
+ show "distinct_zombies ?C"
+ apply (simp add:distinct_zombies_nonCTE_modify_map)
+ apply (erule_tac distinct_zombies_copyMasterE[where x=src])
+   apply (rule cofs)
+  apply (simp add: masters)
+ apply (simp add: notZomb1 notZomb2)
+ done
+
+ from reply_masters_rvk_fb is_der
+ show "reply_masters_rvk_fb ?C"
+   apply (clarsimp simp:reply_masters_rvk_fb_def)
+   apply (erule ranE)
+   apply (clarsimp simp:modify_map_def split:if_split_asm)
+    apply fastforce+
+   apply (clarsimp simp:is_derived'_def isCap_simps)
+   apply fastforce
+ done
 qed
 
 crunch cteInsert
   for state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
-  and aligned'[wp]: pspace_aligned'
-  and distinct'[wp]: pspace_distinct'
-  and bounded'[wp]: pspace_bounded'
-  and no_0_obj'[wp]: no_0_obj'
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and pred_tcb_at'[wp]: "pred_tcb_at' proj P p"
-  and valid_replies' [wp]: valid_replies'
-  (wp: crunch_wps valid_replies'_lift)
+  (wp: crunch_wps)
+
+crunch cteInsert
+  for aligned'[wp]: pspace_aligned'
+  (wp: crunch_wps)
+
+crunch cteInsert
+  for distinct'[wp]: pspace_distinct'
+  (wp: crunch_wps)
+
+crunch cteInsert
+  for no_0_obj'[wp]: no_0_obj'
+  (wp: crunch_wps)
 
 lemma cteInsert_valid_pspace:
   "\<lbrace>valid_pspace' and valid_cap' cap and (\<lambda>s. src \<noteq> dest) and valid_objs' and
@@ -2748,15 +2763,6 @@ lemma setCTE_it'[wp]:
   apply (wp|wpc|simp del: hoare_fail_any)+
   done
 
-lemma setCTE_idldSC[wp]:
-  "setCTE c p \<lbrace>\<lambda>s. P (ksIdleSC s)\<rbrace>"
-  apply (simp add: setCTE_def setObject_def split_def updateObject_cte)
-  apply (wp|wpc|simp del: hoare_fail_any)+
-  done
-
-crunch setCTE
-  for idle_sc_at'[wp]: "\<lambda>s. idle_sc_at' p s"
-
 lemma setCTE_idle [wp]:
   "\<lbrace>valid_idle'\<rbrace> setCTE p cte \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
   apply (simp add: valid_idle'_def)
@@ -2774,7 +2780,7 @@ lemma updateMDB_idle'[wp]:
  "\<lbrace>valid_idle'\<rbrace> updateMDB p m \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
   apply (clarsimp simp add: updateMDB_def)
   apply (rule hoare_pre)
-   apply (wp | simp add: valid_idle'_def)+
+  apply (wp | simp add: valid_idle'_def)+
   by fastforce
 
 lemma updateCap_idle':
@@ -2879,6 +2885,11 @@ done
 lemma setCTE_valid_mappings'[wp]:
   "\<lbrace>valid_pde_mappings'\<rbrace> setCTE x y \<lbrace>\<lambda>rv. valid_pde_mappings'\<rbrace>"
   apply (wp valid_pde_mappings_lift' setCTE_typ_at')
+   apply (simp add: setCTE_def)
+   apply (rule obj_at_setObject2)
+   apply (clarsimp simp: updateObject_cte typeError_def in_monad
+                  split: Structures_H.kernel_object.split_asm if_split_asm)
+  apply assumption
   done
 
 crunch cteInsert
@@ -2910,8 +2921,20 @@ lemma setCTE_cteCaps_of[wp]:
   "\<lbrace>\<lambda>s. P ((cteCaps_of s)(p \<mapsto> cteCap cte))\<rbrace>
       setCTE p cte
    \<lbrace>\<lambda>rv s. P (cteCaps_of s)\<rbrace>"
-  unfolding cteCaps_of_def
-  by wp (force elim!: rsubst[where P=P])
+  apply (simp add: cteCaps_of_def)
+  apply wp
+  apply (clarsimp elim!: rsubst[where P=P] intro!: ext)
+  done
+
+crunch setupReplyMaster
+  for inQ[wp]: "\<lambda>s. P (obj_at' (inQ d p) t s)"
+  and norq[wp]:  "\<lambda>s. P (ksReadyQueues s)"
+  and ct[wp]: "\<lambda>s. P (ksCurThread s)"
+  and state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
+  and it[wp]: "\<lambda>s. P (ksIdleThread s)"
+  and nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+  (wp: crunch_wps)
 
 lemmas setCTE_cteCap_wp_irq[wp] =
     hoare_use_eq_irq_node' [OF setCTE_ksInterruptState setCTE_cteCaps_of]
@@ -2925,15 +2948,16 @@ lemma setUntypedCapAsFull_valid_refs'[wp]:
   "\<lbrace>\<lambda>s. valid_refs' R (ctes_of s) \<and> cte_wp_at' ((=) srcCTE) src s\<rbrace>
    setUntypedCapAsFull (cteCap srcCTE) cap src
    \<lbrace>\<lambda>yb s. valid_refs' R (ctes_of s)\<rbrace>"
-  apply (clarsimp simp: valid_refs'_def setUntypedCapAsFull_def split del:if_split)
+  apply (clarsimp simp:valid_refs'_def setUntypedCapAsFull_def split del:if_splits)
   apply (rule hoare_pre)
-   apply (wp updateCap_ctes_of_wp)
+  apply (wp updateCap_ctes_of_wp)
   apply (clarsimp simp:ran_dom)
   apply (drule_tac x = y in bspec)
-   apply (drule_tac a = y in domI)
-   apply (simp add:modify_map_dom)
-  apply (clarsimp simp:modify_map_def cte_wp_at_ctes_of isCap_simps split:if_splits)
-  done
+    apply (drule_tac a = y in domI)
+    apply (simp add:modify_map_dom)
+  apply (clarsimp simp:modify_map_def cte_wp_at_ctes_of
+    isCap_simps split:if_splits)
+done
 
 crunch setUntypedCapAsFull
   for gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
@@ -2942,14 +2966,15 @@ lemma setUntypedCapAsFull_sizes[wp]:
   "\<lbrace>\<lambda>s. valid_cap_sizes' sz (ctes_of s) \<and> cte_wp_at' ((=) srcCTE) src s\<rbrace>
     setUntypedCapAsFull (cteCap srcCTE) cap src
   \<lbrace>\<lambda>rv s. valid_cap_sizes' sz (ctes_of s)\<rbrace>"
-  apply (clarsimp simp: valid_cap_sizes'_def setUntypedCapAsFull_def split del: if_split)
+  apply (clarsimp simp:valid_cap_sizes'_def setUntypedCapAsFull_def split del:if_splits)
   apply (rule hoare_pre)
-   apply (wp updateCap_ctes_of_wp | wps)+
+  apply (wp updateCap_ctes_of_wp | wps)+
   apply (clarsimp simp:ran_dom)
   apply (drule_tac x = y in bspec)
-   apply (drule_tac a = y in domI)
-   apply (simp add:modify_map_dom)
-  apply (clarsimp simp:modify_map_def cte_wp_at_ctes_of isCap_simps split:if_splits)
+    apply (drule_tac a = y in domI)
+    apply (simp add:modify_map_dom)
+  apply (clarsimp simp:modify_map_def cte_wp_at_ctes_of
+    isCap_simps split:if_splits)
   done
 
 lemma setUntypedCapAsFull_valid_global_refs'[wp]:
@@ -2958,9 +2983,9 @@ lemma setUntypedCapAsFull_valid_global_refs'[wp]:
    \<lbrace>\<lambda>yb s. valid_global_refs' s\<rbrace>"
   apply (clarsimp simp: valid_global_refs'_def)
   apply (rule hoare_pre,wps)
-   apply wp
+  apply wp
   apply simp
-  done
+done
 
 lemma capMaster_eq_capBits_eq:
   "capMasterCap cap = capMasterCap cap' \<Longrightarrow> capBits cap = capBits cap'"
@@ -2986,6 +3011,14 @@ lemma cteInsert_valid_globals [wp]:
   apply simp
   done
 
+crunch cteInsert
+  for arch[wp]: "\<lambda>s. P (ksArchState s)"
+  (wp: crunch_wps simp: cte_wp_at_ctes_of)
+
+crunch cteInsert
+  for pde_mappings'[wp]: valid_pde_mappings'
+  (wp: crunch_wps)
+
 lemma setCTE_ksMachine[wp]:
   "\<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> setCTE x y \<lbrace>\<lambda>_ s. P (ksMachineState s)\<rbrace>"
   apply (clarsimp simp: setCTE_def)
@@ -3017,8 +3050,8 @@ lemma setCTE_ct_not_inQ[wp]:
   apply (rule ct_not_inQ_lift [OF setCTE_nosch])
   apply (simp add: setCTE_def ct_not_inQ_def)
   apply (rule hoare_weaken_pre)
-   apply (wps setObject_cte_ct)
-   apply (rule setObject_cte_obj_at_tcb')
+  apply (wps setObject_cte_ct)
+  apply (rule setObject_cte_obj_at_tcb')
        apply (clarsimp simp add: obj_at'_def)+
   done
 
@@ -3052,8 +3085,7 @@ crunch cteInsert
   (wp:  crunch_wps )
 
 crunch cteInsert
-  for ksIdleThread[wp]:  "\<lambda>s. P (ksIdleThread s)"
-  and ksIdlSC[wp]: "\<lambda>s. P (ksIdleSC s)"
+  for ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
   (wp: crunch_wps)
 
 crunch cteInsert
@@ -3100,7 +3132,8 @@ crunch cteInsert
   (wp: setObject_ksPSpace_only updateObject_cte_inv crunch_wps)
 
 definition
-  "untyped_derived_eq cap cap' = (isUntypedCap cap \<longrightarrow> cap = cap')"
+  "untyped_derived_eq cap cap'
+    = (isUntypedCap cap \<longrightarrow> cap = cap')"
 
 lemma ran_split:
   "inj_on m (dom m)
@@ -3235,17 +3268,12 @@ lemma cteInsert_untyped_ranges_zero[wp]:
   apply blast
   done
 
-lemma updateCap_replies_of'[wp]:
-  "updateCap a b \<lbrace>\<lambda>s. P (replies_of' s)\<rbrace>"
-  unfolding updateCap_def
-  by (wpsimp wp: setObject_cte_replies_of' simp: setCTE_def)
-
 crunch cteInsert
-  for replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
-  and tcbInReleaseQueue[wp]: "\<lambda>s. P (obj_at' tcbInReleaseQueue tcb s)"
-  (wp: crunch_wps setObject_cte_replies_of' simp: crunch_simps setCTE_def)
-
-lemmas fold_list_refs_of_replies' = comp_def[symmetric, where f=Some and g=list_refs_of_reply']
+  for tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and valid_bitmaps[wp]: valid_bitmaps
+  (wp: crunch_wps rule: valid_bitmaps_lift)
 
 lemma cteInsert_invs:
  "\<lbrace>invs' and cte_wp_at' (\<lambda>c. cteCap c=NullCap) dest and valid_cap' cap and
@@ -3254,13 +3282,12 @@ lemma cteInsert_invs:
   and ex_cte_cap_to' dest and (\<lambda>s. \<forall>irq. cap = IRQHandlerCap irq \<longrightarrow> irq_issued' irq s)\<rbrace>
   cteInsert cap src dest
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: cur_tcb_lift tcb_in_cur_domain'_lift sch_act_wf_lift CSpace_R.valid_queues_lift
-                    valid_irq_node_lift valid_queues_lift' valid_release_queue_lift
-                    valid_release_queue'_lift irqs_masked_lift cteInsert_norq
-              simp: st_tcb_at'_def)
-  apply (subst fold_list_refs_of_replies')
-  by (auto simp: invs'_def valid_pspace'_def elim: valid_capAligned)
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
+  apply (wpsimp wp: cur_tcb_lift tcb_in_cur_domain'_lift sch_act_wf_lift
+                    valid_irq_node_lift irqs_masked_lift cteInsert_norq
+                    sym_heap_sched_pointers_lift)
+  apply (auto simp: invs'_def valid_state'_def valid_pspace'_def elim: valid_capAligned)
+  done
 
 lemma deriveCap_corres:
  "\<lbrakk>cap_relation c c'; cte = cte_map slot \<rbrakk> \<Longrightarrow>
@@ -3331,7 +3358,7 @@ lemma lookupSlotForCNodeOp_inv'[wp]:
 lemma loadWordUser_inv [wp]:
   "\<lbrace>P\<rbrace> loadWordUser p \<lbrace>\<lambda>rv. P\<rbrace>"
   unfolding loadWordUser_def
-  by (wpsimp wp: dmo_inv' loadWord_inv)
+  by (wp dmo_inv' loadWord_inv)
 
 lemma capTransferFromWords_inv:
   "\<lbrace>P\<rbrace> capTransferFromWords buffer \<lbrace>\<lambda>_. P\<rbrace>"
@@ -3492,7 +3519,7 @@ lemma deriveCap_untyped_derived:
 
 lemma setCTE_corres:
   "cap_relation cap (cteCap cte) \<Longrightarrow>
-   corres_underlying {(s, s'). pspace_relation (kheap s) (ksPSpace s')} False True dc
+   corres_underlying {(s, s'). pspace_relations (ekheap (s)) (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)
@@ -3537,10 +3564,8 @@ lemma ghost_relation_of_heap:
   done
 
 lemma corres_caps_decomposition:
-  assumes pspace_corres:
-    "corres_underlying {(s, s'). pspace_relation (kheap s) (ksPSpace s')} False True r P P' f g"
-  assumes updates:
-             "\<And>P. \<lbrace>\<lambda>s. P (new_caps s)\<rbrace>f \<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
+  assumes x: "corres_underlying {(s, s'). pspace_relations (ekheap (s)) (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>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_rvk s)\<rbrace> f \<lbrace>\<lambda>rv s. P (is_original_cap s)\<rbrace>"
@@ -3555,7 +3580,6 @@ lemma corres_caps_decomposition:
              "\<And>P. \<lbrace>\<lambda>s. P (new_as' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksArchState s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_id s)\<rbrace> f \<lbrace>\<lambda>rv s. P (idle_thread s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_id' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksIdleThread s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_idsc' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksIdleSC s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_irqn s)\<rbrace> f \<lbrace>\<lambda>rv s. P (interrupt_irq_node s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_irqs s)\<rbrace> f \<lbrace>\<lambda>rv s. P (interrupt_states s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_irqs' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksInterruptState s)\<rbrace>"
@@ -3566,65 +3590,50 @@ lemma corres_caps_decomposition:
              "\<And>P. \<lbrace>\<lambda>s. P (new_ready_queues s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ready_queues s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_action s)\<rbrace> f \<lbrace>\<lambda>rv s. P (scheduler_action s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_sa' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_rqs' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksReadyQueues s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_release_queue s)\<rbrace> f \<lbrace>\<lambda>rv s. P (release_queue s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_ksReleaseQueue s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksReleaseQueue s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_release_queue s)\<rbrace> f \<lbrace>\<lambda>rv s. P (release_queue s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_sc_replies_of s)\<rbrace> f \<lbrace>\<lambda>rv s. P (sc_replies_of s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_scs_of' s) (new_replies_of' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (scs_of' s) (replies_of' s)\<rbrace>"
+             "\<And>P. \<lbrace>\<lambda>s. P (new_ksReadyQueues s) (new_tcbSchedNexts_of s) (new_tcbSchedPrevs_of s)
+                          (\<lambda>d p. new_inQs d p s)\<rbrace>
+                   g \<lbrace>\<lambda>rv s. P (ksReadyQueues s) (tcbSchedNexts_of s) (tcbSchedPrevs_of s)
+                               (\<lambda>d p. inQ d p |< (tcbs_of' s))\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_di s)\<rbrace> f \<lbrace>\<lambda>rv s. P (domain_index s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_dl s)\<rbrace> f \<lbrace>\<lambda>rv s. P (domain_list s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cd s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cur_domain s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_dt s)\<rbrace> f \<lbrace>\<lambda>rv s. P (domain_time s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_cot s)\<rbrace> f \<lbrace>\<lambda>rv s. P (consumed_time s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_cut s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cur_time s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_csc s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cur_sc s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_rpt s)\<rbrace> f \<lbrace>\<lambda>rv s. P (reprogram_timer s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_dsi' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksDomScheduleIdx s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_ds' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_cd' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksCurDomain s)\<rbrace>"
              "\<And>P. \<lbrace>\<lambda>s. P (new_dt' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksDomainTime s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_cot' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksConsumedTime s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_cut' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksCurTime s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_csc' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksCurSc s)\<rbrace>"
-             "\<And>P. \<lbrace>\<lambda>s. P (new_rpt' s)\<rbrace> g \<lbrace>\<lambda>rv s. P (ksReprogramTimer s)\<rbrace>"
-  assumes updated_relations:
-    "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
-              \<Longrightarrow> cdt_relation ((\<noteq>) None \<circ> new_caps s) (new_mdb s) (new_ctes s')
-                  \<and> cdt_list_relation (new_list s) (new_mdb s) (new_ctes s')
-                  \<and> sc_replies_relation_2 (new_sc_replies_of s) (new_scs_of' s' |> scReply)
-                      (new_replies_of' s' |> replyPrev)
-                  \<and> release_queue_relation (new_release_queue s) (new_ksReleaseQueue s')
-                  \<and> sched_act_relation (new_action s) (new_sa' s')
-                  \<and> ready_queues_relation (new_queues s) (new_rqs' s')
-                  \<and> revokable_relation (new_rvk s) (null_filter (new_caps s)) (new_ctes s')
-                  \<and> interrupt_state_relation (new_irqn s) (new_irqs s) (new_irqs' s')
-                  \<and> (new_as s, new_as' s') \<in> arch_state_relation
-                  \<and> new_ct s = new_ct' s'
-                  \<and> new_id s = new_id' s'
-                  \<and> idle_sc_ptr = new_idsc' s'
-                  \<and> new_ms s = new_ms' s'
-                  \<and> new_di s = new_dsi' s'
-                  \<and> new_dl s = new_ds' s'
-                  \<and> new_cd s = new_cd' s'
-                  \<and> new_dt s = new_dt' s'
-                  \<and> new_cot s = new_cot' s'
-                  \<and> new_cut s = new_cut' s'
-                  \<and> new_csc s = new_csc' s'
-                  \<and> new_rpt s = new_rpt' s'
-                  \<and> new_wuc s = new_wuc' s'
-                  \<and> new_ups s = new_ups' s'
-                  \<and> new_cns s = new_cns' s'"
+  assumes z: "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
+                       \<Longrightarrow> cdt_relation ((\<noteq>) None \<circ> new_caps s) (new_mdb s) (new_ctes s')"
+             "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
+                       \<Longrightarrow> cdt_list_relation (new_list s) (new_mdb s) (new_ctes s')"
+             "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
+                       \<Longrightarrow> sched_act_relation (new_action s) (new_sa' s')"
+             "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
+                       \<Longrightarrow> ready_queues_relation_2 (new_ready_queues s) (new_ksReadyQueues s')
+                                                   (new_tcbSchedNexts_of s') (new_tcbSchedPrevs_of s')
+                                                   (\<lambda>d p. new_inQs d p s')"
+             "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
+                       \<Longrightarrow> revokable_relation (new_rvk s) (null_filter (new_caps s)) (new_ctes s')"
+             "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
+                       \<Longrightarrow> (new_as s, new_as' s') \<in> arch_state_relation
+                            \<and> interrupt_state_relation (new_irqn s) (new_irqs s) (new_irqs' s')
+                            \<and> new_ct s = new_ct' s' \<and> new_id s = new_id' s'
+                            \<and> new_ms s = new_ms' s' \<and> new_di s = new_dsi' s'
+                            \<and> new_dl s = new_ds' s' \<and> new_cd s = new_cd' s' \<and> new_dt s = new_dt' s' \<and> new_wuc s = new_wuc' s'"
+             "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
+                       \<Longrightarrow> new_ups s = new_ups' s'"
+             "\<And>s s'. \<lbrakk> P s; P' s'; (s, s') \<in> state_relation \<rbrakk>
+                       \<Longrightarrow> new_cns s = new_cns' s'"
   shows "corres r P P' f g"
 proof -
   have all_ext: "\<And>f f'. (\<forall>p. f p = f' p) = (f = f')"
-    by fastforce
+    by (fastforce intro!: ext)
   have mdb_wp':
     "\<And>ctes. \<lbrace>\<lambda>s. cdt_relation ((\<noteq>) None \<circ> new_caps s) (new_mdb s) ctes\<rbrace>
                 f
             \<lbrace>\<lambda>rv s. \<exists>m ca. (\<forall>p. ca p = ((\<noteq>) None \<circ> caps_of_state s) p) \<and> m = cdt s
                             \<and> cdt_relation ca m ctes\<rbrace>"
-    apply (wp hoare_vcg_ex_lift hoare_vcg_all_lift updates)
+    apply (wp hoare_vcg_ex_lift hoare_vcg_all_lift u)
     apply (subst all_ext)
     apply (simp add: o_def)
     done
@@ -3634,7 +3643,7 @@ proof -
                 f
             \<lbrace>\<lambda>rv s. \<exists>m t. t = cdt_list s \<and> m = cdt s
                             \<and> cdt_list_relation t m ctes\<rbrace>"
-    apply (wp hoare_vcg_ex_lift hoare_vcg_all_lift updates)
+    apply (wp hoare_vcg_ex_lift hoare_vcg_all_lift u)
     apply (simp add: o_def)
     done
   note list_wp = list_wp' [simplified all_ext simp_thms]
@@ -3644,7 +3653,15 @@ proof -
             \<lbrace>\<lambda>rv s. revokable_relation (is_original_cap s) (null_filter (caps_of_state s)) ctes\<rbrace>"
     unfolding revokable_relation_def
     apply (simp only: imp_conv_disj)
-    apply (wp hoare_vcg_ex_lift hoare_vcg_all_lift hoare_vcg_disj_lift updates)
+    apply (wp hoare_vcg_ex_lift hoare_vcg_all_lift hoare_vcg_disj_lift u)
+    done
+  have exs_wp':
+    "\<And>ctes. \<lbrace>\<lambda>s. revokable_relation (new_rvk s) (null_filter (new_caps s)) ctes\<rbrace>
+                f
+            \<lbrace>\<lambda>rv s. revokable_relation (is_original_cap s) (null_filter (caps_of_state s)) ctes\<rbrace>"
+    unfolding revokable_relation_def
+    apply (simp only: imp_conv_disj)
+    apply (wp hoare_vcg_ex_lift hoare_vcg_all_lift hoare_vcg_disj_lift u)
     done
   note rvk_wp = rvk_wp' [simplified all_ext simp_thms]
   have swp_cte_at:
@@ -3653,18 +3670,18 @@ proof -
   have abs_irq_together':
     "\<And>P. \<lbrace>\<lambda>s. P (new_irqn s) (new_irqs s)\<rbrace> f
              \<lbrace>\<lambda>rv s. \<exists>irn. interrupt_irq_node s = irn \<and> P irn (interrupt_states s)\<rbrace>"
-    by (wp hoare_vcg_ex_lift updates, simp)
+    by (wp hoare_vcg_ex_lift u, simp)
   note abs_irq_together = abs_irq_together'[simplified]
   show ?thesis
     unfolding state_relation_def swp_cte_at
-    apply (rule corres_underlying_decomposition[OF pspace_corres])
+    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 (wp hoare_vcg_conj_lift mdb_wp rvk_wp list_wp updates abs_irq_together)
-    apply (wpsimp wp: hoare_vcg_conj_lift updates simp: swp_cte_at)
-    apply (frule updated_relations)
-      apply fastforce
-     apply (fastforce simp: state_relation_def swp_cte_at)
-    apply (clarsimp simp: o_def)
+     apply (wp hoare_vcg_conj_lift mdb_wp rvk_wp list_wp u abs_irq_together)+
+    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))+
     done
 qed
 
@@ -3676,7 +3693,7 @@ lemma getCTE_symb_exec_r:
   done
 
 lemma updateMDB_symb_exec_r:
-  "corres_underlying {(s, s'). pspace_relation (kheap s) (ksPSpace s')} False nf' dc
+  "corres_underlying {(s, s'). pspace_relations (ekheap s) (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]
@@ -3696,6 +3713,9 @@ lemma updateMDB_ctes_of_cases:
   apply (case_tac y, simp)
   done
 
+crunch updateMDB
+  for ct[wp]: "\<lambda>s. P (ksCurThread s)"
+
 lemma setCTE_state_bits[wp]:
   "\<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> setCTE p v \<lbrace>\<lambda>rv s. P (ksMachineState s)\<rbrace>"
   "\<lbrace>\<lambda>s. Q (ksIdleThread s)\<rbrace> setCTE p v \<lbrace>\<lambda>rv s. Q (ksIdleThread s)\<rbrace>"
@@ -3705,6 +3725,15 @@ lemma setCTE_state_bits[wp]:
   apply (wp updateObject_cte_inv | simp)+
   done
 
+crunch updateMDB
+  for ms'[wp]: "\<lambda>s. P (ksMachineState s)"
+crunch updateMDB
+  for idle'[wp]: "\<lambda>s. P (ksIdleThread s)"
+crunch updateMDB
+  for arch'[wp]: "\<lambda>s. P (ksArchState s)"
+crunch updateMDB
+  for int'[wp]: "\<lambda>s. P (ksInterruptState s)"
+
 lemma cte_map_eq_subst:
   "\<lbrakk> cte_at p s; cte_at p' s; valid_objs s; pspace_aligned s; pspace_distinct s \<rbrakk>
      \<Longrightarrow> (cte_map p = cte_map p') = (p = p')"
@@ -3728,9 +3757,21 @@ lemma setCTE_gsCNodes[wp]:
   done
 
 lemma set_original_symb_exec_l':
-  "corres_underlying {(s, s'). f (kheap s) s'} False nf' dc P P' (set_original p b) (return x)"
+  "corres_underlying {(s, s'). f (ekheap s) (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)
 
+lemma setCTE_schedule_index[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setCTE p v \<lbrace>\<lambda>rv s. P (ksDomScheduleIdx s)\<rbrace>"
+  apply (simp add: setCTE_def setObject_def split_def)
+  apply (wp updateObject_cte_inv crunch_wps | simp)+
+  done
+
+lemma setCTE_schedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> setCTE p v \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
+  apply (simp add: setCTE_def setObject_def split_def)
+  apply (wp updateObject_cte_inv crunch_wps | simp)+
+  done
+
 lemma setCTE_domain_time[wp]:
   "\<lbrace>\<lambda>s. P (ksDomainTime s)\<rbrace> setCTE p v \<lbrace>\<lambda>rv s. P (ksDomainTime s)\<rbrace>"
   apply (simp add: setCTE_def setObject_def split_def)
@@ -3743,6 +3784,78 @@ lemma setCTE_work_units_completed[wp]:
   apply (wp updateObject_cte_inv crunch_wps | simp)+
   done
 
+lemma create_reply_master_corres:
+  "\<lbrakk> sl' = cte_map sl ; AllowGrant \<in> rights \<rbrakk> \<Longrightarrow>
+   corres dc
+      (cte_wp_at ((=) cap.NullCap) sl and valid_pspace and valid_mdb and valid_list)
+      (cte_wp_at' (\<lambda>c. cteCap c = NullCap \<and> mdbPrev (cteMDBNode c) = 0) sl'
+       and valid_mdb' and valid_pspace')
+      (do
+         y \<leftarrow> set_original sl True;
+         set_cap (cap.ReplyCap thread True rights) sl
+       od)
+      (setCTE sl' (CTE (capability.ReplyCap thread True True) initMDBNode))"
+  apply clarsimp
+  apply (rule corres_caps_decomposition)
+                                 defer
+                                 apply (wp|simp add: o_def split del: if_splits)+
+          apply (clarsimp simp: o_def cdt_relation_def cte_wp_at_ctes_of
+                     split del: if_split cong: if_cong simp del: id_apply)
+          apply (case_tac cte, clarsimp)
+          apply (fold fun_upd_def)
+          apply (subst descendants_of_Null_update')
+               apply fastforce
+              apply fastforce
+             apply assumption
+            apply assumption
+           apply (simp add: nullPointer_def)
+          apply (subgoal_tac "cte_at (a, b) s")
+           prefer 2
+           apply (drule not_sym, clarsimp simp: cte_wp_at_caps_of_state
+                                         split: if_split_asm)
+          apply (simp add: state_relation_def cdt_relation_def)
+         apply (clarsimp simp: o_def cdt_list_relation_def cte_wp_at_ctes_of
+                    split del: if_split cong: if_cong simp del: id_apply)
+         apply (case_tac cte, clarsimp)
+         apply (clarsimp simp: state_relation_def cdt_list_relation_def)
+         apply (simp split: if_split_asm)
+         apply (erule_tac x=a in allE, erule_tac x=b in allE)
+         apply clarsimp
+         apply(case_tac "next_slot (a, b) (cdt_list s) (cdt s)")
+          apply(simp)
+         apply(simp)
+         apply(fastforce simp: valid_mdb'_def valid_mdb_ctes_def valid_nullcaps_def)
+        apply (clarsimp simp: state_relation_def)
+       apply (clarsimp simp: state_relation_def)
+      apply (clarsimp simp add: revokable_relation_def cte_wp_at_ctes_of
+                     split del: if_split)
+      apply simp
+      apply (rule conjI)
+       apply (clarsimp simp: initMDBNode_def)
+      apply clarsimp
+      apply (subgoal_tac "null_filter (caps_of_state s) (a, b) \<noteq> None")
+       prefer 2
+       apply (clarsimp simp: null_filter_def cte_wp_at_caps_of_state
+                      split: if_split_asm)
+      apply (subgoal_tac "cte_at (a,b) s")
+       prefer 2
+       apply clarsimp
+       apply (drule null_filter_caps_of_stateD)
+       apply (erule cte_wp_cte_at)
+      apply (clarsimp split: if_split_asm cong: conj_cong
+                       simp: cte_map_eq_subst revokable_relation_simp
+                             cte_wp_at_cte_at valid_pspace_def)
+     apply (clarsimp simp: state_relation_def)
+    apply (clarsimp elim!: state_relationE simp: ghost_relation_of_heap)+
+  apply (rule corres_guard_imp)
+    apply (rule corres_underlying_symb_exec_l [OF set_original_symb_exec_l'])
+     apply (rule setCTE_corres)
+     apply simp
+    apply wp
+   apply (clarsimp simp: cte_wp_at_cte_at valid_pspace_def)
+  apply (clarsimp simp: valid_pspace'_def cte_wp_at'_def)
+  done
+
 lemma cte_map_nat_to_cref:
   "\<lbrakk> n < 2 ^ b; b < word_bits \<rbrakk> \<Longrightarrow>
    cte_map (p, nat_to_cref b n) = p + (of_nat n * 2^cte_level_bits)"
@@ -3785,16 +3898,222 @@ lemma valid_nullcaps_next:
   apply clarsimp
   done
 
+defs noReplyCapsFor_def:
+  "noReplyCapsFor \<equiv> \<lambda>t s. \<forall>sl m r. \<not> cte_wp_at' (\<lambda>cte. cteCap cte = ReplyCap t m r) sl s"
+
+lemma pspace_relation_no_reply_caps:
+  assumes pspace: "pspace_relation (kheap s) (ksPSpace s')"
+  and       invs: "invs s"
+  and        tcb: "tcb_at t s"
+  and     m_cte': "cte_wp_at' ((=) cte) sl' s'"
+  and     m_null: "cteCap cte = capability.NullCap"
+  and       m_sl: "sl' = cte_map (t, tcb_cnode_index 2)"
+  shows           "noReplyCapsFor t s'"
+proof -
+  from tcb have m_cte: "cte_at (t, tcb_cnode_index 2) s"
+    by (clarsimp elim!: tcb_at_cte_at)
+  have m_cte_null:
+    "cte_wp_at (\<lambda>c. c = cap.NullCap) (t, tcb_cnode_index 2) s"
+    using pspace invs
+    apply (frule_tac pspace_relation_cte_wp_atI')
+      apply (rule assms)
+     apply clarsimp
+    apply (clarsimp simp: m_sl)
+    apply (frule cte_map_inj_eq)
+         apply (rule m_cte)
+        apply (erule cte_wp_cte_at)
+       apply clarsimp+
+    apply (clarsimp elim!: cte_wp_at_weakenE simp: m_null)
+    done
+  have no_reply_caps:
+    "\<forall>sl m r. \<not> cte_wp_at (\<lambda>c. c = cap.ReplyCap t m r) sl s"
+    by (rule no_reply_caps_for_thread [OF invs tcb m_cte_null])
+  hence noReplyCaps:
+    "\<forall>sl m r. \<not> cte_wp_at' (\<lambda>cte. cteCap cte = ReplyCap t m r) sl s'"
+    apply (intro allI)
+    apply (clarsimp simp: cte_wp_at_neg2 cte_wp_at_ctes_of simp del: split_paired_All)
+    apply (frule pspace_relation_cte_wp_atI [OF pspace _ invs_valid_objs [OF invs]])
+    apply (clarsimp simp: cte_wp_at_neg2 simp del: split_paired_All)
+    apply (drule_tac x="(a, b)" in spec)
+    apply (clarsimp simp: cte_wp_cte_at cte_wp_at_caps_of_state)
+    apply (case_tac c, simp_all)
+    apply fastforce
+    done
+  thus ?thesis
+    by (simp add: noReplyCapsFor_def)
+qed
+
+lemma setupReplyMaster_corres:
+  "corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
+       (setup_reply_master t) (setupReplyMaster t)"
+  apply (simp add: setupReplyMaster_def setup_reply_master_def)
+  apply (simp add: locateSlot_conv tcbReplySlot_def objBits_def objBitsKO_def)
+  apply (simp add: nullMDBNode_def, fold initMDBNode_def)
+  apply (rule_tac F="t + 2*2^cte_level_bits = cte_map (t, tcb_cnode_index 2)" in corres_req)
+   apply (clarsimp simp: tcb_cnode_index_def2 cte_map_nat_to_cref word_bits_def cte_level_bits_def)
+  apply (clarsimp simp: cte_level_bits_def)
+  apply (rule stronger_corres_guard_imp)
+    apply (rule corres_split[OF get_cap_corres])
+      apply (rule corres_when)
+       apply fastforce
+      apply (rule_tac P'="einvs and tcb_at t" in corres_stateAssert_implied)
+       apply (rule create_reply_master_corres; simp)
+      apply (subgoal_tac "\<exists>cte. cte_wp_at' ((=) cte) (cte_map (t, tcb_cnode_index 2)) s'
+                              \<and> cteCap cte = capability.NullCap")
+       apply (fastforce dest: pspace_relation_no_reply_caps
+                             state_relation_pspace_relation)
+      apply (clarsimp simp: cte_map_def tcb_cnode_index_def cte_wp_at_ctes_of)
+     apply (rule_tac Q'="\<lambda>rv. einvs and tcb_at t and
+                             cte_wp_at ((=) rv) (t, tcb_cnode_index 2)"
+                  in hoare_strengthen_post)
+      apply (wp hoare_drop_imps get_cap_wp)
+     apply (clarsimp simp: invs_def valid_state_def elim!: cte_wp_at_weakenE)
+    apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_mdb' and
+                            cte_wp_at' ((=) rv) (cte_map (t, tcb_cnode_index 2))"
+                 in hoare_strengthen_post)
+     apply (wp hoare_drop_imps getCTE_wp')
+    apply (rename_tac rv s)
+    apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def)
+    apply (case_tac rv, fastforce elim: valid_nullcapsE)
+   apply (fastforce elim: tcb_at_cte_at)
+  apply (clarsimp simp: cte_at'_obj_at' tcb_cte_cases_def cte_map_def)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+  done
+
+crunch setupReplyMaster
+  for tcb'[wp]: "tcb_at' t"
+  (wp: crunch_wps)
+
+crunch setupReplyMaster
+  for idle'[wp]: "valid_idle'"
+
 (* Levity: added (20090126 19:32:14) *)
 declare stateAssert_wp[wp]
 
+lemma setupReplyMaster_valid_mdb:
+  "slot = t + 2 ^ objBits (undefined :: cte) * tcbReplySlot \<Longrightarrow>
+   \<lbrace>valid_mdb' and valid_pspace' and tcb_at' t\<rbrace>
+   setupReplyMaster t
+   \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
+  apply (clarsimp simp: setupReplyMaster_def locateSlot_conv
+                        nullMDBNode_def)
+  apply (fold initMDBNode_def)
+  apply (wp setCTE_valid_mdb getCTE_wp')
+  apply clarsimp
+  apply (intro conjI)
+      apply (case_tac cte)
+      apply (fastforce simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def
+                            no_mdb_def
+                      elim: valid_nullcapsE)
+     apply (frule obj_at_aligned')
+      apply (simp add: valid_cap'_def capAligned_def
+                       objBits_simps' word_bits_def)+
+    apply (clarsimp simp: valid_pspace'_def)
+   apply (clarsimp simp: caps_no_overlap'_def capRange_def)
+  apply (clarsimp simp: fresh_virt_cap_class_def
+                 elim!: ranE)
+  apply (clarsimp simp add: noReplyCapsFor_def cte_wp_at_ctes_of)
+  apply (case_tac x)
+  apply (rename_tac capability mdbnode)
+  apply (case_tac capability; simp)
+   apply (rename_tac arch_capability)
+   apply (case_tac arch_capability; simp)
+  apply fastforce
+  done
+
+lemma setupReplyMaster_valid_objs [wp]:
+  "\<lbrace> valid_objs' and pspace_aligned' and pspace_distinct' and tcb_at' t\<rbrace>
+  setupReplyMaster t
+  \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (simp add: setupReplyMaster_def locateSlot_conv)
+  apply (wp setCTE_valid_objs getCTE_wp')
+  apply (clarsimp)
+  apply (frule obj_at_aligned')
+   apply (simp add: valid_cap'_def capAligned_def
+                    objBits_simps' word_bits_def)+
+  done
+
+lemma setupReplyMaster_wps[wp]:
+  "\<lbrace>pspace_aligned'\<rbrace> setupReplyMaster t \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
+  "\<lbrace>pspace_distinct'\<rbrace> setupReplyMaster t \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
+  "slot = cte_map (t, tcb_cnode_index 2) \<Longrightarrow>
+   \<lbrace>\<lambda>s. P ((cteCaps_of s)(slot \<mapsto> (capability.ReplyCap t True True))) \<and> P (cteCaps_of s)\<rbrace>
+      setupReplyMaster t
+   \<lbrace>\<lambda>rv s. P (cteCaps_of s)\<rbrace>"
+  apply (simp_all add: setupReplyMaster_def locateSlot_conv)
+    apply (wp getCTE_wp | simp add: o_def cte_wp_at_ctes_of)+
+  apply clarsimp
+  apply (rule_tac x=cte in exI)
+  apply (clarsimp simp: tcbReplySlot_def objBits_simps' fun_upd_def word_bits_def
+                        tcb_cnode_index_def2 cte_map_nat_to_cref cte_level_bits_def)
+  done
+
+crunch setupReplyMaster
+  for no_0_obj'[wp]: no_0_obj'
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma setupReplyMaster_valid_pspace':
+  "\<lbrace>valid_pspace' and tcb_at' t\<rbrace>
+     setupReplyMaster t
+   \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
+  apply (simp add: valid_pspace'_def)
+  apply (wp setupReplyMaster_valid_mdb)
+   apply (simp_all add: valid_pspace'_def)
+  done
+
+lemma setupReplyMaster_ifunsafe'[wp]:
+  "slot = t + 2 ^ objBits (undefined :: cte) * tcbReplySlot \<Longrightarrow>
+   \<lbrace>if_unsafe_then_cap' and ex_cte_cap_to' slot\<rbrace>
+     setupReplyMaster t
+   \<lbrace>\<lambda>rv s. if_unsafe_then_cap' s\<rbrace>"
+  apply (simp add: ifunsafe'_def3 setupReplyMaster_def locateSlot_conv)
+  apply (wp getCTE_wp')
+  apply (clarsimp simp: ex_cte_cap_to'_def cte_wp_at_ctes_of cteCaps_of_def
+                        cte_level_bits_def objBits_simps')
+  apply (drule_tac x=crefa in spec)
+  apply (rule conjI)
+   apply clarsimp
+   apply (rule_tac x=cref in exI, fastforce)
+  apply clarsimp
+  apply (rule_tac x=cref' in exI, fastforce)
+  done
+
+
+lemma setupReplyMaster_iflive'[wp]:
+  "\<lbrace>if_live_then_nonz_cap'\<rbrace> setupReplyMaster t \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
+  apply (simp add: setupReplyMaster_def locateSlot_conv)
+  apply (wp setCTE_iflive' getCTE_wp')
+  apply (clarsimp elim!: cte_wp_at_weakenE')
+  done
+
+lemma setupReplyMaster_global_refs[wp]:
+  "\<lbrace>\<lambda>s. valid_global_refs' s \<and> thread \<notin> global_refs' s \<and> tcb_at' thread s
+      \<and> ex_nonz_cap_to' thread s \<and> valid_objs' s\<rbrace>
+    setupReplyMaster thread
+   \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
+  apply (simp add: setupReplyMaster_def locateSlot_conv)
+  apply (wp getCTE_wp')
+  apply (clarsimp simp: capRange_def cte_wp_at_ctes_of objBits_simps)
+  apply (clarsimp simp: ex_nonz_cap_to'_def cte_wp_at_ctes_of)
+  apply (rename_tac "prev_cte")
+  apply (case_tac prev_cte, simp)
+  apply (frule(1) ctes_of_valid_cap')
+  apply (drule(1) valid_global_refsD_with_objSize)+
+  apply (clarsimp simp: valid_cap'_def objBits_simps obj_at'_def projectKOs
+                 split: capability.split_asm)
+  done
+
+crunch setupReplyMaster
+  for valid_arch'[wp]: "valid_arch_state'"
+  (wp: crunch_wps simp: crunch_simps)
+
 lemma ex_nonz_tcb_cte_caps':
   "\<lbrakk>ex_nonz_cap_to' t s; tcb_at' t s; valid_objs' s; sl \<in> dom tcb_cte_cases\<rbrakk> \<Longrightarrow>
    ex_cte_cap_to' (t + sl) s"
   apply (clarsimp simp: ex_nonz_cap_to'_def ex_cte_cap_to'_def cte_wp_at_ctes_of)
   apply (subgoal_tac "s \<turnstile>' cteCap cte")
    apply (rule_tac x=cref in exI, rule_tac x=cte in exI)
-   apply (clarsimp simp: valid_cap'_def obj_at'_def projectKOs dom_def ko_wp_at'_def
+   apply (clarsimp simp: valid_cap'_def obj_at'_def projectKOs dom_def
                   split: cte.split_asm capability.split_asm)
   apply (case_tac cte)
   apply (clarsimp simp: ctes_of_valid_cap')
@@ -3815,6 +4134,10 @@ lemma ex_nonz_cap_not_global':
   apply (clarsimp simp: ctes_of_valid_cap')
   done
 
+crunch setupReplyMaster
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps simp: crunch_simps)
+
 lemma setCTE_irq_handlers':
   "\<lbrace>\<lambda>s. valid_irq_handlers' s \<and> (\<forall>irq. cteCap cte = IRQHandlerCap irq \<longrightarrow> irq_issued' irq s)\<rbrace>
      setCTE ptr cte
@@ -3824,13 +4147,100 @@ lemma setCTE_irq_handlers':
   apply (auto simp: ran_def)
   done
 
+lemma setupReplyMaster_irq_handlers'[wp]:
+  "\<lbrace>valid_irq_handlers'\<rbrace> setupReplyMaster t \<lbrace>\<lambda>rv. valid_irq_handlers'\<rbrace>"
+  apply (simp add: setupReplyMaster_def locateSlot_conv)
+  apply (wp setCTE_irq_handlers' getCTE_wp)
+  apply (clarsimp simp: cte_wp_at_ctes_of)
+  done
+
+crunch setupReplyMaster
+  for irq_states'[wp]: valid_irq_states'
+  and irqs_masked' [wp]: irqs_masked'
+  and pde_mappings' [wp]: valid_pde_mappings'
+  and pred_tcb_at' [wp]: "pred_tcb_at' proj P t"
+  and ksMachine[wp]: "\<lambda>s. P (ksMachineState s)"
+  and pspace_domain_valid[wp]: "pspace_domain_valid"
+  and ct_not_inQ[wp]: "ct_not_inQ"
+  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
+  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
+  and ksIdlethread[wp]: "\<lambda>s. P (ksIdleThread s)"
+  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
+  and scheduler_action[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  and obj_at'_inQ[wp]: "obj_at' (inQ d p) t"
+  and tcbDomain_inv[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
+  and tcbPriority_inv[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
+  and ready_queues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ready_queuesL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  and ready_queuesL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  and tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: crunch_wps simp: crunch_simps rule: irqs_masked_lift)
+
+lemma setupReplyMaster_vms'[wp]:
+  "\<lbrace>valid_machine_state'\<rbrace> setupReplyMaster t \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
+  apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def )
+  apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift)
+  apply wp+
+  done
+
+lemma setupReplyMaster_urz[wp]:
+  "\<lbrace>untyped_ranges_zero' and valid_mdb' and valid_objs'\<rbrace>
+    setupReplyMaster t
+  \<lbrace>\<lambda>rv. untyped_ranges_zero'\<rbrace>"
+  apply (simp add: setupReplyMaster_def locateSlot_conv)
+  apply (rule hoare_pre)
+   apply (wp untyped_ranges_zero_lift getCTE_wp' | simp)+
+  apply (clarsimp simp: cte_wp_at_ctes_of fun_upd_def[symmetric])
+  apply (subst untyped_ranges_zero_fun_upd, assumption, simp_all)
+  apply (clarsimp simp: cteCaps_of_def untypedZeroRange_def Let_def isCap_simps)
+  done
+
+lemma setupReplyMaster_invs'[wp]:
+  "\<lbrace>invs' and tcb_at' t and ex_nonz_cap_to' t\<rbrace>
+     setupReplyMaster t
+   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def)
+  apply (rule hoare_pre)
+   apply (wp setupReplyMaster_valid_pspace' sch_act_wf_lift tcb_in_cur_domain'_lift ct_idle_or_in_cur_domain'_lift
+             valid_queues_lift cur_tcb_lift hoare_vcg_disj_lift sym_heap_sched_pointers_lift
+             valid_bitmaps_lift
+             valid_irq_node_lift | simp)+
+  apply (clarsimp simp: ex_nonz_tcb_cte_caps' valid_pspace'_def
+                        objBits_simps' tcbReplySlot_def
+                        ex_nonz_cap_not_global' dom_def)
+  done
+
+lemma setupReplyMaster_cte_wp_at'':
+  "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p and K (\<not> P NullCap)\<rbrace>
+     setupReplyMaster t
+   \<lbrace>\<lambda>rv s. cte_wp_at' (P \<circ> cteCap) p s\<rbrace>"
+  apply (simp add: setupReplyMaster_def locateSlot_conv tree_cte_cteCap_eq)
+  apply (wp getCTE_wp')
+  apply (fastforce simp: cte_wp_at_ctes_of cteCaps_of_def)
+  done
+
+lemmas setupReplyMaster_cte_wp_at' = setupReplyMaster_cte_wp_at''[unfolded o_def]
+
+lemma setupReplyMaster_cap_to'[wp]:
+  "\<lbrace>ex_nonz_cap_to' p\<rbrace> setupReplyMaster t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
+  apply (simp add: ex_nonz_cap_to'_def)
+  apply (rule hoare_pre)
+   apply (wp hoare_vcg_ex_lift setupReplyMaster_cte_wp_at')
+  apply clarsimp
+  done
+
 definition
   is_arch_update' :: "capability \<Rightarrow> cte \<Rightarrow> bool"
 where
   "is_arch_update' cap cte \<equiv> isArchObjectCap cap \<and> capMasterCap cap = capMasterCap (cteCap cte)"
 
 lemma mdb_next_pres:
-  "\<lbrakk> m p = Some v; mdbNext (cteMDBNode x) = mdbNext (cteMDBNode v) \<rbrakk> \<Longrightarrow>
+  "\<lbrakk> m p = Some v;
+ mdbNext (cteMDBNode x) = mdbNext (cteMDBNode v) \<rbrakk> \<Longrightarrow>
   m(p \<mapsto> x) \<turnstile> a \<leadsto> b = m \<turnstile> a \<leadsto> b"
   by (simp add: mdb_next_unfold)
 
@@ -3980,6 +4390,8 @@ lemma arch_update_setCTE_mdb:
    apply (clarsimp simp: is_arch_update'_def isCap_simps)
   apply (rule conjI)
    apply clarsimp
+  apply (simp add: reply_masters_rvk_fb_def)
+  apply (erule ball_ran_fun_updI)
   apply (clarsimp simp add: is_arch_update'_def isCap_simps)
   done
 
@@ -4052,15 +4464,13 @@ lemma arch_update_setCTE_invs:
   "\<lbrace>cte_wp_at' (is_arch_update' cap) p and cte_wp_at' ((=) oldcte) p and invs' and valid_cap' cap\<rbrace>
   setCTE p (cteCap_update (\<lambda>_. cap) oldcte)
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
-  apply (wp arch_update_setCTE_mdb valid_queues_lift sch_act_wf_lift tcb_in_cur_domain'_lift
-            ct_idle_or_in_cur_domain'_lift
-            arch_update_setCTE_iflive arch_update_setCTE_ifunsafe
-            valid_irq_node_lift setCTE_typ_at' setCTE_irq_handlers'
-            valid_queues_lift' setCTE_pred_tcb_at' irqs_masked_lift
-            setCTE_norq hoare_vcg_disj_lift untyped_ranges_zero_lift valid_replies'_lift
-          | simp add: pred_tcb_at'_def)+
-  apply (subst fold_list_refs_of_replies')
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
+  apply (wp arch_update_setCTE_mdb valid_queues_lift sch_act_wf_lift tcb_in_cur_domain'_lift ct_idle_or_in_cur_domain'_lift
+             arch_update_setCTE_iflive arch_update_setCTE_ifunsafe
+             valid_irq_node_lift setCTE_typ_at' setCTE_irq_handlers'
+             setCTE_pred_tcb_at' irqs_masked_lift
+             hoare_vcg_disj_lift untyped_ranges_zero_lift valid_bitmaps_lift
+           | simp add: pred_tcb_at'_def)+
   apply (clarsimp simp: valid_global_refs'_def is_arch_update'_def fun_upd_def[symmetric]
                         cte_wp_at_ctes_of isCap_simps untyped_ranges_zero_fun_upd)
   apply (frule capMaster_eq_capBits_eq)
@@ -4104,7 +4514,7 @@ locale mdb_insert_simple = mdb_insert +
   assumes safe_parent: "safe_parent_for' m src c'"
   assumes simple: "is_simple_cap' c'"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 lemma dest_no_parent_n:
   "n \<turnstile> dest \<rightarrow> p = False"
   using src simple safe_parent
@@ -4294,7 +4704,7 @@ lemma maskedAsFull_revokable_safe_parent:
      apply (clarsimp simp:isCap_simps is_simple_cap'_def)+
 done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma cteInsert_simple_corres:
   assumes "cap_relation c c'" "src' = cte_map src" "dest' = cte_map dest"
   notes trans_state_update'[symmetric,simp]
@@ -4344,8 +4754,6 @@ lemma cteInsert_simple_corres:
            and (\<lambda>s. safe_parent_for' (ctes_of s) src' c')"
                         in corres_split[where r'=dc])
              apply (rule setUntypedCapAsFull_corres; simp)
-
-
             apply (rule corres_stronger_no_failI)
              apply (rule no_fail_pre, wp hoare_weak_lift_imp)
              apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def)
@@ -4353,8 +4761,8 @@ 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 (22) set_cap_not_quite_corres)
-              apply fastforce
+            apply (drule (1) pspace_relationsD)
+            apply (drule (18) set_cap_not_quite_corres)
              apply (rule refl)
             apply (elim conjE exE)
             apply (rule bind_execI, assumption)
@@ -4380,6 +4788,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 (thin_tac "gsCNodes t = p" for t p)+
             apply (thin_tac "ksMachineState t = p" for t p)+
             apply (thin_tac "ksCurThread t = p" for t p)+
@@ -4404,22 +4813,20 @@ 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)+
             apply (thin_tac "ready_queues_relation t p" for t p)+
-            apply clarsimp
             apply (rule conjI)
              subgoal by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def)
             apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def prev_update_modify_mdb_relation)
             apply (subgoal_tac "cte_map dest \<noteq> 0")
              prefer 2
-             apply (clarsimp simp: valid_mdb'_def
-                                   valid_mdb_ctes_def no_0_def)
+             apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
             apply (subgoal_tac "cte_map src \<noteq> 0")
              prefer 2
-             apply (clarsimp simp: valid_mdb'_def
-                                   valid_mdb_ctes_def no_0_def)
+             apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
             apply (subgoal_tac "should_be_parent_of src_cap (is_original_cap a src) c (revokable src_cap c) = True")
              prefer 2
              apply (subst should_be_parent_of_masked_as_full[symmetric])
@@ -4468,10 +4875,10 @@ lemma cteInsert_simple_corres:
              apply (subgoal_tac "cte_map (aa,bb) \<noteq> cte_map dest")
               subgoal by (clarsimp simp: modify_map_def split: if_split_asm)
              apply (erule (5) cte_map_inj)
-
-            apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb set_untyped_cap_as_full_valid_list
-               set_untyped_cap_as_full_cte_wp_at setUntypedCapAsFull_valid_cap
-               setUntypedCapAsFull_cte_wp_at setUntypedCapAsFull_safe_parent_for' | clarsimp | wps)+
+            apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb
+                      set_untyped_cap_as_full_valid_list set_untyped_cap_as_full_cte_wp_at
+                      setUntypedCapAsFull_valid_cap setUntypedCapAsFull_cte_wp_at setUntypedCapAsFull_safe_parent_for'
+                   | clarsimp | wps)+
           apply (clarsimp simp:cte_wp_at_caps_of_state )
          apply (case_tac rv',clarsimp simp:cte_wp_at_ctes_of maskedAsFull_def)
         apply (wp getCTE_wp' get_cap_wp)+
@@ -4519,7 +4926,7 @@ lemma cteInsert_simple_corres:
    apply clarsimp
    apply (drule (5) cte_map_inj)+
    apply simp
-    (* exact reproduction of proof in cteInsert_corres,
+  (* exact reproduction of proof in cteInsert_corres,
      as it does not used is_derived *)
   apply(simp add: cdt_list_relation_def del: split_paired_All split_paired_Ex)
   apply(subgoal_tac "no_mloop (cdt a) \<and> finite_depth (cdt a)")
@@ -4677,7 +5084,7 @@ locale mdb_insert_simple' = mdb_insert_simple +
   fixes n'
   defines  "n' \<equiv> modify_map n (mdbNext src_node) (cteMDBNode_update (mdbPrev_update (\<lambda>_. dest)))"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 lemma no_0_n' [intro!]: "no_0 n'" by (auto simp: n'_def)
 lemmas n_0_simps' [iff] = no_0_simps [OF no_0_n']
 
@@ -5335,13 +5742,28 @@ lemma irq' [simp]:
   apply (erule (1) irq_controlD, rule irq_control)
   done
 
+lemma reply_masters_rvk_fb:
+  "reply_masters_rvk_fb m"
+  using valid by (simp add: valid_mdb_ctes_def)
+
+lemma reply_masters_rvk_fb' [simp]:
+  "reply_masters_rvk_fb n'"
+   using reply_masters_rvk_fb simple
+   apply (simp add: reply_masters_rvk_fb_def n'_def
+                    n_def ball_ran_modify_map_eq)
+   apply (subst ball_ran_modify_map_eq)
+    apply (clarsimp simp: modify_map_def m_p is_simple_cap'_def)
+   apply (simp add: ball_ran_modify_map_eq m_p is_simple_cap'_def
+                    dest_cap isCap_simps)
+   done
+
 lemma mdb:
   "valid_mdb_ctes n'"
   by (simp add: valid_mdb_ctes_def no_0_n' chain_n')
 
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma cteInsert_simple_mdb':
   "\<lbrace>valid_mdb' and pspace_aligned' and pspace_distinct' and (\<lambda>s. src \<noteq> dest) and K (capAligned cap) and
     (\<lambda>s. safe_parent_for' (ctes_of s) src cap) and K (is_simple_cap' cap) \<rbrace>
@@ -5400,13 +5822,12 @@ lemma cteInsert_simple_invs:
   cteInsert cap src dest
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (rule hoare_pre)
-   apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
+   apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
    apply (wp cur_tcb_lift sch_act_wf_lift valid_queues_lift tcb_in_cur_domain'_lift
-             valid_irq_node_lift valid_queues_lift' valid_release_queue_lift
-             valid_release_queue'_lift irqs_masked_lift cteInsert_simple_mdb'
-             cteInsert_valid_globals_simple cteInsert_norq | simp add: pred_tcb_at'_def)+
-   apply (subst fold_list_refs_of_replies')
-  apply (auto simp: invs'_def valid_pspace'_def valid_dom_schedule'_def
+             valid_irq_node_lift irqs_masked_lift sym_heap_sched_pointers_lift
+             cteInsert_simple_mdb' cteInsert_valid_globals_simple
+             cteInsert_norq | simp add: pred_tcb_at'_def)+
+  apply (auto simp: invs'_def valid_state'_def valid_pspace'_def
                     is_simple_cap'_def untyped_derived_eq_def o_def
               elim: valid_capAligned)
   done
@@ -5542,35 +5963,26 @@ lemma arch_update_updateCap_invs:
   apply clarsimp
   done
 
-lemma setCTE_set_cap_sc_replies_relation_valid_corres:
-  assumes pre: "sc_replies_relation s s'"
-      and step_abs: "(x, t) \<in> fst (set_cap cap slot s)"
-      and step_conc: "(y, t') \<in> fst (setCTE slot' cap' s')"
-  shows "sc_replies_relation t t'"
-  using pre unfolding sc_replies_relation_def
-  apply clarsimp
-  apply (prop_tac "sc_replies_of t = sc_replies_of s")
-   apply (rule use_valid[OF step_abs set_cap.valid_sched_pred], simp)
-  apply (rule use_valid[OF step_conc setCTE_scs_of'])
-  apply (rule use_valid[OF step_conc setCTE_replies_of'])
-  apply clarsimp
-  done
-
-lemma setCTE_set_cap_release_queue_relation_valid_corres:
-  assumes pre: "release_queue_relation (release_queue s) (ksReleaseQueue s')"
-      and step_abs: "(x, t) \<in> fst (set_cap cap slot s)"
-      and step_conc: "(y, t') \<in> fst (setCTE slot' cap' s')"
-  shows "release_queue_relation (release_queue t)(ksReleaseQueue t')"
-  apply (rule use_valid[OF step_abs set_cap.valid_sched_pred])
-  apply (rule use_valid[OF step_conc setCTE_ksReleaseQueue])
-  apply (rule pre)
-  done
+lemma setCTE_set_cap_ready_queues_relation_valid_corres:
+  assumes pre: "ready_queues_relation s s'"
+  assumes step_abs: "(x, t) \<in> fst (set_cap cap slot s)"
+  assumes step_conc: "(y, t') \<in> fst (setCTE slot' cap' s')"
+  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_conc setCTE_ksReadyQueues])
+  apply (rule use_valid[OF step_conc setCTE_tcbSchedNexts_of])
+  apply (rule use_valid[OF step_conc setCTE_tcbSchedPrevs_of])
+  apply (clarsimp simp: ready_queues_relation_def Let_def)
+  using use_valid[OF step_conc setCTE_inQ_opt_pred]
+  by fast
 
 lemma updateCap_same_master:
   "\<lbrakk> cap_relation cap cap' \<rbrakk> \<Longrightarrow>
    corres dc (valid_objs and pspace_aligned and pspace_distinct and
               cte_wp_at (\<lambda>c. cap_master_cap c = cap_master_cap cap \<and>
-                             \<not>is_reply_cap c \<and>
+                             \<not>is_reply_cap c \<and> \<not>is_master_reply_cap c \<and>
                              \<not>is_ep_cap c \<and> \<not>is_ntfn_cap c) slot)
              (pspace_aligned' and pspace_distinct' and cte_at' (cte_map slot))
      (set_cap cap slot)
@@ -5584,6 +5996,7 @@ 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
@@ -5594,19 +6007,14 @@ lemma updateCap_same_master:
        apply (rule bexI)
         prefer 2
         apply assumption
-       apply clarsimp
-       apply (extract_conjunct \<open>match conclusion in "sc_replies_relation a b" for a b \<Rightarrow> -\<close>)
-        subgoal by (erule setCTE_set_cap_sc_replies_relation_valid_corres; assumption)
-       apply (extract_conjunct \<open>match conclusion in "release_queue_relation a b" for a b \<Rightarrow> -\<close>)
-        subgoal by (erule setCTE_set_cap_release_queue_relation_valid_corres; assumption)
+       apply (clarsimp simp: pspace_relations_def)
        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)
        apply (rule conjI)
         apply (frule setCTE_pspace_only)
-        apply (clarsimp simp: set_cap_def in_monad split_def get_object_def set_object_def)
-        apply (rename_tac obj ps' s'' obj' kobj; case_tac obj;
-               simp add: return_def fail_def split: if_split_asm)
+        apply (clarsimp simp: set_cap_def in_monad split_def get_object_def set_object_def
+                         split: if_split_asm Structures_A.kernel_object.splits)
        apply (rule conjI)
         apply (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def)
         apply (intro allI conjI)
@@ -5623,9 +6031,8 @@ lemma updateCap_same_master:
          prefer 2
          apply (frule setCTE_pspace_only)
          apply clarsimp
-         apply (clarsimp simp: set_cap_def in_monad split_def get_object_def set_object_def)
-        apply (rename_tac obj s'' obj' kobj; case_tac obj;
-               simp add: return_def fail_def split: if_split_asm)
+         apply (clarsimp simp: set_cap_def in_monad split_def get_object_def set_object_def
+                         split: if_split_asm Structures_A.kernel_object.splits)
         apply (frule set_cap_caps_of_state_monad)
         apply (drule is_original_cap_set_cap)
         apply clarsimp
@@ -5667,9 +6074,9 @@ lemma updateCap_same_master:
        apply (subst same_master_descendants)
             apply assumption
            apply (clarsimp simp: master_cap_relation)
-          apply (clarsimp simp: is_reply_cap_relation)
           apply (frule_tac d=c in master_cap_relation [symmetric], assumption)
-          apply (frule is_reply_cap_relation[symmetric])
+          apply (frule is_reply_cap_relation[symmetric],
+                 drule is_reply_master_relation[symmetric])+
           apply simp
           apply (drule masterCap.intro)
           apply (drule masterCap.isReplyCap)
@@ -5787,13 +6194,10 @@ lemma updateFreeIndex_forward_valid_objs':
 
 crunch updateFreeIndex
   for pspace_aligned'[wp]: "pspace_aligned'"
-  and pspace_distinct'[wp]: "pspace_distinct'"
-  and pspace_bounded'[wp]: "pspace_bounded'"
-  and no_0_obj[wp]: "no_0_obj'"
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and pred_tcb_at'[wp]: "pred_tcb_at' proj P p"
-  and valid_replies'[wp]: "valid_replies'"
-  (wp: valid_replies'_lift)
+crunch updateFreeIndex
+  for pspace_distinct'[wp]: "pspace_distinct'"
+crunch updateFreeIndex
+  for no_0_obj[wp]: "no_0_obj'"
 
 lemma updateFreeIndex_forward_valid_mdb':
   "\<lbrace>\<lambda>s. valid_mdb' s \<and> valid_objs' s \<and> cte_wp_at' ((\<lambda>cap. isUntypedCap cap
@@ -5807,7 +6211,7 @@ lemma updateFreeIndex_forward_valid_mdb':
   apply (frule(1) CSpace1_R.ctes_of_valid)
   apply (clarsimp simp: cte_wp_at_ctes_of del: subsetI)
   apply (rule usableUntypedRange_mono2,
-         auto simp add: isCap_simps valid_cap_simps' capAligned_def)
+    auto simp add: isCap_simps valid_cap_simps' capAligned_def)
   done
 
 lemma updateFreeIndex_forward_invs':
@@ -5816,7 +6220,7 @@ lemma updateFreeIndex_forward_invs':
           \<and> is_aligned (of_nat idx :: word32) minUntypedSizeBits) o cteCap) src s\<rbrace>
    updateFreeIndex src idx
    \<lbrace>\<lambda>r s. invs' s\<rbrace>"
-  apply (clarsimp simp: invs'_def valid_dom_schedule'_def)
+  apply (clarsimp simp:invs'_def valid_state'_def)
   apply (rule hoare_pre)
    apply (rule hoare_vcg_conj_lift)
     apply (simp add: valid_pspace'_def, wp updateFreeIndex_forward_valid_objs'
@@ -5825,7 +6229,6 @@ lemma updateFreeIndex_forward_invs':
    apply (wp sch_act_wf_lift valid_queues_lift updateCap_iflive' tcb_in_cur_domain'_lift
             | simp add: pred_tcb_at'_def)+
       apply (rule hoare_vcg_conj_lift)
-
        apply (simp add: ifunsafe'_def3 cteInsert_def setUntypedCapAsFull_def
                split del: if_split)
        apply wp+
@@ -5845,7 +6248,6 @@ lemma updateFreeIndex_forward_invs':
   apply (clarsimp simp: cte_wp_at_ctes_of fun_upd_def[symmetric])
   apply (clarsimp simp: isCap_simps valid_pspace'_def)
   apply (frule(1) valid_global_refsD_with_objSize)
-  apply (subst fold_list_refs_of_replies')
   apply clarsimp
   apply (intro conjI allI impI)
    apply (clarsimp simp: modify_map_def cteCaps_of_def ifunsafe'_def3 split:if_splits)
diff --git a/proof/refine/ARM/Corres.thy b/proof/refine/ARM/Corres.thy
index b566be9c94..85cf77f61a 100644
--- a/proof/refine/ARM/Corres.thy
+++ b/proof/refine/ARM/Corres.thy
@@ -12,23 +12,10 @@ text \<open>Instantiating the corres framework to this particular state relation
 abbreviation
  "corres \<equiv> corres_underlying state_relation False True"
 
-abbreviation
- "cross_rel \<equiv> cross_rel_ul state_relation"
-
-lemmas cross_rel_def = cross_rel_ul_def
-
 abbreviation
  "corresK \<equiv> corres_underlyingK state_relation False True"
 
 abbreviation
   "ex_abs \<equiv> ex_abs_underlying state_relation"
 
-abbreviation "sr_inv P P' f \<equiv> sr_inv_ul state_relation P P' f"
-
-lemmas sr_inv_def = sr_inv_ul_def
-
-lemmas sr_inv_imp = sr_inv_ul_imp[of state_relation]
-
-lemmas sr_inv_bind = sr_inv_ul_bind[where sr=state_relation]
-
 end
diff --git a/proof/refine/ARM/Detype_R.thy b/proof/refine/ARM/Detype_R.thy
index 9a5c89de16..5953bf6341 100644
--- a/proof/refine/ARM/Detype_R.thy
+++ b/proof/refine/ARM/Detype_R.thy
@@ -1,5 +1,4 @@
 (*
- * Copyright 2022, Proofcraft Pty Ltd
  * Copyright 2014, General Dynamics C4 Systems
  *
  * SPDX-License-Identifier: GPL-2.0-only
@@ -9,7 +8,11 @@ theory Detype_R
 imports Retype_R
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
+
+text \<open>Establishing that the invariants are maintained
+        when a region of memory is detyped, that is,
+        removed from the model.\<close>
 
 definition
   "descendants_range_in' S p \<equiv>
@@ -83,18 +86,19 @@ lemma descendants_range_inD':
   done
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma descendants_range'_def2:
   "descendants_range' cap p = descendants_range_in' (capRange cap) p"
   by (simp add: descendants_range_in'_def descendants_range'_def)
 
+
 defs deletionIsSafe_def:
-  "deletionIsSafe \<equiv> \<lambda>ptr bits s. \<forall>p.
-        (ko_wp_at' live' p s \<longrightarrow> p \<notin> {ptr .. ptr + 2 ^ bits - 1})
-        \<and> (p \<in> set (ksReleaseQueue s) \<longrightarrow> obj_at' (runnable' \<circ> tcbState) p s)
-        \<and> (\<forall>ko. ksPSpace s p = Some (KOArch ko) \<and> p \<in> {ptr .. ptr + 2 ^ bits - 1}
-                \<longrightarrow> 6 \<le> bits)"
+  "deletionIsSafe \<equiv> \<lambda>ptr bits s. \<forall>p t m r.
+       (cte_wp_at' (\<lambda>cte. cteCap cte = capability.ReplyCap t m r) p s \<longrightarrow>
+       t \<notin> {ptr .. ptr + 2 ^ bits - 1}) \<and>
+       (\<forall>ko. ksPSpace s p = Some (KOArch ko) \<and> p \<in> {ptr .. ptr + 2 ^ bits - 1}
+        \<longrightarrow> 6 \<le> bits)"
 
 defs deletionIsSafe_delete_locale_def:
   "deletionIsSafe_delete_locale \<equiv> \<lambda>ptr bits s. \<forall>p. ko_wp_at' live' p s \<longrightarrow> p \<notin> {ptr .. ptr + 2 ^ bits - 1}"
@@ -110,17 +114,10 @@ defs cNodePartialOverlap_def:
       \<or> (\<not> {p .. p + 2 ^ (cte_level_bits + n) - 1} \<subseteq> {p. inRange p}
         \<and> \<not> {p .. p + 2 ^ (cte_level_bits + n) - 1} \<subseteq> {p. \<not> inRange p}))"
 
-defs release_q_runnable_asrt_def:
-  "release_q_runnable_asrt \<equiv>
-     \<lambda>s. \<forall>p. p \<in> set (ksReleaseQueue s) \<longrightarrow> obj_at' (runnable' \<circ> tcbState) p s"
-
 (* FIXME: move *)
 lemma deleteObjects_def2:
   "is_aligned ptr bits \<Longrightarrow>
    deleteObjects ptr bits = do
-     stateAssert sym_refs_asrt [];
-     stateAssert valid_idle'_asrt [];
-     stateAssert release_q_runnable_asrt [];
      stateAssert (deletionIsSafe ptr bits) [];
      stateAssert (deletionIsSafe_delete_locale ptr bits) [];
      doMachineOp (freeMemory ptr bits);
@@ -134,7 +131,9 @@ lemma deleteObjects_def2:
      stateAssert ksASIDMapSafe []
    od"
   apply (simp add: deleteObjects_def is_aligned_mask[symmetric] unless_def deleteGhost_def)
-  apply (rule bind_eqI, rule ext)+
+  apply (rule bind_eqI, rule ext)
+  apply (rule bind_eqI, rule ext)
+  apply (rule bind_eqI, rule ext)
   apply (simp add: bind_assoc[symmetric])
   apply (rule bind_cong[rotated], rule refl)
   apply (simp add: bind_assoc modify_modify deleteRange_def gets_modify_def)
@@ -153,9 +152,6 @@ lemma deleteObjects_def2:
 lemma deleteObjects_def3:
   "deleteObjects ptr bits =
    do
-     stateAssert sym_refs_asrt [];
-     stateAssert valid_idle'_asrt [];
-     stateAssert release_q_runnable_asrt [];
      assert (is_aligned ptr bits);
      stateAssert (deletionIsSafe ptr bits) [];
      stateAssert (deletionIsSafe_delete_locale ptr bits) [];
@@ -180,14 +176,11 @@ lemma obj_relation_cuts_in_obj_range:
        kheap s x = Some ko; valid_objs s; pspace_aligned s \<rbrakk> \<Longrightarrow> y \<in> obj_range x ko"
   apply (cases ko, simp_all)
    apply (clarsimp split: if_split_asm)
-    apply (subgoal_tac "cte_at (x, ya) s")
-     apply (drule(2) cte_at_cte_map_in_obj_bits)
-     apply (simp add: obj_range_def)
-    apply (fastforce intro: cte_wp_at_cteI)
-   apply (prop_tac "y = x")
-    apply (meson old.prod.inject singletonD)
-   apply simp
-   apply (frule(1) pspace_alignedD)
+   apply (subgoal_tac "cte_at (x, ya) s")
+    apply (drule(2) cte_at_cte_map_in_obj_bits)
+    apply (simp add: obj_range_def)
+   apply (fastforce intro: cte_wp_at_cteI)
+  apply (frule(1) pspace_alignedD)
   apply (frule valid_obj_sizes, erule ranI)
   apply (rename_tac arch_kernel_obj)
   apply (case_tac arch_kernel_obj, simp_all)
@@ -396,7 +389,7 @@ lemma cte_wp_at_delete':
               del: atLeastAtMost_iff)
   apply (simp add: objBits_simps)
   apply (frule(1) tcb_cte_cases_aligned_helpers)
-  apply (simp)
+  apply (simp add: is_aligned_neg_mask_eq)
   done
 
 lemma map_to_ctes_delete:
@@ -437,9 +430,9 @@ next
     apply (subst card_Un_disjoint; simp)
      apply (clarsimp simp: field_simps)
     apply (subst suc)
-    apply (erule word_plus_mono_right2)
+     apply (erule word_plus_mono_right2)
      apply (simp add: field_simps)
-     apply simp
+    apply simp
     apply (simp add: unatSuc)
     done
 qed
@@ -448,321 +441,94 @@ end
 
 locale detype_locale' = detype_locale + constrains s::"det_state"
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-text \<open>Invariant preservation across concrete deletion\<close>
-
-lemma caps_containedD':
-  "\<lbrakk> ctes_of s p = Some cte; ctes_of s p' = Some cte';
-     \<not> isUntypedCap (cteCap cte); capRange (cteCap cte) \<inter> untypedRange (cteCap cte') \<noteq> {};
-     caps_contained' (ctes_of s) \<rbrakk> \<Longrightarrow>
-     capRange (cteCap cte) \<subseteq> untypedRange (cteCap cte')"
-  apply (cases cte, cases cte')
-  apply (simp add: caps_contained'_def)
-  apply blast
-  done
-
-lemma untyped_mdbD':
-  "\<lbrakk> ctes p = Some cte; ctes p' = Some cte';
-     isUntypedCap (cteCap cte); capRange (cteCap cte') \<inter> untypedRange (cteCap cte) \<noteq> {};
-     \<not> isUntypedCap (cteCap cte');
-     untyped_mdb' ctes \<rbrakk> \<Longrightarrow> p' \<in> descendants_of' p ctes"
-  by (cases cte, cases cte', simp add: untyped_mdb'_def)
-
-lemma ko_wp_at_state_refs_ofD:
-  "\<lbrakk> ko_wp_at' P p s \<rbrakk> \<Longrightarrow> (\<exists>ko. P ko \<and> state_refs_of' s p = refs_of' ko)"
-  by (fastforce simp: ko_wp_at'_def state_refs_of'_def)
-
-lemma sym_refs_ko_wp_atD:
-  "\<lbrakk> ko_wp_at' P p s; sym_refs (state_refs_of' s) \<rbrakk>
-      \<Longrightarrow> (\<exists>ko. P ko \<and> state_refs_of' s p = refs_of' ko
-                    \<and> (\<forall>(x, tp) \<in> refs_of' ko. (p, symreftype tp) \<in> state_refs_of' s x))"
-  apply (clarsimp dest!: ko_wp_at_state_refs_ofD)
-  apply (rule exI, erule conjI)
-  apply (drule sym)
-  apply clarsimp
-  apply (erule(1) sym_refsD)
-  done
-
-lemma zobj_refs_capRange:
-  "capAligned c \<Longrightarrow> zobj_refs' c \<subseteq> capRange c"
-  by (cases c, simp_all add: capRange_def capAligned_def is_aligned_no_overflow)
-end
-
-locale delete_locale =
-  fixes s' and base and bits and ptr and idx and d
-  assumes     cap: "cte_wp_at' (\<lambda>cte. cteCap cte = UntypedCap d base bits idx) ptr s'"
-  and      nodesc: "descendants_range' (UntypedCap d base bits idx) ptr (ctes_of s')"
-  and        invs: "invs' s'"
-  and    sym_refs: "sym_refs (state_refs_of' s')"
-  and valid_idle': "valid_idle' s'"
-  and      ct_act: "ct_active' s'"
-  and     sa_simp: "sch_act_simple s'"
-  and          al: "is_aligned base bits"
-  and      rlqrun: "\<forall>p. p \<in> set (ksReleaseQueue s') \<longrightarrow> obj_at' (runnable' \<circ> tcbState) p s'"
-
-context delete_locale
-begin
-interpretation Arch . (*FIXME: arch_split*)
-lemma  valid_objs: "valid_objs' s'"
-  and    vreplies: "valid_replies' s'"
-  and      pspace: "valid_pspace' s'"
-  and          pa: "pspace_aligned' s'"
-  and          pd: "pspace_distinct' s'"
-  and          bd: "pspace_bounded' s'"
-  and          vq: "valid_queues s'"
-  and         vq': "valid_queues' s'"
-  and        vrlq: "valid_release_queue s'"
-  and       vrlq': "valid_release_queue' s'"
-  and   list_refs: "sym_refs (list_refs_of_replies' s')"
-  and      iflive: "if_live_then_nonz_cap' s'"
-  and    ifunsafe: "if_unsafe_then_cap' s'"
-  and       dlist: "valid_dlist (ctes_of s')"
-  and        no_0: "no_0 (ctes_of s')"
-  and     chain_0: "mdb_chain_0 (ctes_of s')"
-  and      badges: "valid_badges (ctes_of s')"
-  and   contained: "caps_contained' (ctes_of s')"
-  and     chunked: "mdb_chunked (ctes_of s')"
-  and        umdb: "untyped_mdb' (ctes_of s')"
-  and        uinc: "untyped_inc' (ctes_of s')"
-  and    nullcaps: "valid_nullcaps (ctes_of s')"
-  and      ut_rev: "ut_revocable' (ctes_of s')"
-  and      dist_z: "distinct_zombies (ctes_of s')"
-  and    irq_ctrl: "irq_control (ctes_of s')"
-  and      clinks: "class_links (ctes_of s')"
-  and        refs: "valid_global_refs' s'"
-  and        arch: "valid_arch_state' s'"
-  and        virq: "valid_irq_node' (irq_node' s') s'"
-  and       virqh: "valid_irq_handlers' s'"
-  and       virqs: "valid_irq_states' s'"
-  and   no_0_objs: "no_0_obj' s'"
-  and    pde_maps: "valid_pde_mappings' s'"
-  and irqs_masked: "irqs_masked' s'"
-  and         cdm: "ksCurDomain s' \<le> maxDomain"
-  and         vds: "valid_dom_schedule' s'"
-  using invs
-  by (auto simp add: invs'_def valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
-
-abbreviation
-  "base_bits \<equiv> {base .. base + (2 ^ bits - 1)}"
-
-abbreviation
-  "pspace' \<equiv> \<lambda>x. if base \<le> x \<and> x \<le> base + (2 ^ bits - 1) then None else ksPSpace s' x"
-
-abbreviation
-  "state' \<equiv> (s' \<lparr> ksPSpace := pspace' \<rparr>)"
-
-abbreviation
-  "replies' \<equiv> pspace' |> reply_of'"
-
-lemma ko_wp_at'[simp]:
-  "\<And>P p. (ko_wp_at' P p state') = (ko_wp_at' P p s' \<and> p \<notin> base_bits)"
-  by (fastforce simp add: ko_wp_at_delete'[OF pd])
-
-lemma obj_at'[simp]:
-  "\<And>P p. (obj_at' P p state') = (obj_at' P p s' \<and> p \<notin> base_bits)"
-  by (fastforce simp add: obj_at'_real_def)
-
-lemma typ_at'[simp]:
-  "typ_at' P p state' = (typ_at' P p s' \<and> p \<notin> base_bits)"
-  by (simp add: typ_at'_def)
-
-lemma valid_untyped[simp]:
-  "s' \<turnstile>' UntypedCap d base bits idx"
-  using cte_wp_at_valid_objs_valid_cap' [OF cap valid_objs]
-  by clarsimp
-
-lemma cte_wp_at'[simp]:
-  "\<And>P p. (cte_wp_at' P p state') = (cte_wp_at' P p s' \<and> p \<notin> base_bits)"
-  by (fastforce simp:cte_wp_at_delete'[where idx = idx,OF valid_untyped pd ])
-
-(* the bits of caps they need for validity argument are within their capRanges *)
-lemma valid_cap_ctes_pre:
-    "\<And>c. s' \<turnstile>' c \<Longrightarrow> case c of CNodeCap ref bits g gs
-                      \<Rightarrow> \<forall>x. ref + (x && mask bits) * 2^cteSizeBits \<in> capRange c
-                    | Zombie ref (ZombieCNode bits) n
-                      \<Rightarrow> \<forall>x. ref + (x && mask bits) * 2^cteSizeBits \<in> capRange c
-                    | ArchObjectCap (PageTableCap ref data)
-                      \<Rightarrow> \<forall>x < 0x100. ref + x * 2^pteBits \<in> capRange c \<comment> \<open>number of entries in page table\<close>
-                    | ArchObjectCap (PageDirectoryCap ref data)
-                      \<Rightarrow> \<forall>x < 0x1000. ref + x * 2^pdeBits \<in> capRange c \<comment> \<open>number of entries in page directory\<close>
-                    | _ \<Rightarrow> True"
-  apply (drule valid_capAligned)
-  apply (simp split: capability.split zombie_type.split arch_capability.split, safe)
-     using pre_helper[where a=cteSizeBits]
-     apply (clarsimp simp add: capRange_def capAligned_def objBits_simps field_simps)
-    apply (clarsimp simp add: capRange_def capAligned_def
-                    simp del: atLeastAtMost_iff capBits.simps)
-    apply (rule pre_helper2, simp_all add: word_bits_def pteBits_def)[1]
-   apply (clarsimp simp add: capRange_def capAligned_def
-                   simp del: atLeastAtMost_iff capBits.simps)
-   apply (rule pre_helper2, simp_all add: word_bits_def pdeBits_def)[1]
-  using pre_helper[where a=cteSizeBits]
-  apply (clarsimp simp add: capRange_def capAligned_def objBits_simps field_simps)
-  done
-
-lemma valid_cap':
-    "\<And>p c. \<lbrakk> s' \<turnstile>' c; cte_wp_at' (\<lambda>cte. cteCap cte = c) p s';
-             capRange c \<inter> {base .. base + (2 ^ bits - 1)} = {} \<rbrakk> \<Longrightarrow> state' \<turnstile>' c"
-  apply (subgoal_tac "capClass c = PhysicalClass \<longrightarrow> capUntypedPtr c \<in> capRange c")
-   apply (subgoal_tac "capClass c = PhysicalClass \<longrightarrow>
-                        capUntypedPtr c \<notin> {base .. base + (2 ^ bits - 1)}")
-    apply (frule valid_cap_ctes_pre)
-    apply (case_tac c, simp_all add: valid_cap'_def
-                                del: atLeastAtMost_iff
-                              split: zombie_type.split_asm)
-       apply (simp add: field_simps del: atLeastAtMost_iff)
-       apply blast
-      apply (rename_tac arch_capability)
-      apply (case_tac arch_capability,
-             simp_all add: ARM_H.capUntypedPtr_def
-                           page_table_at'_def page_directory_at'_def
-                           shiftl_t2n
-                      del: atLeastAtMost_iff)[1]
-        apply (rename_tac word vmrights vmpage_size option)
-        apply (subgoal_tac "\<forall>p < 2 ^ (pageBitsForSize vmpage_size - pageBits).
-                               word + p * 2 ^ pageBits \<in> capRange c")
-         apply blast
-        apply (clarsimp simp: capRange_def capAligned_def)
-        apply (frule word_less_power_trans2,
-               rule pbfs_atleast_pageBits, simp add: word_bits_def)
-        apply (rule context_conjI)
-         apply (erule(1) is_aligned_no_wrap')
-        apply (simp only: add_diff_eq[symmetric])
-        apply (rule word_plus_mono_right)
-         apply simp
-        apply (erule is_aligned_no_overflow')
-       apply (simp add: field_simps pteBits_def del: atLeastAtMost_iff)
-       apply blast
-      apply (simp add: field_simps pdeBits_def del: atLeastAtMost_iff)
-      apply blast
-     apply (simp add: valid_untyped'_def)
-    apply (simp add: field_simps del: atLeastAtMost_iff)
-    apply blast
-   apply blast
-  apply (clarsimp simp: capAligned_capUntypedPtr)
-  done
-
-lemma objRefs_notrange:
-  assumes asms: "ctes_of s' p = Some c" "\<not> isUntypedCap (cteCap c)"
-  shows "capRange (cteCap c) \<inter> base_bits = {}"
+lemma (in detype_locale') deletionIsSafe:
+  assumes sr: "(s, s') \<in> state_relation"
+  and    cap: "cap = cap.UntypedCap d base magnitude idx"
+  and      vs: "valid_pspace s"
+  and      al: "is_aligned base magnitude"
+  and      vu: "valid_untyped (cap.UntypedCap d base magnitude idx) s"
+  shows       "deletionIsSafe base magnitude s'"
 proof -
-  from cap obtain node
-    where ctes_of: "ctes_of s' ptr = Some (CTE (UntypedCap d base bits idx) node)"
-    apply (clarsimp simp: cte_wp_at_ctes_of)
-    apply (case_tac cte, simp)
-    done
-
-  show ?thesis using asms cap
+  interpret Arch . (* FIXME: arch-split *)
+  note [simp del] = atLeastatMost_subset_iff atLeastLessThan_iff atLeastAtMost_iff
+                    Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+  have "\<And>t m r. \<exists>ptr. cte_wp_at ((=) (cap.ReplyCap t m r)) ptr s
+        \<Longrightarrow> t \<notin> {base .. base + 2 ^ magnitude - 1}"
+    by (fastforce dest!: valid_cap2 simp: cap obj_reply_refs_def)
+  hence "\<forall>ptr t m r. cte_wp_at ((=) (cap.ReplyCap t m r)) ptr s
+         \<longrightarrow> t \<notin> {base .. base + 2 ^ magnitude - 1}"
+    by (fastforce simp del: split_paired_All)
+  hence "\<forall>t. t \<in> {base .. base + 2 ^ magnitude - 1} \<longrightarrow>
+          (\<forall>ptr m r. \<not> cte_wp_at ((=) (cap.ReplyCap t m r)) ptr s)"
+    by fastforce
+  hence cte: "\<forall>t. t \<in> {base .. base + 2 ^ magnitude - 1} \<longrightarrow>
+          (\<forall>ptr m r. \<not> cte_wp_at' (\<lambda>cte. cteCap cte = ReplyCap t m r) ptr s')"
+    unfolding deletionIsSafe_def
     apply -
-    apply (rule ccontr)
-    apply (drule untyped_mdbD' [OF ctes_of _ _ _ _ umdb])
-       apply (simp add: isUntypedCap_def)
-      apply (simp add: field_simps)
-     apply assumption
-    using nodesc
-    apply (simp add:descendants_range'_def2)
-    apply (drule(1) descendants_range_inD')
-     apply (simp add:asms)
-    apply (simp add:p_assoc_help)
+    apply (erule allEI)
+    apply (rule impI, drule(1) mp)
+    apply (thin_tac "t \<in> S" for S)
+    apply (intro allI)
+    apply (clarsimp simp: cte_wp_at_neg2 cte_wp_at_ctes_of
+                simp del: split_paired_All)
+    apply (frule pspace_relation_cte_wp_atI [rotated])
+      apply (rule invs_valid_objs [OF invs])
+     apply (rule state_relation_pspace_relation [OF sr])
+    apply (clarsimp simp: cte_wp_at_neg2 simp del: split_paired_All)
+    apply (drule_tac x="(a,b)" in spec)
+    apply (clarsimp simp: cte_wp_cte_at cte_wp_at_caps_of_state)
+    apply (case_tac c, simp_all)
+    apply fastforce
     done
-qed
-
-lemma ctes_of_valid [elim!]:
-  "ctes_of s' p = Some cte \<Longrightarrow> s' \<turnstile>' cteCap cte"
-  by (case_tac cte, simp add: ctes_of_valid_cap' [OF _ valid_objs])
-
-lemma valid_cap2:
-  "\<lbrakk> cte_wp_at' (\<lambda>cte. cteCap cte = c) p s' \<rbrakk> \<Longrightarrow> state' \<turnstile>' c"
-  apply (case_tac "isUntypedCap c")
-   apply (drule cte_wp_at_valid_objs_valid_cap' [OF _ valid_objs])
-   apply (clarsimp simp: valid_cap'_def isCap_simps valid_untyped'_def)
-  apply (rule valid_cap'[rotated], assumption)
-   apply (clarsimp simp: cte_wp_at_ctes_of dest!: objRefs_notrange)
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  done
-
-lemma ex_nonz_cap_notRange:
-  "ex_nonz_cap_to' p s' \<Longrightarrow> p \<notin> base_bits"
-  apply (clarsimp simp: ex_nonz_cap_to'_def cte_wp_at_ctes_of)
-  apply (case_tac "isUntypedCap (cteCap cte)")
-   apply (clarsimp simp: isCap_simps)
-  apply (drule subsetD[OF zobj_refs_capRange, rotated])
-   apply (rule valid_capAligned, erule ctes_of_valid)
-  apply (drule(1) objRefs_notrange)
-  apply (drule_tac a=p in equals0D)
-  apply simp
-  done
-
-lemma live_notRange:
-  "\<lbrakk> ko_wp_at' P p s'; \<And>ko. P ko \<Longrightarrow> live' ko \<rbrakk> \<Longrightarrow> p \<notin> base_bits"
-  apply (drule if_live_then_nonz_capE' [OF iflive ko_wp_at'_weakenE])
-   apply simp
-  apply (erule ex_nonz_cap_notRange)
-  done
-
-lemma deletionIsSafe_holds:
-  assumes sr: "(s, s') \<in> state_relation"
-  and    cap: "cap = cap.UntypedCap d base bits idx"
-  and     vs: "valid_pspace s"
-  and     al: "is_aligned base bits"
-  and     vu: "valid_untyped (cap.UntypedCap d base bits idx) s"
-  shows "deletionIsSafe base bits s'"
-proof -
-  interpret Arch . (* FIXME: arch_split *)
 
-  have arch: "\<And> ko p. \<lbrakk> ksPSpace s' p = Some (KOArch ko); p \<in> {base..base + 2 ^ bits - 1} \<rbrakk>
-                       \<Longrightarrow> 6 \<le> bits"
+  have arch: "\<And> ko p. \<lbrakk> ksPSpace s' p = Some (KOArch ko); p \<in> {base..base + 2 ^ magnitude - 1} \<rbrakk>
+             \<Longrightarrow> 6 \<le> magnitude"
     using sr vs vu
     apply (clarsimp simp: state_relation_def)
-    apply (erule (1) pspace_dom_relatedE)
-    apply (frule obj_relation_cuts_eqv_base_in_detype_range[symmetric]; simp?)
-      apply (clarsimp simp: valid_pspace_def)+
-    apply (clarsimp simp: valid_untyped_def)
+    apply (erule(1) pspace_dom_relatedE)
+    apply (frule obj_relation_cuts_eqv_base_in_detype_range[symmetric])
+        apply simp
+       apply (clarsimp simp:valid_pspace_def)+
+      apply simp
+    apply (clarsimp simp:valid_untyped_def)
     apply (drule spec)+
     apply (erule(1) impE)
     apply (erule impE)
-     apply (drule p_in_obj_range; fastforce)
+     apply (drule p_in_obj_range)
+       apply (clarsimp)+
+     apply blast
     apply clarsimp
     apply (drule card_mono[rotated])
      apply fastforce
-    apply (clarsimp simp: valid_pspace_def obj_range_def p_assoc_help)
+    apply (clarsimp simp:valid_pspace_def obj_range_def p_assoc_help)
     apply (subst (asm) word_range_card)
      apply (rule is_aligned_no_overflow')
      apply (erule(1) pspace_alignedD)
     apply (subst (asm) word_range_card)
      apply (rule is_aligned_no_overflow'[OF al])
     apply (rule ccontr)
-    apply (simp add: not_le)
-    apply (prop_tac "obj_bits koa < 32")
-     apply (case_tac koa, simp_all add: objBits_simps word_bits_def)
-       apply (drule(1) valid_cs_size_objsI)
-       apply (clarsimp simp: valid_cs_size_def word_bits_def cte_level_bits_def)
-      apply (clarsimp split: if_splits)
+    apply (simp add:not_le)
+    apply (subgoal_tac "obj_bits koa < 32")
+     prefer 2
+     apply (case_tac koa,simp_all add:objBits_simps word_bits_def)
+      apply (drule(1) valid_cs_size_objsI)
+      apply (clarsimp simp:valid_cs_size_def word_bits_def cte_level_bits_def)
      apply (rename_tac arch_kernel_obj)
-     apply (case_tac arch_kernel_obj; simp add: pageBits_def word_bits_def)
-     apply (simp add: pageBitsForSize_def split: vmpage_size.splits)
-    apply (case_tac koa
-           ; simp add: other_obj_relation_def objBits_simps cte_relation_def
-                split: if_splits)
-     apply (rename_tac arch_kernel_obj
-            , case_tac arch_kernel_obj
-            ; simp add: arch_kobj_size_def pageBits_def pageBitsForSize_def)+
+     apply (case_tac arch_kernel_obj,simp_all add:pageBits_def word_bits_def)
+     apply (simp add:pageBitsForSize_def split:vmpage_size.splits)
+    apply (subgoal_tac "6 \<le> obj_bits koa")
+     apply simp
+    apply (case_tac koa, simp_all add: other_obj_relation_def
+                                       objBits_simps cte_relation_def
+                                split: if_splits)
+    apply (rename_tac arch_kernel_obj,
+           case_tac arch_kernel_obj;
+           simp add: arch_kobj_size_def pageBits_def pageBitsForSize_def)+
     done
-
-  thus ?thesis
-  apply -
-  apply (clarsimp simp: deletionIsSafe_def)
-  apply (intro conjI; blast?)
-   apply (fastforce simp: x_power_minus_1 dest!: live_notRange)
-  apply (insert rlqrun)
-  apply simp
-  done
+  thus ?thesis using cte by (auto simp: deletionIsSafe_def)
 qed
 
-end
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 text \<open>Invariant preservation across concrete deletion\<close>
 
@@ -813,7 +579,7 @@ locale delete_locale =
   and      al: "is_aligned base bits"
   and    safe: "deletionIsSafe base bits s'"
 
-context delete_locale begin interpretation Arch . (*FIXME: arch_split*)
+context delete_locale begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma valid_objs: "valid_objs' s'"
   and        pa: "pspace_aligned' s'"
@@ -1028,7 +794,7 @@ lemma refs_notRange:
   done
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma ksASIDMapSafeI:
   "\<lbrakk> (s,s') \<in> state_relation; invs s; pspace_aligned' s' \<and> pspace_distinct' s' \<rbrakk>
@@ -1069,6 +835,11 @@ 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"
@@ -1112,42 +883,6 @@ lemma sym_refs_hyp_refs_triv[simp]: "sym_refs (state_hyp_refs_of s)"
   apply (case_tac ko; clarsimp)
   done
 
-lemma freeMemory_deletionIsSafe[wp]:
-  "doMachineOp (freeMemory base magnitude) \<lbrace>deletionIsSafe base magnitude\<rbrace>"
-  apply (clarsimp simp: doMachineOp_def)
-  apply wpsimp
-  apply (clarsimp simp: deletionIsSafe_def)
-  done
-
-lemma detype_ReplyPrevs_of:
-  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'; \<forall>p. p \<in> S \<longrightarrow> \<not> ko_wp_at' live' p s'\<rbrakk>
-   \<Longrightarrow> ((\<lambda>x. if x \<in> S then None else ksPSpace s' x) |> reply_of' |> replyPrev)
-       = replyPrevs_of s'"
-  apply (prop_tac "\<And>p reply_ptr. (replyPrevs_of s' p = Some reply_ptr) \<Longrightarrow> p \<notin> S")
-   apply (clarsimp simp: opt_map_def split: option.splits)
-   apply (drule_tac x=p in spec)
-   apply (clarsimp simp: ko_wp_at'_def pred_neg_def live'_def projectKOs live_reply'_def
-                  split: Structures_H.kernel_object.splits)
-  using pspace_alignedD' pspace_distinctD' pspace_boundedD' apply clarsimp
-  apply (rule ext)
-  apply (clarsimp simp: vs_all_heap_simps opt_map_def in_opt_map_eq
-                  split: option.splits)
-  by force
-
-lemma detype_sc_replies_relation:
-  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'; \<forall>p. p \<in> {lower..upper} \<longrightarrow> \<not> ko_wp_at' live' p s';
-    sc_replies_relation s s'\<rbrakk>
-   \<Longrightarrow> sc_replies_relation_2 (sc_replies_of (detype {lower..upper} s))
-                         ((\<lambda>x. if lower \<le> x \<and> x \<le> upper
-                               then None else ksPSpace s' x) |> sc_of' |> scReply)
-                         ((\<lambda>x. if lower \<le> x \<and> x \<le> upper
-                               then None else ksPSpace s' x) |> reply_of' |> replyPrev)"
-  apply (clarsimp simp: sc_replies_relation_def detype_def)
-  apply (frule detype_ReplyPrevs_of[where S="{lower..upper}"]; simp)
-  apply (clarsimp simp: vs_all_heap_simps opt_map_def in_opt_map_eq
-                 split: if_splits Structures_A.kernel_object.splits)
-  done
-
 crunch doMachineOp
   for deletionIsSafe_delete_locale[wp]: "deletionIsSafe_delete_locale base magnitude"
   (simp: deletionIsSafe_delete_locale_def)
@@ -1232,23 +967,23 @@ lemma deleteObjects_corres:
            \<and> ct_active' s'
            \<and> s' \<turnstile>' (UntypedCap d base magnitude idx))
       (delete_objects base magnitude) (deleteObjects base magnitude)"
-    (is "_ \<Longrightarrow> _ \<Longrightarrow> corres _ _ ?conc_guard _ _")
-  apply add_sym_refs
-  apply add_valid_idle'
-  apply add_release_q_runnable
   apply (simp add: deleteObjects_def2)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: sym_refs_asrt_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: valid_idle'_asrt_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: release_q_runnable_asrt_def)
-  apply (rule corres_stateAssert_add_assertion)
+  apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
    prefer 2
    apply clarsimp
-   apply (rule delete_locale.deletionIsSafe_holds
-          ; (fastforce simp: delete_locale_def valid_cap_simps sch_act_simple_def state_relation_def
-                             sched_act_relation_def pred_conj_def)?)
+   apply (rule_tac cap="cap.UntypedCap d base magnitude idx" and ptr="(a,b)" and s=s
+                in detype_locale'.deletionIsSafe,
+          simp_all add: detype_locale'_def detype_locale_def invs_valid_pspace)[1]
+   apply (simp add: valid_cap_simps)
+  apply (rule corres_stateAssert_add_assertion[rotated])
+   apply (rule_tac ptr=ptr and idx=idx and d=d in delete_locale.deletionIsSafe_delete_locale_holds)
+   apply (clarsimp simp: delete_locale_def)
+   apply (intro conjI)
+    apply (fastforce simp: sch_act_simple_def state_relation_def schact_is_rct_def)
+   apply (rule_tac cap="cap.UntypedCap d base magnitude idx" and ptr="(a,b)" and s=s
+                in detype_locale'.deletionIsSafe,
+          simp_all add: detype_locale'_def detype_locale_def invs_valid_pspace)[1]
+   apply (simp add:valid_cap_simps)
   apply (simp add: bind_assoc[symmetric])
   apply (rule corres_stateAssert_implied2)
      defer
@@ -1257,22 +992,24 @@ lemma deleteObjects_corres:
      apply (rule delete_objects_invs)
     apply fastforce
    apply (simp add: doMachineOp_def split_def)
-   apply wpsimp
-   apply (frule invs_valid_pspace')
-   apply (rule conjI
-          ; clarsimp simp: pspace_distinct'_def ps_clear_def dom_if_None Diff_Int_distrib
-                           valid_pspace'_def pspace_aligned'_def)
+   apply wp
+   apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def pspace_distinct'_def
+                         pspace_aligned'_def)
+   apply (rule conjI)
+    subgoal by fastforce
+   apply (clarsimp simp add: pspace_distinct'_def ps_clear_def
+                             dom_if_None Diff_Int_distrib)
   apply (simp add: delete_objects_def)
   apply (rule_tac Q="\<lambda>_ s. valid_objs s \<and> valid_list s \<and>
                            (\<exists>cref. cte_wp_at ((=) (cap.UntypedCap d base magnitude idx)) cref s \<and>
-                                   descendants_range (cap.UntypedCap d base magnitude idx) cref s) \<and>
+                           descendants_range (cap.UntypedCap d base magnitude idx) cref s ) \<and>
                            s \<turnstile> cap.UntypedCap d base magnitude idx \<and> pspace_aligned s \<and>
                            valid_mdb s \<and> pspace_distinct s \<and> if_live_then_nonz_cap s \<and>
                            zombies_final s \<and> sym_refs (state_refs_of s) \<and>
                            untyped_children_in_mdb s \<and> if_unsafe_then_cap s \<and>
-                           valid_global_refs s \<and> valid_replies s \<and> fault_tcbs_valid_states s" and
-                  Q'="\<lambda>_ s. s \<turnstile>' UntypedCap d base magnitude idx \<and>
-                            valid_pspace' s \<and> deletionIsSafe base magnitude s"
+                           valid_global_refs s"
+              and Q'="\<lambda>_ s. s \<turnstile>' capability.UntypedCap d base magnitude idx \<and>
+                            valid_pspace' s \<and> deletionIsSafe_delete_locale base magnitude s"
                in corres_underlying_split)
      apply (rule corres_bind_return)
      apply (rule corres_guard_imp[where r=dc])
@@ -1286,9 +1023,14 @@ 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)
-          apply (intro exI, fastforce)
-         apply (rule ext, clarsimp simp add: null_filter_def)
+            apply (simp add: detype_def, rule state.equality; simp add: detype_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[simplified field_simps])
          apply (rule sym, rule ccontr, clarsimp)
          apply (frule(2) pspace_relation_cte_wp_atI[OF state_relation_pspace_relation])
          apply (elim exE)
@@ -1300,107 +1042,29 @@ lemma deleteObjects_corres:
          apply (frule_tac cref="(aa, ba)" in cte_map_untyped_range,
                 erule cte_wp_at_weakenE[OF _ TrueI], assumption+)
          apply simp
-        apply (rule ext, clarsimp simp add: null_filter'_def
-                           map_to_ctes_delete[simplified field_simps])
-        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
-       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_sc_replies_relation; blast?)
-       apply (clarsimp simp: deletionIsSafe_def)
-      apply (erule state_relation_sc_replies_relation)
+        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 add: detype_def detype_ext_def intro!: ekheap_relation_detype)
+      apply (rule detype_ready_queues_relation; blast?)
+       apply (clarsimp simp: deletionIsSafe_delete_locale_def)
+      apply (frule state_relation_ready_queues_relation)
+      apply (simp add: ready_queues_relation_def Let_def)
      apply (clarsimp simp: state_relation_def ghost_relation_of_heap detype_def)
      apply (drule_tac t="gsUserPages s'" in sym)
      apply (drule_tac t="gsCNodes s'" in sym)
-     apply (auto simp: ups_of_heap_def cns_of_heap_def ext
-                split: option.splits kernel_object.splits)[1]
+     apply (auto simp add: ups_of_heap_def cns_of_heap_def ext
+                    split: option.splits kernel_object.splits)[1]
     apply (simp add: valid_mdb_def)
-   apply (wp hoare_vcg_ex_lift hoare_vcg_ball_lift
-          | wps
-          | simp add: invs_def valid_state_def valid_pspace_def descendants_range_def
-                      valid_cap_simps
-          | wp (once) hoare_drop_imps)+
-  apply (rule invs_valid_pspace')
-  apply simp
+   apply (wp hoare_vcg_ex_lift hoare_vcg_ball_lift | wps |
+          simp add: invs_def valid_state_def valid_pspace_def
+                    descendants_range_def | wp (once) hoare_drop_imps)+
+  apply fastforce
   done
 end
 
-context delete_locale
-begin
-interpretation Arch . (*FIXME: arch_split*)
-
-lemma live_idle_untyped_range':
-  "\<lbrakk> ko_wp_at' P p s' \<or> p = idle_thread_ptr \<or> p = idle_sc_ptr; \<And>ko. P ko \<Longrightarrow> live' ko \<rbrakk>
-   \<Longrightarrow> p \<notin> base_bits"
-  apply (case_tac "ko_wp_at' P p s'")
-   apply (drule if_live_then_nonz_capE'[OF iflive ko_wp_at'_weakenE])
-    apply simp
-   apply (erule ex_nonz_cap_notRange)
-  apply clarsimp
-  apply (insert invs_valid_global'[OF invs] cap valid_idle'
-                idle_is_global[where s = s])
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  apply (drule (1) valid_global_refsD')
-  apply (clarsimp simp: valid_idle'_def)
-  using atLeastAtMost_iff apply (simp add: p_assoc_help)
-  by fastforce
-
-lemma untyped_range_live_idle':
-  "p \<in> base_bits \<Longrightarrow> \<not> (ko_wp_at' live' p s' \<or> p = idle_thread_ptr \<or> p = idle_sc_ptr)"
-  using live_idle_untyped_range' by blast
-
-lemma refs_of':
-  "\<And>ko p. ko_wp_at' ((=) (injectKOS ko)) p s' \<Longrightarrow> sym_refs (state_refs_of' s')
-   \<Longrightarrow> refs_of' (injectKOS ko) \<subseteq> (UNIV - base_bits \<times> UNIV)"
-  apply (case_tac "p = idle_sc_ptr \<or> p = idle_thread_ptr")
-   apply (insert valid_idle')
-   apply (clarsimp simp: valid_idle'_def)
-   apply (elim disjE)
-    apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
-    using live_idle_untyped_range' apply simp
-   apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs idle_tcb'_def)
-   using live_idle_untyped_range' apply simp
-  apply (prop_tac "ko_at' ko p s'")
-   apply (fastforce simp: ko_wp_at'_def obj_at'_def projectKOs project_inject)
-  apply (frule sym_refs_ko_atD')
-   apply (fastforce intro: refs_of_live' dest!: live_notRange)+
-  done
-
-lemma list_refs_of_replies_live':
-  "\<lbrakk> (x, tp) \<in> list_refs_of_replies' s' p; pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s' \<rbrakk>
-   \<Longrightarrow> ko_wp_at' live' p s'"
-  apply (clarsimp simp: ko_wp_at'_def list_refs_of_replies'_def list_refs_of_reply'_def pspace_bounded'_def
-                        pspace_aligned'_def pspace_distinct'_def get_refs_def projectKOs
-                 split: option.splits
-                 elim!: opt_mapE)
-    by (metis live_reply'_def not_in_domIff option.discI option.sel)+
-
-lemma replyPrev_list_refs_of_replies:
-  "\<lbrakk>ko_at' reply p s'; replyPrev reply = Some reply_ptr\<rbrakk>
-   \<Longrightarrow> (reply_ptr, ReplyPrev) \<in> list_refs_of_replies' s' p"
-  by (clarsimp simp: list_refs_of_replies'_def list_refs_of_reply'_def opt_map_def projectKOs
-                     obj_at'_def
-              split: option.splits)
-
-lemma replyNext_list_refs_of_replies:
-  "\<lbrakk>ko_at' reply p s'; replyNext reply = Some next_ptr; next_ptr = Next reply_ptr\<rbrakk>
-   \<Longrightarrow> (reply_ptr, ReplyNext) \<in> list_refs_of_replies' s' p"
-  by (clarsimp simp: list_refs_of_replies'_def list_refs_of_reply'_def opt_map_def projectKOs
-                     obj_at'_def
-              split: option.splits)
+context delete_locale begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma live_idle_untyped_range':
   "ko_wp_at' live' p s' \<or> p = idle_thread_ptr \<Longrightarrow> p \<notin> base_bits"
@@ -1421,150 +1085,64 @@ lemma untyped_range_live_idle':
   using live_idle_untyped_range' by blast
 
 lemma valid_obj':
-  "\<lbrakk> valid_obj' obj s'; ko_wp_at' ((=) obj) p s'; sym_refs (state_refs_of' s');
-     sym_refs (list_refs_of_replies' s'); pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'\<rbrakk>
+  "\<lbrakk> valid_obj' obj s'; ko_wp_at' ((=) obj) p s'; sym_heap_sched_pointers s' \<rbrakk>
    \<Longrightarrow> valid_obj' obj state'"
   apply (case_tac obj, simp_all add: valid_obj'_def)
-        apply (clarsimp dest!: refs_of' simp flip: injectKO_ep)
-        apply (fastforce simp: valid_ep'_def split: endpoint.splits)
-       apply (clarsimp dest!: refs_of' simp flip: injectKO_ntfn)
-       apply (fastforce simp: valid_ntfn'_def valid_bound_obj'_def split: option.splits ntfn.splits)
-      apply (clarsimp simp flip: injectKO_tcb)
-      apply (frule refs_of')
-      apply (frule (2) sym_refs_ko_wp_atD)
-      apply (clarsimp simp: valid_tcb'_def ko_wp_at'_def objBits_simps)
-      apply (rule conjI)
-       apply (erule ballEI, clarsimp elim!: ranE)
-       apply (rule_tac p="p + x" in valid_cap2)
-       apply (erule (2) cte_wp_at_tcbI')
-        apply fastforce
-       apply simp
-      apply (clarsimp simp: valid_tcb_state'_def valid_bound_reply'_def
-                     split: option.splits thread_state.splits)
-     apply (clarsimp simp: valid_cte'_def)
-     apply (rule_tac p=p in valid_cap2)
-     apply (clarsimp simp: ko_wp_at'_def objBits_simps' cte_level_bits_def[symmetric])
-     apply (erule(2) cte_wp_at_cteI')
+      apply (rename_tac endpoint)
+      apply (case_tac endpoint, simp_all add: valid_ep'_def)[1]
+       apply (clarsimp dest!: sym_refs_ko_wp_atD [OF _ sym_refs])
+       apply (drule(1) bspec)+
+       apply (clarsimp dest!: refs_notRange)
+      apply (clarsimp dest!: sym_refs_ko_wp_atD [OF _ sym_refs])
+      apply (drule(1) bspec)+
+      apply (clarsimp dest!: refs_notRange)
+     apply (rename_tac notification)
+     apply (case_tac notification, simp_all add: valid_ntfn'_def valid_bound_tcb'_def)[1]
+     apply (rename_tac ntfn bound)
+     apply (case_tac ntfn, simp_all split:option.splits)[1]
+        apply ((clarsimp dest!: sym_refs_ko_wp_atD [OF _ sym_refs] refs_notRange)+)[4]
+      apply (drule(1) bspec)+
+      apply (clarsimp dest!: refs_notRange)
+     apply (clarsimp dest!: sym_refs_ko_wp_atD [OF _ sym_refs] refs_notRange)
+    apply (frule sym_refs_ko_wp_atD [OF _ sym_refs])
+    apply (clarsimp simp: valid_tcb'_def ko_wp_at'_def
+                          objBits_simps)
+    apply (rule conjI)
+     apply (erule ballEI, clarsimp elim!: ranE)
+     apply (rule_tac p="p + x" in valid_cap2)
+     apply (erule(2) cte_wp_at_tcbI')
+      apply fastforce
      apply simp
-    apply (rename_tac arch_kernel_object)
-    apply (case_tac "arch_kernel_object", simp_all)
-      apply (rename_tac asidpool)
-      apply (case_tac asidpool, clarsimp simp: page_directory_at'_def)
-     apply (rename_tac pte)
-     apply (case_tac pte, simp_all add: valid_mapping'_def)
-    apply (rename_tac pde)
-    apply (case_tac pde, simp_all add: valid_mapping'_def)
-   apply (clarsimp dest!: refs_of' simp flip: injectKO_sc)
-   apply (clarsimp simp: valid_sched_context'_def valid_bound_obj'_def split: option.splits)
-  apply (rename_tac reply)
-  apply (clarsimp simp flip: injectKO_reply)
-  apply (frule (1) refs_of')
-  apply (clarsimp simp: ko_wp_at'_def valid_reply'_def valid_bound_tcb'_def)
-  apply (rule conjI; (solves \<open>clarsimp split: option.splits\<close>)?)+
-   apply (case_tac "replyPrev reply = None"; clarsimp?)
-   apply (frule replyPrev_list_refs_of_replies[rotated])
-    apply (simp add: obj_at'_def projectKOs)
-  using sym_refs_def live_notRange list_refs_of_replies_live' apply fastforce
-  apply (case_tac "replyNext reply = None"; clarsimp?)
-  apply (rename_tac reply_next)
-  apply (case_tac reply_next; clarsimp)
-  apply (frule replyNext_list_refs_of_replies[rotated], simp)
-   apply (simp add: obj_at'_def projectKOs)
-  using sym_refs_def live_notRange list_refs_of_replies_live' apply fastforce
-  done
-
-lemma state_refs_for_state':
-  "\<lbrakk> pspace_aligned' s'; pspace_distinct' s'; pspace_distinct' state' \<rbrakk>
-   \<Longrightarrow> state_refs_of' state' = (\<lambda>x. if x \<in> base_bits then {} else state_refs_of' s' x)"
-  apply (rule ext)
-  by (auto simp: state_refs_of'_def intro!: pspace_distinctD' split: option.splits)
-
-lemma sc_tcb_not_idle_thread'_helper:
-  "\<lbrakk> pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'; scTCB sc = Some tp;
-     ksPSpace s' scp = Some (KOSchedContext sc); sym_refs (state_refs_of' s') \<rbrakk>
-   \<Longrightarrow> (scp, TCBSchedContext) \<in> state_refs_of' s' tp"
-  apply (clarsimp simp: state_refs_of'_def
-                 elim!: sym_refsE)
-  by (simp add: pspace_alignedD' pspace_distinctD' pspace_boundedD')
-
-lemma sc_tcb_not_idle_thread':
-  "\<lbrakk> pspace_aligned' s'; pspace_distinct' s'; ksPSpace s' scp = Some (KOSchedContext sc);
-     scp \<noteq> idle_sc_ptr; valid_global_refs' s'; valid_pspace' s';
-     if_live_then_nonz_cap' s'; sym_refs (state_refs_of' s')\<rbrakk>
-   \<Longrightarrow> scTCB sc \<noteq> Some (ksIdleThread s')"
-  apply (frule (1) global'_no_ex_cap)
-  apply (rule valid_objsE'; fastforce?)
-  apply (clarsimp simp: valid_obj_def valid_sched_context_def is_tcb obj_at_def)
-  apply (frule sc_tcb_not_idle_thread'_helper; blast?)
-  apply (insert valid_idle')
-  apply (clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def projectKOs state_refs_of'_def
-                        live'_def idle_tcb'_def
-                 dest!: sc_tcb_not_idle_thread'_helper if_live_then_nonz_capD')
-  done
-
-lemma thread_not_idle_implies_sc_not_idle'_helper:
-  "\<lbrakk> pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'; tcbSchedContext tcb = Some scp;
-     ksPSpace s' tp = Some (KOTCB tcb); sym_refs (state_refs_of' s') \<rbrakk>
-   \<Longrightarrow> (tp, SCTcb) \<in> state_refs_of' s' scp"
-  apply (clarsimp simp: state_refs_of'_def
-                 elim!: sym_refsE)
-  by (simp add: pspace_alignedD' pspace_distinctD' pspace_boundedD')
-
-lemma thread_not_idle_implies_sc_not_idle':
-  "\<lbrakk> pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'; ksPSpace s' tp = Some (KOTCB tcb);
-     tp \<noteq> idle_thread_ptr; valid_global_refs' s'; valid_objs' s';
-     valid_idle' s'; if_live_then_nonz_cap' s'; sym_refs (state_refs_of' s') \<rbrakk>
-   \<Longrightarrow> tcbSchedContext tcb \<noteq> Some idle_sc_ptr"
-  apply (frule global'_sc_no_ex_cap)
-   apply (blast intro: pspace)
-  apply (rule valid_objsE'; simp?)
-  apply (clarsimp simp: valid_obj'_def valid_tcb'_def is_sc_obj_def obj_at'_def)
-  apply (rename_tac ko obj)
-  apply (case_tac ko; clarsimp simp: projectKOs)
-   apply (drule (5) thread_not_idle_implies_sc_not_idle'_helper)
-   apply (drule if_live_then_nonz_capE'[where p=idle_sc_ptr])
-    apply (fastforce simp: ko_wp_at'_def  live_sc'_def state_refs_of'_def
-                    dest!: thread_not_idle_implies_sc_not_idle_helper)
-   apply fastforce
-  done
-
-lemma state_refs:
-  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s';
-    pspace_distinct' state'; sym_refs (state_refs_of' s')\<rbrakk>
-  \<Longrightarrow> (state_refs_of' state') = (state_refs_of' s')"
-  apply (rule ext)
-  apply (clarsimp simp: state_refs_for_state')
-  apply (rename_tac x)
-  apply (prop_tac "x \<in> base_bits", simp)
-  apply (frule untyped_range_live_idle')
-  apply (clarsimp simp: state_refs_of'_def split: option.splits)
-  apply (rename_tac ko)
-  apply (case_tac ko; simp)
-      apply (fastforce simp: ep_q_refs_of'_def ko_wp_at'_def)
-     apply (fastforce simp: ntfn_q_refs_of'_def ko_wp_at'_def live_ntfn'_def state_refs_of'_def
-                     split: ntfn.splits)
-    apply (insert refs valid_objs valid_idle' iflive pspace)
-    apply (frule (8) thread_not_idle_implies_sc_not_idle')
-     apply (fastforce simp: state_refs_of'_def)
-    apply (fastforce simp: ko_wp_at'_def)
-   apply (frule (6) sc_tcb_not_idle_thread')
-    apply (fastforce simp: state_refs_of'_def)
-   apply (clarsimp simp: ko_wp_at'_def live_sc'_def  valid_idle'_def)
-  apply (clarsimp simp: ko_wp_at'_def live_reply'_def)
-  done
-
-
-lemma list_refs_of_reply'_state':
-  "\<lbrakk>pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'; pspace_distinct' state'\<rbrakk>
-   \<Longrightarrow> (map_set (replies' ||> list_refs_of_reply')) = (list_refs_of_replies' s')"
-  apply (rule ext)
-  apply (clarsimp simp: list_refs_of_replies'_def list_refs_of_reply'_def opt_map_def
-                 split: option.splits)
-  apply (rename_tac x reply_ptr reply)
-  apply (prop_tac "x \<in> base_bits", simp)
-  apply (frule untyped_range_live_idle')
-  apply (clarsimp simp: live'_def ko_wp_at'_def live_reply'_def projectKOs)
-  using pspace_alignedD' pspace_distinctD' pspace_boundedD' apply clarsimp
+    apply (intro conjI)
+       apply (rename_tac tcb)
+       apply (case_tac "tcbState tcb"; clarsimp simp: valid_tcb_state'_def  dest!: refs_notRange)
+      apply (rename_tac tcb)
+      apply (case_tac "tcbState tcb";
+             clarsimp simp: valid_tcb_state'_def valid_bound_ntfn'_def
+                     dest!: refs_notRange split: option.splits)
+     apply (clarsimp simp: none_top_bool_cases)
+     apply (rename_tac prev)
+     apply (cut_tac P=live' and p=prev in live_notRange; fastforce?)
+     apply (fastforce dest: sym_heapD2[where p'=p]
+                      simp: opt_map_def ko_wp_at'_def obj_at'_def projectKOs)
+    apply (clarsimp simp: none_top_bool_cases)
+    apply (rename_tac "next")
+    apply (cut_tac P=live' and p="next" in live_notRange; fastforce?)
+    apply (fastforce dest!: sym_heapD1[where p=p]
+                     simp: opt_map_def ko_wp_at'_def obj_at'_def projectKOs)
+   apply (clarsimp simp: valid_cte'_def)
+   apply (rule_tac p=p in valid_cap2)
+   apply (clarsimp simp: ko_wp_at'_def objBits_simps' cte_level_bits_def[symmetric])
+   apply (erule(2) cte_wp_at_cteI')
+   apply simp
+  apply (rename_tac arch_kernel_object)
+  apply (case_tac "arch_kernel_object", simp_all)
+    apply (rename_tac asidpool)
+    apply (case_tac asidpool, clarsimp simp: page_directory_at'_def)
+   apply (rename_tac pte)
+   apply (case_tac pte, simp_all add: valid_mapping'_def)
+  apply(rename_tac pde)
+  apply (case_tac pde, simp_all add: valid_mapping'_def)
   done
 
 lemma tcbSchedNexts_of_pspace':
@@ -1792,17 +1370,15 @@ lemma exists_disj:
    by auto
 
 lemma (in delete_locale) delete_invs':
-  assumes "\<forall>t. t \<in> set (ksReleaseQueue s) \<longrightarrow> obj_at' (runnable' \<circ> tcbState) t s"
-  and "sym_refs (state_refs_of' s')"
-  shows "invs' (ksMachineState_update
-             (\<lambda>ms. underlying_memory_update
-                (\<lambda>m x. if base \<le> x \<and> x \<le> base + (2 ^ bits - 1) then 0 else m x) ms)
-              state')" (is "invs' (?state'')")
+  "invs' (ksMachineState_update
+           (\<lambda>ms. underlying_memory_update
+              (\<lambda>m x. if base \<le> x \<and> x \<le> base + (2 ^ bits - 1) then 0 else m x) ms)
+           state')" (is "invs' (?state'')")
 using vds
-proof (simp add: invs'_def valid_pspace'_def (* FIXME: do not simp here *)
+proof (simp add: invs'_def valid_state'_def valid_pspace'_def
                  valid_mdb'_def valid_mdb_ctes_def,
        safe)
-  interpret Arch . (*FIXME: arch_split*)
+  interpret Arch . (*FIXME: arch-split*)
   let ?s = state'
   let ?ran = base_bits
 
@@ -1813,66 +1389,25 @@ proof (simp add: invs'_def valid_pspace'_def (* FIXME: do not simp here *)
     by (clarsimp simp add: pspace_distinct'_def ps_clear_def
                            dom_if_None Diff_Int_distrib)
 
-  show "pspace_bounded' ?s" using bd
-    by (simp add: pspace_bounded'_def dom_def)
-
-  show "valid_objs' ?s" using valid_objs assms
+  show "valid_objs' ?s" using valid_objs sym_sched
     apply (clarsimp simp: valid_objs'_def ran_def)
-    apply (insert list_refs pa pd bd)
-    apply (rule_tac p=a in valid_obj'; fastforce?)
-    apply (frule pspace_alignedD'[OF _ pa])
-    apply (frule pspace_distinctD'[OF _ pd])
-    apply (frule pspace_boundedD'[OF _ bd])
-    apply (clarsimp simp: ko_wp_at'_def)
-    done
-
-  show "valid_replies' ?s" using vreplies assms
-    apply (clarsimp simp: valid_replies'_def simp del: imp_disjL)
-    apply (prop_tac "rptr \<notin> base_bits")
-     apply (clarsimp simp: opt_map_def)
-    apply (drule_tac x=rptr in spec, drule mp)
-     apply (fastforce simp: opt_map_def)
-    apply clarsimp
-    apply (prop_tac "tptr \<notin> base_bits")
-     apply (rule live_notRange[where P=live']; clarsimp?)
-     apply (fastforce simp: ko_wp_at'_def pred_tcb_at'_def obj_at'_def projectKOs)
-    apply (clarsimp simp: pred_tcb_at'_def opt_map_def)
-    done
-
-  show "sym_refs (map_set (replies' ||> list_refs_of_reply'))"
-    apply (insert pa pd bd pspace_distinct'_state' list_refs)
-    by (subst list_refs_of_reply'_state'; blast?)
-
-  from vq show "valid_queues ?s"
-    apply (clarsimp simp: valid_queues_def bitmapQ_defs)
-    apply (clarsimp simp: valid_queues_no_bitmap_def)
-    apply (drule spec, drule spec, drule conjunct1, drule(1) bspec)
-    apply (clarsimp simp: obj_at'_real_def)
-    apply (frule if_live_then_nonz_capE'[OF iflive, OF ko_wp_at'_weakenE])
-     apply (clarsimp simp: projectKOs inQ_def)
-    apply (clarsimp dest!: ex_nonz_cap_notRange)
+    apply (rule_tac p=a in valid_obj')
+      apply fastforce
+     apply (frule pspace_alignedD'[OF _ pa])
+     apply (frule pspace_distinctD'[OF _ pd])
+     apply (clarsimp simp: ko_wp_at'_def)
+    apply fastforce
     done
 
-  from vq' show "valid_queues' ?s"
-    by (simp add: valid_queues'_def)
-
-  from rlqrun show "valid_release_queue ?s"
-    apply (clarsimp simp: valid_release_queue_def)
-    apply (insert assms vrlq)
-    apply (drule_tac x=t and P="\<lambda>t. t \<in> set (ksReleaseQueue s)
-                                    \<longrightarrow> obj_at' (runnable' \<circ> tcbState) t s"
-                  in spec)
-    apply (clarsimp simp: obj_at'_real_def)
-    apply (drule_tac x=t in spec, simp)
-    apply (frule live_notRange)
-     apply (fastforce simp: projectKOs live'_def ko_wp_at'_def obj_at'_def
-                     split: Structures_H.thread_state.splits)
-    apply (clarsimp simp: valid_release_queue_def obj_at'_real_def)
+  from sym_refs show "sym_refs (state_refs_of' ?s)"
+    apply -
+    apply (clarsimp simp: state_refs_ko_wp_at_eq
+                   elim!: rsubst[where P=sym_refs])
+    apply (rule ext)
+    apply safe
+    apply (simp add: refs_notRange[simplified] state_refs_ko_wp_at_eq)
     done
 
-  from vrlq' show "valid_release_queue' ?s"
-    by (simp add: valid_release_queue'_def)
-
   show "if_live_then_nonz_cap' ?s" using iflive
     apply (clarsimp simp: if_live_then_nonz_cap'_def)
     apply (drule spec, drule(1) mp)
@@ -1892,6 +1427,19 @@ proof (simp add: invs'_def valid_pspace'_def (* FIXME: do not simp here *)
     apply (simp add: cte_wp_at_ctes_of valid_global_refs'_def valid_refs'_def)
     apply blast
     done
+  with idle show "valid_idle' ?s"
+    apply (clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def projectKOs)
+    apply (clarsimp simp add: ps_clear_def dom_if_None Diff_Int_distrib)
+    done
+
+  from tcb_at_invs' [OF invs] ct_act
+  show "cur_tcb' ?s" unfolding cur_tcb'_def
+    apply (clarsimp simp: cur_tcb'_def ct_in_state'_def)
+    apply (drule st_tcb)
+      apply simp
+     apply simp
+    apply (simp add: pred_tcb_at'_def)
+    done
 
   let ?ctes' = ctes'
 
@@ -2015,6 +1563,11 @@ proof (simp add: invs'_def valid_pspace'_def (* FIXME: do not simp here *)
     apply clarsimp
     done
 
+  show "reply_masters_rvk_fb ?ctes'"
+    using rep_r_fb
+    by (simp add: tree_to_ctes reply_masters_rvk_fb_def
+                  ball_ran_eq)
+
   from virqs
   show "valid_irq_states' s'" .
 
@@ -2030,13 +1583,20 @@ proof (simp add: invs'_def valid_pspace'_def (* FIXME: do not simp here *)
   show "irqs_masked' state'"
     by (simp add: irqs_masked'_def)
 
+  from sa_simp ct_act
+  show "sch_act_wf (ksSchedulerAction s') state'"
+    apply (simp add: sch_act_simple_def)
+    apply (case_tac "ksSchedulerAction s'", simp_all add: ct_in_state'_def)
+    apply (fastforce dest!: st_tcb elim!: pred_tcb'_weakenE)
+    done
+
   from invs
-  have "pspace_domain_valid s'" by (simp add: invs'_def)
+  have "pspace_domain_valid s'" by (simp add: invs'_def valid_state'_def)
   thus "pspace_domain_valid state'"
     by (simp add: pspace_domain_valid_def)
 
   from invs
-  have "valid_machine_state' s'" by (simp add: invs'_def)
+  have "valid_machine_state' s'" by (simp add: invs'_def valid_state'_def)
   thus "valid_machine_state' ?state''"
     apply (clarsimp simp: valid_machine_state'_def)
     apply (drule_tac x=p in spec)
@@ -2059,10 +1619,42 @@ proof (simp add: invs'_def valid_pspace'_def (* FIXME: do not simp here *)
     apply (auto simp add: x_power_minus_1)
     done
 
+  from sa_simp ctnotinQ
+  show "ct_not_inQ state'"
+    apply (clarsimp simp: ct_not_inQ_def pred_tcb_at'_def)
+    apply (drule obj_at'_and
+                   [THEN iffD2, OF conjI,
+                    OF ct_act [unfolded ct_in_state'_def pred_tcb_at'_def]])
+    apply (clarsimp simp: obj_at'_real_def)
+    apply (frule if_live_then_nonz_capE'[OF iflive, OF ko_wp_at'_weakenE])
+     apply (clarsimp simp: projectKOs)
+     apply (case_tac "tcbState obj")
+            apply (clarsimp simp: projectKOs)+
+    apply (clarsimp dest!: ex_nonz_cap_notRange)
+    done
+
+  from ctcd show "ct_idle_or_in_cur_domain' state'"
+    apply (simp add: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
+    apply (intro impI)
+    apply (elim disjE impE)
+     apply simp+
+    apply (intro impI)
+    apply (rule disjI2)
+    apply (drule obj_at'_and
+                   [THEN iffD2, OF conjI,
+                    OF ct_act [unfolded ct_in_state'_def st_tcb_at'_def]])
+    apply (clarsimp simp: obj_at'_real_def)
+    apply (frule if_live_then_nonz_capE'[OF iflive, OF ko_wp_at'_weakenE])
+     apply (clarsimp simp: projectKOs)
+     apply (case_tac "tcbState obj")
+            apply (clarsimp simp: projectKOs)+
+    apply (clarsimp dest!: ex_nonz_cap_notRange elim!: ko_wp_at'_weakenE)
+    done
+
   from cdm show "ksCurDomain s' \<le> maxDomain" .
 
   from invs
-  have urz: "untyped_ranges_zero' s'" by (simp add: invs'_def)
+  have urz: "untyped_ranges_zero' s'" by (simp add: invs'_def valid_state'_def)
   show "untyped_ranges_zero_inv (cteCaps_of state')
     (gsUntypedZeroRanges s')"
     apply (simp add: untyped_zero_ranges_cte_def
@@ -2130,6 +1722,7 @@ lemma deleteObjects_null_filter:
      and K (bits < word_bits \<and> is_aligned ptr bits)\<rbrace>
   deleteObjects ptr bits
   \<lbrace>\<lambda>rv s.  P (null_filter' (ctes_of s))\<rbrace>"
+  apply (simp add: deleteObjects_def3)
   apply (simp add: deleteObjects_def3 doMachineOp_def split_def)
   apply wp
   apply clarsimp
@@ -2141,7 +1734,6 @@ lemma deleteObjects_null_filter:
    apply (subgoal_tac "ksPSpace (s\<lparr>ksMachineState := snd ((), b)\<rparr>) =
                        ksPSpace s", simp only:, simp)
   apply (unfold_locales, simp_all)
-   apply (clarsimp simp: deletionIsSafe_def sym_refs_asrt_def valid_idle'_asrt_def)+
   done
 
 lemma deleteObjects_descendants:
@@ -2163,8 +1755,7 @@ lemma doMachineOp_modify:
   apply (rule ext)
   apply (simp add: simpler_gets_def simpler_modify_def bind_def)
   done
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma deleteObjects_invs':
   "\<lbrace>cte_wp_at' (\<lambda>c. cteCap c = UntypedCap d ptr bits idx) p
      and invs' and ct_active' and sch_act_simple
@@ -2186,11 +1777,8 @@ proof -
   apply (simp cong: if_cong)
   apply (subgoal_tac "is_aligned ptr bits \<and> 2 \<le> bits \<and> bits < word_bits",simp)
    apply clarsimp
-   apply (frule delete_locale.intro; simp add: deletionIsSafe_def sym_refs_asrt_def valid_idle'_asrt_def)
-    apply (rule subst[rotated, where P=invs'], erule delete_locale.delete_invs')
-     apply (clarsimp simp: deletionIsSafe_def)
-     apply blast
-    apply blast
+   apply (frule(2) delete_locale.intro, simp_all)[1]
+   apply (rule subst[rotated, where P=invs'], erule delete_locale.delete_invs')
    apply (simp add: field_simps)
   apply clarsimp
   apply (drule invs_valid_objs')
@@ -2220,12 +1808,12 @@ lemma deleteObjects_st_tcb_at':
      apply (fastforce elim: ko_wp_at'_weakenE)
     apply (erule if_live_then_nonz_capD' [rotated])
      apply (clarsimp simp: projectKOs)
-    apply (clarsimp simp: invs'_def)
+    apply (clarsimp simp: invs'_def valid_state'_def)
    apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def
                   field_simps ko_wp_at'_def ps_clear_def
                   cong:if_cong
                   split: option.splits)
-  apply (simp add: delete_locale_def deletionIsSafe_def sym_refs_asrt_def valid_idle'_asrt_def)
+  apply (simp add: delete_locale_def)
   done
 
 lemma deleteObjects_cap_to':
@@ -2251,14 +1839,14 @@ lemma deleteObjects_cap_to':
                          else ksPSpace s x\<rparr>)",erule ssubst)
     apply (simp add: field_simps ex_cte_cap_wp_to'_def cong:if_cong)
    apply simp
-  apply (simp add: delete_locale_def deletionIsSafe_def sym_refs_asrt_def valid_idle'_asrt_def)
+  apply (simp add: delete_locale_def)
   done
 
 lemma valid_untyped_no_overlap:
   "\<lbrakk> valid_untyped' d ptr bits idx s; is_aligned ptr bits; valid_pspace' s \<rbrakk>
   \<Longrightarrow> pspace_no_overlap' ptr bits (s\<lparr>ksPSpace := ksPSpace s |` (- {ptr .. ptr + 2 ^ bits - 1})\<rparr>)"
   apply (clarsimp simp del: atLeastAtMost_iff
-                  simp: pspace_no_overlap'_def valid_cap'_def valid_untyped'_def)
+            simp: pspace_no_overlap'_def valid_cap'_def valid_untyped'_def is_aligned_neg_mask_eq)
   apply (drule_tac x=x in spec)
   apply (drule restrict_map_Some_iff[THEN iffD1])
   apply clarsimp
@@ -2266,8 +1854,6 @@ lemma valid_untyped_no_overlap:
    apply (simp add: valid_pspace'_def)
   apply (frule pspace_distinctD')
    apply (simp add: valid_pspace'_def)
-  apply (frule pspace_boundedD')
-   apply (simp add: valid_pspace'_def)
   apply (unfold ko_wp_at'_def obj_range'_def)
   apply (drule (1) aligned_ranges_subset_or_disjoint)
   apply (clarsimp simp del: Int_atLeastAtMost atLeastAtMost_iff atLeastatMost_subset_iff)
@@ -2334,19 +1920,13 @@ lemma deleteObjects_invs_derivatives:
      and (\<lambda>s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s))
      and K (bits < word_bits \<and> is_aligned ptr bits)\<rbrace>
      deleteObjects ptr bits
-   \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
-  "\<lbrace>cte_wp_at' (\<lambda>c. cteCap c = UntypedCap d ptr bits idx) p
-     and invs' and ct_active' and sch_act_simple
-     and (\<lambda>s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s))
-     and K (bits < word_bits \<and> is_aligned ptr bits)\<rbrace>
-     deleteObjects ptr bits
-   \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
+   \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
   "\<lbrace>cte_wp_at' (\<lambda>c. cteCap c = UntypedCap d ptr bits idx) p
      and invs' and ct_active' and sch_act_simple
      and (\<lambda>s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s))
      and K (bits < word_bits \<and> is_aligned ptr bits)\<rbrace>
      deleteObjects ptr bits
-   \<lbrace>\<lambda>rv. pspace_bounded'\<rbrace>"
+   \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
   by (safe intro!: hoare_strengthen_post [OF deleteObjects_invs'])
 
 lemma deleteObjects_nosch:
@@ -2371,45 +1951,35 @@ definition pspace_no_overlap_cell' where
 
 lemma pspace_no_overlap'_lift:
   assumes typ_at:"\<And>slot P Q. \<lbrace>\<lambda>s. P (typ_at' Q slot s)\<rbrace> f \<lbrace>\<lambda>r s. P (typ_at' Q slot s) \<rbrace>"
-  assumes sz: "\<And>p n. \<lbrace>\<lambda>s. sc_at'_n n p s\<rbrace> f \<lbrace>\<lambda>rv s. sc_at'_n n p s\<rbrace>"
-  assumes ps :"\<lbrace>Q and pspace_aligned' and pspace_distinct' and pspace_bounded'\<rbrace>
-                  f \<lbrace>\<lambda>r s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>"
-  shows "\<lbrace>Q and pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz\<rbrace>
-                f \<lbrace>\<lambda>r. pspace_no_overlap' ptr sz\<rbrace>"
+  assumes ps :"\<lbrace>Q\<rbrace> f \<lbrace>\<lambda>r s. pspace_aligned' s \<and> pspace_distinct' s \<rbrace>"
+  shows "\<lbrace>Q and pspace_no_overlap' ptr sz \<rbrace> f \<lbrace>\<lambda>r. pspace_no_overlap' ptr sz\<rbrace>"
 proof -
-  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
+  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
   show ?thesis
     apply (clarsimp simp:valid_def pspace_no_overlap'_def)
     apply (drule_tac x = x in spec)
     apply (subgoal_tac "\<exists>ko'. ksPSpace s x = Some ko' \<and> koTypeOf ko = koTypeOf ko'")
-     apply (clarsimp, frule koType_objBitsKO; clarsimp)
-     apply (frule_tac p1=x and n1="objBitsKO ko'" in use_valid[OF _ sz])
-      apply (fastforce simp: ko_wp_at'_def dest: pspace_alignedD' pspace_distinctD' pspace_boundedD')
-     apply (clarsimp simp: ko_wp_at'_def)
+     apply (clarsimp dest!:objBits_type)
     apply (rule ccontr)
     apply clarsimp
     apply (frule_tac slot1 = x and Q1 = "koTypeOf ko" and P1 = "\<lambda>a. \<not> a" in use_valid[OF _ typ_at])
-     apply (clarsimp simp:typ_at'_def ko_wp_at'_def)+
-    apply (frule use_valid[OF _ ps])
-     apply (clarsimp simp:valid_pspace'_def)+
+    apply (clarsimp simp:typ_at'_def ko_wp_at'_def)+
+    apply (frule(1) use_valid[OF _ ps])
+    apply (clarsimp simp:valid_pspace'_def)
     apply (frule(1) pspace_alignedD')
-    apply (frule(1) pspace_distinctD')
-    apply (drule(1) pspace_boundedD')
+    apply (drule(1) pspace_distinctD')
     apply simp
-    done
+  done
 qed
 
-lemmas pspace_no_overlap'_lift2 = pspace_no_overlap'_lift[where Q=\<top>, simplified]
-
-crunch setCTE, insertNewCap
-  for sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (simp: crunch_simps wp: crunch_wps)
-
 lemma setCTE_pspace_no_overlap':
-  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz\<rbrace>
+  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\<rbrace>
    setCTE cte src
    \<lbrace>\<lambda>r. pspace_no_overlap' ptr sz\<rbrace>"
-   by (rule pspace_no_overlap'_lift2; wpsimp wp: setCTE_typ_at')
+   apply (rule pspace_no_overlap'_lift; wp setCTE_typ_at')
+   apply auto
+   done
 
 lemma getCTE_commute:
   assumes cte_at_modify:
@@ -2457,12 +2027,12 @@ qed
 
 definition "cte_check \<equiv> \<lambda>b src a next. (case b of
      KOTCB tcb \<Rightarrow> (is_aligned a (objBits tcb)
-        \<and> (case next of None \<Rightarrow> True | Some z \<Rightarrow> 2^objBits tcb \<le> z - a)) \<and>
+        \<and> (case next of None \<Rightarrow> True | Some z \<Rightarrow> 2^(objBits tcb) \<le> z - a)) \<and>
         (src - a = tcbVTableSlot << cteSizeBits
         \<or> src - a = tcbCTableSlot << cteSizeBits
-        \<or> src - a = tcbIPCBufferSlot << cteSizeBits
-        \<or> src - a = tcbFaultHandlerSlot << cteSizeBits
-        \<or> src - a = tcbTimeoutHandlerSlot << cteSizeBits)
+        \<or> src - a = tcbReplySlot << cteSizeBits
+        \<or> src - a = tcbCallerSlot << cteSizeBits
+        \<or> src - a = tcbIPCBufferSlot << cteSizeBits )
      | KOCTE v1 \<Rightarrow> ( src = a \<and> (is_aligned a (objBits (makeObject::cte)))
         \<and> (case next of None \<Rightarrow> True | Some z \<Rightarrow> 2^(objBits (makeObject::cte)) \<le> z - a))
      | _ \<Rightarrow> False)"
@@ -2478,11 +2048,11 @@ definition locateCTE where
 
 definition cte_update where
   "cte_update  \<equiv> \<lambda>cte b src a. (case b of
-     KOTCB tcb \<Rightarrow> if src - a = tcbVTableSlot << cteSizeBits then KOTCB (tcbVTable_update (\<lambda>_. cte) tcb)
-        else if src - a = tcbCTableSlot << cteSizeBits then KOTCB (tcbCTable_update (\<lambda>_. cte) tcb)
-        else if src - a = tcbIPCBufferSlot << cteSizeBits then KOTCB (tcbIPCBufferFrame_update (\<lambda>_. cte) tcb)
-        else if src - a = tcbFaultHandlerSlot << cteSizeBits then KOTCB (tcbFaultHandler_update (\<lambda>_. cte) tcb)
-        else if src - a = tcbTimeoutHandlerSlot << cteSizeBits then KOTCB (tcbTimeoutHandler_update (\<lambda>_. cte) tcb)
+     KOTCB tcb \<Rightarrow> if (src - a = tcbVTableSlot << cteSizeBits) then KOTCB (tcbVTable_update (\<lambda>_. cte) tcb)
+        else if (src - a = tcbCTableSlot << cteSizeBits) then KOTCB (tcbCTable_update (\<lambda>_. cte) tcb)
+        else if (src - a = tcbReplySlot << cteSizeBits) then KOTCB (tcbReply_update (\<lambda>_. cte) tcb)
+        else if (src - a = tcbCallerSlot << cteSizeBits) then KOTCB (tcbCaller_update (\<lambda>_. cte) tcb)
+        else if (src - a = tcbIPCBufferSlot << cteSizeBits) then KOTCB (tcbIPCBufferFrame_update (\<lambda>_. cte) tcb)
         else KOTCB tcb
      | KOCTE v1 \<Rightarrow> KOCTE cte
      | x \<Rightarrow> x)"
@@ -2492,15 +2062,21 @@ lemma simpler_updateObject_def:
    (\<lambda>s. (if (cte_check b src a next) then ({(cte_update cte b src a,s)}, False)
          else fail s))"
   apply (rule ext)
-  apply (clarsimp simp: ObjectInstances_H.updateObject_cte objBits_simps)
-  apply (case_tac b; simp add: cte_check_def typeError_def fail_def tcbSlot_defs cteSizeBits_def)
-  by (intro conjI;
-      clarsimp simp: alignCheck_def unless_def when_def not_less[symmetric]
-                     alignError_def is_aligned_mask magnitudeCheck_def assert_def
-                     cte_update_def return_def tcbSlot_defs objBits_simps cteSizeBits_def
-                     read_alignCheck_def ounless_def read_magnitudeCheck_def read_alignError_def
-               split:option.splits;
-      fastforce simp:return_def fail_def bind_def)+
+  apply (clarsimp simp:ObjectInstances_H.updateObject_cte objBits_simps)
+  apply (case_tac b)
+   apply (simp_all add:cte_check_def typeError_def fail_def
+          tcbIPCBufferSlot_def
+          tcbCallerSlot_def tcbReplySlot_def
+          tcbCTableSlot_def tcbVTableSlot_def)
+   by (intro conjI impI;
+        clarsimp simp:alignCheck_def unless_def when_def not_less[symmetric]
+         alignError_def is_aligned_mask magnitudeCheck_def
+         cte_update_def return_def tcbIPCBufferSlot_def
+         tcbCallerSlot_def tcbReplySlot_def
+         tcbCTableSlot_def tcbVTableSlot_def objBits_simps
+         cteSizeBits_def split:option.splits;
+          fastforce simp:return_def fail_def bind_def)+
+
 
 lemma setCTE_def2:
  "(setCTE src cte) =
@@ -2529,9 +2105,10 @@ lemma pspace_no_overlapD3':
 
 lemma singleton_locateCTE:
   "a \<in> fst (locateCTE src s) = ({a} = fst (locateCTE src s))"
-  apply (clarsimp simp: locateCTE_def assert_opt_def assert_def gets_def get_def bind_def return_def
-                        split_def)
-  apply (clarsimp simp: return_def fail_def split: if_splits option.splits)+
+  apply (clarsimp simp:locateCTE_def assert_opt_def assert_def
+    gets_def get_def bind_def return_def split_def)
+  apply (clarsimp simp:return_def fail_def
+    split:if_splits option.splits)+
   done
 
 lemma locateCTE_inv:
@@ -2552,19 +2129,35 @@ lemma locateCTE_case:
   done
 
 lemma cte_wp_at_top:
-  "cte_wp_at' \<top> src s
-   = (\<exists>a b. fst (lookupAround2 src (ksPSpace s)) = Some (a, b) \<and>
-            cte_check b src a (snd (lookupAround2 src (ksPSpace s))))"
-  apply (simp add: cte_wp_at'_def getObject_def gets_def get_def bind_def return_def split_def
-                   assert_opt_def fail_def gets_the_def readObject_def omonad_defs obind_def
-            split: option.splits)
-  apply (clarsimp simp: loadObject_cte)
-  by (case_tac b;
-      simp add: typeError_def read_typeError_def obind_def omonad_defs cte_check_def
-                read_alignCheck_def read_magnitudeCheck_def read_alignError_def is_aligned_mask
-                objBits_simps tcbSlot_defs cteSizeBits_def
-         split: option.split;
-      fastforce)
+  "(cte_wp_at' \<top> src s)
+  = (\<exists>a b. ( fst (lookupAround2 src (ksPSpace s)) = Some (a, b) \<and>
+  cte_check b src a (snd (lookupAround2 src (ksPSpace s)))))"
+  apply (simp add:cte_wp_at'_def getObject_def gets_def
+    get_def bind_def return_def split_def
+    assert_opt_def fail_def
+    split:option.splits)
+  apply (clarsimp simp:loadObject_cte)
+  apply (case_tac b,simp_all)
+       apply ((simp add: typeError_def fail_def cte_check_def
+                  split: Structures_H.kernel_object.splits)+)[5]
+    apply (simp add:loadObject_cte cte_check_def
+      tcbIPCBufferSlot_def tcbCallerSlot_def
+      tcbReplySlot_def tcbCTableSlot_def
+      tcbVTableSlot_def objBits_simps cteSizeBits_def)
+    apply (simp add:alignCheck_def bind_def
+      alignError_def fail_def return_def objBits_simps
+      magnitudeCheck_def in_monad is_aligned_mask
+      when_def unless_def split:option.splits)
+    apply (intro conjI impI allI,simp_all add:not_le)
+   apply (clarsimp simp:cte_check_def)
+   apply (simp add:alignCheck_def bind_def
+     alignError_def fail_def return_def objBits_simps
+     magnitudeCheck_def in_monad is_aligned_mask
+     when_def unless_def split:option.splits)
+    apply (intro conjI impI allI,simp_all add:not_le)
+  apply (simp add:typeError_def fail_def
+         cte_check_def split:Structures_H.kernel_object.splits)+
+  done
 
 lemma locateCTE_monad:
   assumes ko_wp_at: "\<And>Q dest.
@@ -2577,12 +2170,9 @@ lemma locateCTE_monad:
   "\<lbrace>\<lambda>s. P3 s \<rbrace> f \<lbrace>\<lambda>a s. pspace_distinct' s\<rbrace>"
   assumes psp_aligned:
   "\<lbrace>\<lambda>s. P4 s \<rbrace> f \<lbrace>\<lambda>a s. pspace_aligned' s\<rbrace>"
-  assumes psp_bounded:
-  "\<lbrace>\<lambda>s. P5 s \<rbrace> f \<lbrace>\<lambda>a s. pspace_bounded' s\<rbrace>"
   shows
   "\<lbrakk>{(ptr, s)} = fst (locateCTE src s);
-    (r, s') \<in> fst (f s);pspace_aligned' s;pspace_distinct' s; pspace_bounded' s;
-    (P1 and P2 and P3 and P4 and P5) s\<rbrakk>
+    (r, s') \<in> fst (f s);pspace_aligned' s;pspace_distinct' s;(P1 and P2 and P3 and P4) s\<rbrakk>
    \<Longrightarrow> {(ptr,s')} = fst (locateCTE src s')"
 proof -
   have src_in_range:
@@ -2591,16 +2181,20 @@ proof -
     fix obj src a m
     show "\<And>s'. \<lbrakk>cte_check obj src a m; ksPSpace s' a = Some obj\<rbrakk> \<Longrightarrow> src \<in> {a..a + 2 ^ objBitsKO obj - 1}"
       by (case_tac obj)
-         (auto simp add: cte_check_def objBits_simps' diff_eq_eq add.commute[where b=a]
-                         word_plus_mono_right is_aligned_no_wrap' tcbSlot_defs)
+         (auto simp add: cte_check_def objBits_simps' diff_eq_eq
+                         add.commute[where b=a]
+                         word_plus_mono_right is_aligned_no_wrap'
+                         tcbVTableSlot_def tcbCTableSlot_def tcbReplySlot_def
+                         tcbCallerSlot_def tcbIPCBufferSlot_def )
   qed
 
-  note blah[simp del] = usableUntypedRange.simps atLeastAtMost_simps
+  note blah[simp del] = usableUntypedRange.simps atLeastAtMost_iff
+          atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
 
   have step1:
     "\<lbrakk>(ptr, s) \<in> fst (locateCTE src s);
-      (r, s') \<in> fst (f s); pspace_aligned' s; pspace_distinct' s; pspace_bounded' s;
-      (P1 and P2 and P3 and P4 and P5) s\<rbrakk>
+      (r, s') \<in> fst (f s); pspace_aligned' s; pspace_distinct' s; (P1 and P2 and P3 and P4) s\<rbrakk>
      \<Longrightarrow> (ptr,s') \<in> fst (locateCTE src s')"
   apply (frule use_valid[OF _ locateCTE_case])
    apply simp
@@ -2616,7 +2210,6 @@ proof -
   apply (frule_tac dest1 = ptr and  Q1 = "\<lambda>x. x = objBitsKO b" in use_valid[OF _ ko_wp_at])
    apply (frule(1) pspace_alignedD')
    apply (frule(1) pspace_distinctD')
-   apply (frule(1) pspace_boundedD')
    apply (auto simp add:ko_wp_at'_def)[1]
   apply (clarsimp simp add:ko_wp_at'_def)
   apply (rule ccontr)
@@ -2624,8 +2217,6 @@ proof -
    apply simp
   apply (frule use_valid[OF _ psp_aligned])
    apply simp
-  apply (frule use_valid[OF _ psp_bounded])
-   apply simp
   apply (frule_tac x = a in pspace_distinctD')
    apply simp
   apply (frule_tac s = s' and a = ptr in rule_out_intv[rotated])
@@ -2638,11 +2229,10 @@ proof -
   apply (drule(1) src_in_range)+
   apply (drule base_member_set[OF pspace_alignedD'])
     apply simp
-   apply (simp add: word_bits_def)
-  apply (frule base_member_set[OF pspace_alignedD'])
+   apply (simp add:objBitsKO_bounded2[unfolded word_bits_def,simplified])
+  apply (drule base_member_set[OF pspace_alignedD'])
     apply simp
-   apply (fold word_bits_def)
-   apply (erule (1) pspace_boundedD')
+   apply (simp add:objBitsKO_bounded2[unfolded word_bits_def,simplified])
   apply (clarsimp simp: field_simps)
   apply (elim disjE; fastforce simp: mask_def p_assoc_help)
   done
@@ -2651,8 +2241,7 @@ proof -
     "(r, s') \<in> fst (f s)"
     "pspace_aligned' s"
     "pspace_distinct' s"
-    "pspace_bounded' s"
-    "(P1 and P2 and P3 and P4 and P5) s"
+    "(P1 and P2 and P3 and P4) s"
   thus ?thesis
   using assms step1
   by (clarsimp simp:singleton_locateCTE)
@@ -2672,17 +2261,14 @@ lemma locateCTE_commute:
   assumes nf: "no_fail P0 f" "no_fail P1 (locateCTE src)"
   and psp_distinct: "\<lbrace>\<lambda>s. P2 s \<rbrace> f \<lbrace>\<lambda>a s. pspace_distinct' s\<rbrace>"
   and psp_aligned: "\<lbrace>\<lambda>s. P3 s \<rbrace> f \<lbrace>\<lambda>a s. pspace_aligned' s\<rbrace>"
-  and psp_bounded: "\<lbrace>\<lambda>s. P4 s \<rbrace> f \<lbrace>\<lambda>a s. pspace_bounded' s\<rbrace>"
   assumes ko_wp_at: "\<And>Q dest.
   \<lbrace>\<lambda>s. (P0 and P1 and P2 and P3) s  \<and> ko_wp_at' (\<lambda>obj. Q (objBitsKO obj))  dest s \<rbrace> f
   \<lbrace>\<lambda>a s. ko_wp_at' (\<lambda>obj. Q (objBitsKO obj)) dest s\<rbrace>"
   and cte_wp_at: "\<And> dest.
   \<lbrace>\<lambda>s. (P0 and P1 and P2 and P3) s \<and> cte_wp_at' \<top> dest s \<rbrace> f
   \<lbrace>\<lambda>a s. cte_wp_at' \<top> dest s\<rbrace>"
-  shows "monad_commute
-           (P0 and P1 and P2 and P3 and P4 and P5
-                        and pspace_aligned' and pspace_distinct' and pspace_bounded')
-           (locateCTE src) f"
+  shows "monad_commute (P0 and P1 and P2 and P3 and P4 and P5 and pspace_aligned' and pspace_distinct')
+  (locateCTE src) f"
 proof -
   have same:
     "\<And>ptr val next s s'. (ptr, s') \<in> fst (locateCTE src s)
@@ -2697,7 +2283,7 @@ proof -
      apply (clarsimp)
      apply (rule bexI[rotated], assumption)
      apply (frule singleton_locateCTE[THEN iffD1])
-     apply (frule locateCTE_monad [OF ko_wp_at cte_wp_at psp_distinct psp_aligned psp_bounded])
+     apply (frule locateCTE_monad [OF ko_wp_at cte_wp_at psp_distinct psp_aligned])
          apply assumption+
       apply simp
      apply (clarsimp)
@@ -2713,7 +2299,7 @@ proof -
     apply (frule_tac s = s in same)
     apply clarsimp
     apply (frule_tac s1 = s in singleton_locateCTE[THEN iffD1])
-    apply (frule locateCTE_monad [OF ko_wp_at cte_wp_at psp_distinct psp_aligned psp_bounded])
+    apply (frule locateCTE_monad [OF ko_wp_at cte_wp_at psp_distinct psp_aligned])
         apply assumption+
      apply simp
     apply (rule bexI[rotated],assumption)
@@ -2735,7 +2321,7 @@ proof -
    apply (frule same)
    apply simp
    apply (frule singleton_locateCTE[THEN iffD1])
-   apply (frule locateCTE_monad [OF ko_wp_at cte_wp_at psp_distinct psp_aligned psp_bounded])
+   apply (frule locateCTE_monad [OF ko_wp_at cte_wp_at psp_distinct psp_aligned])
        apply assumption+
     apply simp
    apply (clarsimp)
@@ -2754,28 +2340,31 @@ lemma createObject_cte_wp_at':
   "\<lbrace>\<lambda>s. Types_H.getObjectSize ty us < word_bits \<and>
         is_aligned ptr (Types_H.getObjectSize ty us) \<and>
         pspace_no_overlap' ptr (Types_H.getObjectSize ty us) s \<and>
-        (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us) \<and>
-        cte_wp_at' (\<lambda>c. P c) slot s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>
+        cte_wp_at' (\<lambda>c. P c) slot s \<and> pspace_aligned' s \<and>
+        pspace_distinct' s\<rbrace>
    RetypeDecls_H.createObject ty ptr us d
    \<lbrace>\<lambda>r s. cte_wp_at' (\<lambda>c. P c) slot s \<rbrace>"
   apply (simp add:createObject_def)
   apply (rule hoare_pre)
-  by (wpc
-    | wp createObjects_orig_cte_wp_at'[where sz = "(Types_H.getObjectSize ty us)"]
-         threadSet_cte_wp_at'
-    | simp add: ARM_H.createObject_def placeNewDataObject_def unless_def placeNewObject_def2
-                objBits_simps range_cover_full curDomain_def pageBits_def ptBits_def pdBits_def
-                getObjSize_simps archObjSize_def apiGetObjectSize_def tcbBlockSizeBits_def
-                epSizeBits_def ntfnSizeBits_def scBits_simps cteSizeBits_def pteBits_def pdeBits_def
-    | intro conjI impI | clarsimp dest!: arch_toAPIType_simps)+
+   apply (wpc
+        | wp createObjects_orig_cte_wp_at'[where sz = "(Types_H.getObjectSize ty us)"]
+             threadSet_cte_wp_at'
+        | simp add: ARM_H.createObject_def placeNewDataObject_def
+                    unless_def placeNewObject_def2 objBits_simps range_cover_full
+                    curDomain_def pageBits_def ptBits_def
+                    pdBits_def getObjSize_simps archObjSize_def
+                    apiGetObjectSize_def tcbBlockSizeBits_def
+                    epSizeBits_def ntfnSizeBits_def
+                    cteSizeBits_def pteBits_def pdeBits_def
+        | intro conjI impI | clarsimp dest!: arch_toAPIType_simps)+
+  done
 
 lemma createObject_getCTE_commute:
   "monad_commute
-     (cte_wp_at' (\<lambda>_. True) dests and pspace_aligned' and pspace_distinct' and pspace_bounded' and
+     (cte_wp_at' (\<lambda>_. True) dests and pspace_aligned' and pspace_distinct' and
       pspace_no_overlap' ptr (Types_H.getObjectSize ty us) and
       K (ptr \<noteq> dests) and K (Types_H.getObjectSize ty us < word_bits) and
-      K (is_aligned ptr (Types_H.getObjectSize ty us)) and
-      K (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us))
+      K (is_aligned ptr (Types_H.getObjectSize ty us)))
      (RetypeDecls_H.createObject ty ptr us d) (getCTE dests)"
   apply (rule monad_commute_guard_imp[OF commute_commute])
    apply (rule getCTE_commute)
@@ -2803,7 +2392,7 @@ lemma simpler_placeNewObject_def:
     apply clarsimp
     apply (drule(1) pspace_alignedD')
     apply (simp add:is_aligned_no_overflow)
-   apply (clarsimp simp: shiftL_nat p_assoc_help)
+   apply (clarsimp simp: is_aligned_neg_mask_eq shiftL_nat p_assoc_help)
   apply simp
   done
 
@@ -2812,17 +2401,15 @@ lemma fail_set: "fst (fail s) = {}"
 
 lemma locateCTE_cte_no_fail:
  "no_fail (cte_at' src) (locateCTE src)"
-  apply (clarsimp simp: no_fail_def cte_wp_at'_def getObject_def
-                        locateCTE_def return_def gets_def get_def bind_def split_def
-                        gets_the_def readObject_def omonad_defs obind_def
-                        assert_opt_def assert_def fail_set
-                 split: option.splits)
+  apply (clarsimp simp:no_fail_def cte_wp_at'_def getObject_def
+     locateCTE_def return_def gets_def get_def bind_def split_def
+     assert_opt_def assert_def in_fail fail_set split:option.splits)
   apply (clarsimp simp:cte_check_def ObjectInstances_H.loadObject_cte)
+  apply (drule in_singleton)
   by (auto simp: objBits_simps cteSizeBits_def alignError_def
-                 alignCheck_def in_monad is_aligned_mask magnitudeCheck_def
-                 typeError_def read_typeError_def read_magnitudeCheck_def
-                 ohaskell_fail_def ohaskell_assert_def
-           cong: if_cong split: if_splits option.splits kernel_object.splits)
+    alignCheck_def in_monad is_aligned_mask magnitudeCheck_def
+    typeError_def
+    cong: if_cong split: if_splits option.splits kernel_object.splits)
 
 lemma not_in_new_cap_addrs:
   "\<lbrakk>is_aligned ptr (objBitsKO obj + us);
@@ -2849,14 +2436,14 @@ lemma not_in_new_cap_addrs:
 lemma placeNewObject_pspace_aligned':
   "\<lbrace>K (is_aligned ptr (objBitsKO (injectKOS val) + us) \<and>
         objBitsKO (injectKOS val) + us < word_bits) and
-    pspace_aligned' and pspace_distinct' and pspace_bounded' and
+    pspace_aligned' and pspace_distinct' and
     pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us)\<rbrace>
    placeNewObject ptr val us
    \<lbrace>\<lambda>r s. pspace_aligned' s\<rbrace>"
   apply (clarsimp simp:valid_def)
   apply (simp add:simpler_placeNewObject_def simpler_modify_def)
   apply (subst data_map_insert_def[symmetric])+
-  apply (erule (3) Retype_R.retype_aligned_distinct' [unfolded data_map_insert_def[symmetric]])
+  apply (erule(2) Retype_R.retype_aligned_distinct' [unfolded data_map_insert_def[symmetric]])
   apply (rule range_cover_rel[OF range_cover_full])
      apply simp+
   done
@@ -2865,28 +2452,14 @@ lemma placeNewObject_pspace_distinct':
   "\<lbrace>\<lambda>s. objBitsKO (injectKOS val) + us < word_bits \<and>
         is_aligned ptr (objBitsKO (injectKOS val) + us) \<and>
         pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us) s \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>
+        pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
    placeNewObject ptr val us
    \<lbrace>\<lambda>a. pspace_distinct'\<rbrace>"
  apply (clarsimp simp:valid_def)
   apply (simp add:simpler_placeNewObject_def simpler_modify_def)
  apply (subst data_map_insert_def[symmetric])+
- apply (erule (3) Retype_R.retype_aligned_distinct'[unfolded data_map_insert_def[symmetric]])
- apply (rule range_cover_rel[OF range_cover_full])
-  apply simp+
- done
-
-lemma placeNewObject_pspace_bounded':
-  "\<lbrace>\<lambda>s. objBitsKO (injectKOS val) + us < word_bits \<and>
-        is_aligned ptr (objBitsKO (injectKOS val) + us) \<and>
-        pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us) s \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>
-   placeNewObject ptr val us
-   \<lbrace>\<lambda>a. pspace_bounded'\<rbrace>"
- apply (clarsimp simp:valid_def)
-  apply (simp add:simpler_placeNewObject_def simpler_modify_def)
- apply (subst data_map_insert_def[symmetric])+
- apply (erule (3) Retype_R.retype_aligned_distinct'[unfolded data_map_insert_def[symmetric]])
+ apply (erule(2) Retype_R.retype_aligned_distinct'
+   [unfolded data_map_insert_def[symmetric]])
  apply (rule range_cover_rel[OF range_cover_full])
   apply simp+
  done
@@ -2898,7 +2471,7 @@ lemma placeNewObject_ko_wp_at':
         objBitsKO (injectKOS val) + us < word_bits \<and>
         is_aligned ptr (objBitsKO (injectKOS val) + us) \<and>
         pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us) s \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>
+        pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
    placeNewObject ptr val us
    \<lbrace>\<lambda>a. ko_wp_at' P slot\<rbrace>"
   apply (clarsimp simp:valid_def split del:if_split)
@@ -2937,7 +2510,7 @@ lemma placeNewObject_cte_wp_at':
   "\<lbrace>K (is_aligned ptr (objBitsKO (injectKOS val) + us) \<and>
        objBitsKO (injectKOS val) + us < word_bits) and
     K (ptr \<noteq> src) and cte_wp_at' P src and
-    pspace_aligned' and pspace_distinct' and pspace_bounded' and
+    pspace_aligned' and pspace_distinct' and
     pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us)\<rbrace>
    placeNewObject ptr val us
    \<lbrace>\<lambda>r s. cte_wp_at' P src s\<rbrace>"
@@ -2952,7 +2525,7 @@ lemma placeNewObject_cte_wp_at'':
   objBitsKO (injectKOS val) + us < word_bits \<and>
   is_aligned ptr (objBitsKO (injectKOS val) + us) \<and>
   pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us) s \<and>
-  pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>
+  pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
   placeNewObject ptr val us \<lbrace>\<lambda>a s. cte_wp_at' P slot s\<rbrace>"
   apply (simp add:cte_wp_at_cases_mask' obj_at'_real_def)
   apply (wp hoare_vcg_disj_lift placeNewObject_ko_wp_at')
@@ -2982,14 +2555,13 @@ lemma placeNewObject_locateCTE_commute:
      (K (is_aligned ptr (objBitsKO (injectKOS val) + us) \<and>
          (objBitsKO (injectKOS val) + us) < word_bits \<and> ptr \<noteq> src) and
       pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us) and
-      pspace_aligned' and pspace_distinct' and pspace_bounded' and cte_at' src)
+      pspace_aligned' and pspace_distinct' and cte_at' src)
      (placeNewObject ptr val us) (locateCTE src)"
   apply (rule monad_commute_guard_imp)
   apply (rule commute_commute[OF locateCTE_commute])
       apply (wp no_fail_placeNewObject locateCTE_cte_no_fail
         placeNewObject_pspace_aligned'
         placeNewObject_pspace_distinct'
-        placeNewObject_pspace_bounded'
         placeNewObject_ko_wp_at' | simp)+
     apply (clarsimp simp:ko_wp_at'_def)
     apply (drule(3) not_in_new_cap_addrs)
@@ -3054,7 +2626,8 @@ lemma placeNewObject_modify_commute:
     apply simp
    apply (drule_tac x = ptr' in in_empty_interE)
      apply (clarsimp simp:is_aligned_no_overflow)
-    apply (clarsimp simp:range_cover_def ptr_add_def obj_range'_def p_assoc_help)
+    apply (clarsimp simp:range_cover_def ptr_add_def
+     is_aligned_neg_mask_eq obj_range'_def p_assoc_help)
    apply simp
   done
 
@@ -3080,9 +2653,9 @@ lemma locateCTE_ko_wp_at':
    \<lbrace>\<lambda>rv. ko_wp_at' \<top> rv \<rbrace>"
   apply (clarsimp simp:locateCTE_def split_def)
   apply wp
-  apply (clarsimp simp: cte_wp_at'_def getObject_def gets_the_def  obind_def omonad_defs
-                        gets_def split_def get_def bind_def return_def readObject_def
-                        ko_wp_at'_def lookupAround2_char1 assert_opt_def)
+  apply (clarsimp simp:cte_wp_at'_def getObject_def
+    gets_def split_def get_def bind_def return_def
+    ko_wp_at'_def lookupAround2_char1 assert_opt_def)
   apply (clarsimp split:option.splits
     simp:fail_def return_def lookupAround2_char1)
   apply (case_tac ba)
@@ -3090,10 +2663,10 @@ lemma locateCTE_ko_wp_at':
     apply (clarsimp simp:lookupAround2_char1
       objBits_simps cte_update_def)
     apply (drule(1) pspace_distinctD')+
-    apply (simp add: objBits_simps' word_bits_def)
+    apply (simp add:objBits_simps)
   apply (clarsimp simp:objBits_simps cte_update_def)
   apply (drule(1) pspace_distinctD')+
-  apply (simp add: objBits_simps' word_bits_def)
+  apply (simp add:objBits_simps)
   done
 
 
@@ -3102,7 +2675,7 @@ lemma setCTE_placeNewObject_commute:
      (K (is_aligned ptr (objBitsKO (injectKOS val) + us) \<and>
          objBitsKO (injectKOS val) + us < word_bits) and
       K(ptr \<noteq> src) and cte_wp_at' (\<lambda>_. True) src and
-      pspace_aligned' and pspace_distinct' and pspace_bounded' and
+      pspace_aligned' and pspace_distinct' and
       pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us))
      (setCTE src cte) (placeNewObject ptr val us)"
   apply (clarsimp simp: setCTE_def2 split_def)
@@ -3122,29 +2695,65 @@ lemma doMachineOp_upd_heap_commute:
   done
 
 lemma magnitudeCheck_det:
-  "\<lbrakk>ksPSpace s ptr = Some ko; is_aligned ptr (objBitsKO ko); objBitsKO ko < word_bits;
+  "\<lbrakk>ksPSpace s ptr = Some ko; is_aligned ptr (objBitsKO ko);
     ps_clear ptr (objBitsKO ko) s\<rbrakk>
-   \<Longrightarrow> magnitudeCheck ptr (snd (lookupAround2 ptr (ksPSpace s))) (objBitsKO ko) s =
+   \<Longrightarrow> magnitudeCheck ptr (snd (lookupAround2 ptr (ksPSpace s)))
+                          (objBitsKO ko) s =
        ({((), s)},False)"
-  apply (frule in_magnitude_check'[THEN iffD2]; simp)
-  apply (subgoal_tac "\<not> snd (magnitudeCheck ptr (snd (lookupAround2 ptr (ksPSpace s))) (objBitsKO ko) s)")
+  apply (frule in_magnitude_check'[THEN iffD2])
+   apply (case_tac ko)
+     apply (simp add: objBits_simps' pageBits_def)+
+    apply (rename_tac arch_kernel_object)
+    apply (case_tac arch_kernel_object)
+     apply (simp add:archObjSize_def pageBits_def pteBits_def pdeBits_def)+
+  apply (subgoal_tac
+    "\<not> snd (magnitudeCheck ptr (snd (lookupAround2 ptr (ksPSpace s))) (objBitsKO ko) s)")
    apply (drule singleton_in_magnitude_check)
    apply (drule_tac x = s in spec)
-   apply (case_tac "(magnitudeCheck ptr (snd (lookupAround2 ptr (ksPSpace s))) (objBitsKO ko) s)")
-   apply simp
+   apply (case_tac
+    "(magnitudeCheck ptr (snd (lookupAround2 ptr (ksPSpace s))) (objBitsKO ko) s)")
+    apply simp
   apply (rule ccontr)
-  apply (clarsimp simp: magnitudeCheck_assert assert_def fail_def return_def
-                  split: if_splits option.splits)
+  apply (clarsimp simp:magnitudeCheck_assert assert_def fail_def return_def
+    split:if_splits option.splits)
   done
 
 lemma getPDE_det:
   "ko_wp_at' ((=) (KOArch (KOPDE pde))) p s
    \<Longrightarrow> getObject p s = ({((pde::ARM_H.pde),s)},False)"
-  by (clarsimp simp: getObject_def split_def gets_the_def ko_wp_at'_def obj_at'_def
-                     bind_def gets_def return_def get_def projectKOs
-                     assert_opt_def fail_def typ_at'_def
-                     no_ofailD[OF no_ofail_pde_at'_readObject]
-              split: if_splits option.splits)
+  apply (clarsimp simp:ko_wp_at'_def getObject_def split_def
+                       bind_def gets_def return_def get_def
+                       assert_opt_def split:if_splits)
+
+  apply (clarsimp simp: fail_def return_def lookupAround2_known1)
+   apply (simp add: loadObject_default_def)
+  apply (clarsimp simp:projectKO_def projectKO_opt_pde alignCheck_def
+    is_aligned_mask objBits_simps unless_def)
+  apply (clarsimp simp:bind_def return_def)
+  apply (intro conjI)
+   apply (intro set_eqI iffI)
+    apply clarsimp
+    apply (subst (asm) in_magnitude_check')
+     apply (simp add:archObjSize_def is_aligned_mask pteBits_def pdeBits_def)+
+    apply (rule bexI[rotated])
+     apply (rule in_magnitude_check'[THEN iffD2])
+      apply (simp add:is_aligned_mask)+
+   apply (clarsimp simp:image_def)
+  apply (clarsimp simp:magnitudeCheck_assert assert_def
+    objBits_def archObjSize_def
+    return_def fail_def lookupAround2_char2 split:option.splits if_split_asm)
+  apply (rule ccontr)
+  apply (simp add:ps_clear_def field_simps pteBits_def pdeBits_def)
+  apply (erule_tac x = x2 in in_empty_interE)
+   apply (clarsimp simp:less_imp_le)
+   apply (rule conjI)
+    apply (subst add.commute)
+    apply (rule word_diff_ls')
+     apply (clarsimp simp: not_le plus_one_helper)
+    apply (subst add.commute)
+    apply (simp add: is_aligned_no_wrap' is_aligned_mask)
+  apply auto
+  done
 
 lemma in_dom_eq:
   "m a = Some obj \<Longrightarrow> dom (\<lambda>b. if b = a then Some g else m b) = dom m"
@@ -3223,7 +2832,7 @@ lemma getPDE_doMachineOp_commute:
 
 lemma getPDE_placeNewObject_commute:
   "monad_commute
-     (pde_at' src and pspace_distinct' and pspace_aligned' and pspace_bounded' and
+     (pde_at' src and pspace_distinct' and pspace_aligned' and
       pspace_no_overlap' ptr (objBitsKO (injectKOS val) + sz) and
       K (is_aligned ptr (objBitsKO (injectKOS val) + sz) \<and>
          objBitsKO (injectKOS val) + sz < word_bits) )
@@ -3259,15 +2868,15 @@ lemma storePDE_det:
    \<Longrightarrow> storePDE ptr (new_pde::ARM_H.pde) s =
        modify
          (ksPSpace_update (\<lambda>_. (ksPSpace s)(ptr \<mapsto> KOArch (KOPDE new_pde)))) s"
-  apply (clarsimp simp: ko_wp_at'_def storePDE_def split_def
-                        bind_def gets_def return_def
-                        get_def setObject_def
-                        assert_opt_def split:if_splits)
-  apply (clarsimp simp: lookupAround2_known1 return_def alignCheck_def
-                        updateObject_default_def split_def gets_the_def
-                        archObjSize_def unless_def projectKO_def read_alignCheck_def
-                        projectKO_opt_pde bind_def when_def omonad_defs
-                        is_aligned_mask[symmetric] objBits_simps)
+  apply (clarsimp simp:ko_wp_at'_def storePDE_def split_def
+                       bind_def gets_def return_def
+                       get_def setObject_def
+                       assert_opt_def split:if_splits)
+  apply (clarsimp simp:lookupAround2_known1 return_def alignCheck_def
+                       updateObject_default_def split_def
+                       archObjSize_def unless_def projectKO_def
+                       projectKO_opt_pde bind_def when_def
+                       is_aligned_mask[symmetric] objBits_simps)
   apply (drule magnitudeCheck_det)
     apply (simp add:objBits_simps archObjSize_def)+
   apply (simp add:simpler_modify_def)
@@ -3350,28 +2959,13 @@ lemma modify_pde_pspace_aligned':
   apply simp
   done
 
-lemma modify_pde_pspace_bounded':
-  "\<lbrace>pde_at' ptr and pspace_bounded'\<rbrace>
-   modify (ksPSpace_update (\<lambda>ps. ps(ptr \<mapsto> KOArch (KOPDE new_pde))))
-   \<lbrace>\<lambda>a. pspace_bounded'\<rbrace>"
-  apply (clarsimp simp: simpler_modify_def ko_wp_at'_def valid_def typ_at'_def)
-  apply (case_tac ko,simp_all)
-  apply (rename_tac arch_kernel_object)
-  apply (case_tac arch_kernel_object,simp_all)
-  apply (subst pspace_bounded'_def)
-  apply (intro ballI)
-  apply (erule domE)
-  apply (clarsimp split:if_splits)
-   apply (simp add:objBits_simps archObjSize_def)
-  apply (fastforce dest!: pspace_boundedD')
-  done
-
 lemma modify_pde_psp_no_overlap':
   "\<lbrace>pde_at' ptr and pspace_no_overlap' ptr' sz\<rbrace>
    modify (ksPSpace_update (\<lambda>ps. ps(ptr \<mapsto> KOArch (KOPDE new_pde))))
    \<lbrace>\<lambda>a. pspace_no_overlap' ptr' sz\<rbrace>"
   proof -
-  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
+  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
   show ?thesis
   apply (clarsimp simp:simpler_modify_def ko_wp_at'_def
     valid_def typ_at'_def)
@@ -3454,7 +3048,7 @@ lemma doMachineOp_storePDE_commute:
 
 lemma storePDE_placeNewObject_commute:
   "monad_commute
-     (pde_at' src and pspace_distinct' and pspace_aligned' and pspace_bounded' and
+     (pde_at' src and pspace_distinct' and pspace_aligned' and
       pspace_no_overlap' ptr (objBitsKO (injectKOS val) + sz) and
       K (is_aligned ptr (objBitsKO (injectKOS val) + sz) \<and>
       objBitsKO (injectKOS val) + sz < word_bits) )
@@ -3516,7 +3110,9 @@ lemma modify_obj_commute':
   done
 
 lemma cte_wp_at_modify_pde:
-  notes blah[simp del] =  atLeastAtMost_simps
+  notes blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
   shows
   "\<lbrakk>ksPSpace s ptr' = Some (KOArch (KOPDE pde)); pspace_aligned' s;cte_wp_at' \<top> ptr s\<rbrakk>
        \<Longrightarrow> cte_wp_at' \<top> ptr (s\<lparr>ksPSpace := (ksPSpace s)(ptr' \<mapsto> (KOArch (KOPDE pde')))\<rparr>)"
@@ -3526,9 +3122,11 @@ lemma cte_wp_at_modify_pde:
    apply (rule disjI1)
    apply (clarsimp simp add:ko_wp_at'_def)
    apply (intro conjI impI)
-       apply (simp add:objBits_simps archObjSize_def)
-      apply (clarsimp simp:projectKO_opt_cte)
-     apply (clarsimp simp: ps_clear_def objBits_simps archObjSize_def)+
+      apply (simp add:objBits_simps archObjSize_def)
+     apply (clarsimp simp:projectKO_opt_cte)
+    apply (simp add:ps_clear_def)+
+    apply (clarsimp simp:objBits_simps archObjSize_def)
+   apply (simp add:ps_clear_def)
    apply (rule ccontr)
    apply simp
    apply (erule in_emptyE, blast)
@@ -3536,9 +3134,11 @@ lemma cte_wp_at_modify_pde:
   apply (rule disjI2)
   apply (clarsimp simp:ko_wp_at'_def)
   apply (intro conjI impI)
-      apply (simp add:objBits_simps archObjSize_def)+
-     apply (clarsimp simp:projectKO_opt_cte projectKO_opt_tcb)
-    apply (clarsimp simp: ps_clear_def objBits_simps archObjSize_def)+
+     apply (simp add:objBits_simps archObjSize_def)+
+    apply (clarsimp simp:projectKO_opt_cte projectKO_opt_tcb)
+    apply (simp add:ps_clear_def)+
+   apply (clarsimp simp:objBits_simps archObjSize_def)
+  apply (simp add:ps_clear_def)
   apply (rule ccontr)
   apply simp
   apply (erule in_emptyE)
@@ -3546,9 +3146,11 @@ lemma cte_wp_at_modify_pde:
   done
 
 lemma storePDE_setCTE_commute:
-  notes blah[simp del] =  atLeastAtMost_simps
+  notes blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
   shows "monad_commute
-     (pde_at' ptr and pspace_distinct' and pspace_aligned' and pspace_bounded' and
+     (pde_at' ptr and pspace_distinct' and pspace_aligned' and
       cte_wp_at' (\<lambda>_. True) src)
      (setCTE src cte) (storePDE ptr (new_pde::ARM_H.pde))"
   apply (rule commute_name_pre_state)
@@ -3570,38 +3172,33 @@ lemma storePDE_setCTE_commute:
    apply (rule monad_commute_split)
      apply (subst modify_specify)
      apply (rule modify_obj_commute')
-    apply (subst modify_specify)
     apply (rule commute_commute[OF locateCTE_commute])
-          apply (rule no_fail_modify)
-         apply (rule locateCTE_cte_no_fail)
-        apply (rule modify_pde_pspace_distinct')
-       apply (rule modify_pde_pspace_aligned')
-      apply (rule modify_pde_pspace_bounded')
-     apply (wpsimp wp: modify_wp)
-     apply (case_tac "dest = ptr"; clarsimp?)
-      apply (subst non_sc_same_typ_at'_ko_wp_at'_set_ko'_iff[unfolded unfold_set_ko',
-                                                             unfolded fun_upd_def];
-             force?)
-      apply (clarsimp simp: ko_wp_at'_def typ_at'_def)
-      apply (erule_tac P=Q in rsubst)
-      apply (rule koType_objBitsKO; simp)
-     apply (subst ko_wp_at'_set_ko'_distinct[simplified unfold_set_ko',
-                                                   unfolded fun_upd_def];
-            clarsimp simp: ko_wp_at'_def typ_at'_def)
-    apply (clarsimp simp: simpler_modify_def valid_def)
-    apply (frule typ_at'_ksPSpace_exI, clarsimp)
-    apply (rule cte_wp_at_modify_pde[unfolded unfold_set_ko']; simp)
+         apply (wp locateCTE_cte_no_fail no_fail_modify
+                   modify_pde_pspace_distinct'
+                   modify_pde_pspace_aligned'| subst modify_specify)+
+     apply (clarsimp simp:simpler_modify_def valid_def typ_at'_def)
+     apply (clarsimp simp:ko_wp_at'_def dest!: koTypeOf_pde)
+     apply (intro conjI impI)
+        apply (clarsimp simp:objBits_simps archObjSize_def)+
+      apply (simp add:ps_clear_def in_dom_eq)
+     apply (simp add:ps_clear_def in_dom_eq)
+    apply (clarsimp simp:simpler_modify_def valid_def)
+    apply (clarsimp simp:typ_at'_def ko_wp_at'_def)
+    apply (case_tac ko,simp_all add:koTypeOf_def )[1]
+    apply (rename_tac arch_kernel_object)
+    apply (case_tac arch_kernel_object,simp_all add:archTypeOf_def)[1]
+    apply (erule(2) cte_wp_at_modify_pde)
    apply wp
    apply (thin_tac "cte_wp_at' P src s" for P s)+
    apply (clarsimp simp: typ_at'_def cte_wp_at_obj_cases_mask obj_at'_real_def)
    apply (wp locateCTE_ret_neq locateCTE_ko_wp_at')
-  apply (clarsimp simp: ko_wp_at'_def objBits_simps archObjSize_def typ_at'_def)
+  apply (clarsimp simp:ko_wp_at'_def objBits_simps archObjSize_def typ_at'_def)
   apply fastforce
   done
 
 lemma setCTE_gets_globalPD_commute:
   "monad_commute
-     (cte_wp_at' (\<lambda>_. True) src and pspace_distinct' and pspace_aligned' and pspace_bounded')
+     (cte_wp_at' (\<lambda>_. True) src and pspace_distinct' and pspace_aligned')
      (setCTE src cte) (gets (armKSGlobalPD \<circ> ksArchState))"
   apply (simp add:setCTE_def2)
   apply (rule monad_commute_guard_imp)
@@ -3611,6 +3208,7 @@ lemma setCTE_gets_globalPD_commute:
          apply (wp locateCTE_cte_no_fail)+
      apply clarsimp
     apply (wp|clarsimp)+
+  apply fastforce
   done
 
 lemma placeNewObject_gets_globalPD_commute:
@@ -3634,7 +3232,7 @@ lemma placeNewObject_gets_globalPD_commute:
 
 lemma copyGlobalMappings_setCTE_commute:
   "monad_commute
-     (valid_arch_state' and pspace_distinct' and pspace_aligned' and pspace_bounded' and
+     (valid_arch_state' and pspace_distinct' and pspace_aligned' and
       cte_wp_at' (\<lambda>_. True) src and page_directory_at' ptr)
      (copyGlobalMappings ptr) (setCTE src cte)"
   apply (clarsimp simp:copyGlobalMappings_def)
@@ -3653,15 +3251,9 @@ lemma copyGlobalMappings_setCTE_commute:
   apply (clarsimp simp: pteBits_def pdeBits_def)
   done
 
-lemma dmo_bounded'[wp]:
-  "doMachineOp f \<lbrace>pspace_bounded'\<rbrace>"
-  apply (simp add: doMachineOp_def split_def)
-  apply wpsimp
-  done
-
 lemma setCTE_doMachineOp_commute:
   assumes nf: "no_fail Q (doMachineOp x)"
-  shows "monad_commute (cte_at' dest and pspace_aligned' and pspace_distinct' and pspace_bounded' and Q)
+  shows "monad_commute (cte_at' dest and pspace_aligned' and pspace_distinct' and Q)
   (setCTE dest cte)
   (doMachineOp x)"
   apply (simp add:setCTE_def2 split_def)
@@ -3674,10 +3266,21 @@ lemma setCTE_doMachineOp_commute:
   apply (wp|clarsimp|fastforce)+
   done
 
+lemma setCTE_when_doMachineOp_commute:
+  assumes nf: "no_fail Q (doMachineOp x)"
+  shows "monad_commute (cte_at' dest and pspace_aligned' and pspace_distinct' and Q)
+  (setCTE dest cte)
+  (when P (doMachineOp x))"
+  apply (cases P; simp add: setCTE_doMachineOp_commute nf)
+  apply (rule monad_commute_guard_imp)
+   apply (rule return_commute[THEN commute_commute])
+  apply simp
+  done
+
 lemma placeNewObject_valid_arch_state:
   "\<lbrace>valid_arch_state' and
     pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us) and
-    pspace_aligned' and pspace_distinct' and pspace_bounded' and
+    pspace_aligned' and pspace_distinct' and
     K (is_aligned ptr (objBitsKO (injectKOS val) + us)) and
     K ( (objBitsKO (injectKOS val)+ us)< word_bits)\<rbrace>
    placeNewObject ptr val us
@@ -3692,7 +3295,7 @@ lemma placeNewObject_valid_arch_state:
 
 lemma placeNewObject_pd_at':
   "\<lbrace>K (is_aligned ptr pdBits) and pspace_no_overlap' ptr pdBits and
-    pspace_aligned' and pspace_distinct' and pspace_bounded'\<rbrace>
+    pspace_aligned' and pspace_distinct'\<rbrace>
    placeNewObject ptr (makeObject::ARM_H.pde)
                       (pdBits - objBits (makeObject::ARM_H.pde))
    \<lbrace>\<lambda>rv s. page_directory_at' ptr s\<rbrace>"
@@ -3729,10 +3332,39 @@ lemma setCTE_modify_gsUserPages_commute:
 lemma getTCB_det:
   "ko_wp_at' ((=) (KOTCB tcb)) p s
    \<Longrightarrow> getObject p s = ({(tcb,s)},False)"
-  by (clarsimp simp: ko_wp_at'_def getObject_def split_def gets_the_def
-                     bind_def gets_def return_def get_def fail_def assert_opt_def
-                     no_ofailD[OF no_ofail_tcb_at'_readObject] obj_at'_def projectKOs
-              split: if_splits option.split dest!: readObject_misc_ko_at')
+  apply (clarsimp simp:ko_wp_at'_def getObject_def split_def
+                       bind_def gets_def return_def get_def
+                       assert_opt_def split:if_splits)
+  apply (clarsimp simp: fail_def return_def lookupAround2_known1)
+   apply (simp add:loadObject_default_def)
+  apply (clarsimp simp:projectKO_def projectKO_opt_tcb alignCheck_def
+    is_aligned_mask objBits_simps' unless_def)
+  apply (clarsimp simp:bind_def return_def)
+  apply (intro conjI)
+   apply (intro set_eqI iffI)
+    apply clarsimp
+    apply (subst (asm) in_magnitude_check')
+     apply (simp add:archObjSize_def is_aligned_mask)+
+    apply (rule bexI[rotated])
+     apply (rule in_magnitude_check'[THEN iffD2])
+      apply (simp add:is_aligned_mask)+
+   apply (clarsimp simp:image_def)
+  apply (clarsimp simp:magnitudeCheck_assert assert_def
+    objBits_def archObjSize_def
+    return_def fail_def lookupAround2_char2 split:option.splits if_split_asm)
+  apply (rule ccontr)
+  apply (simp add:ps_clear_def field_simps)
+  apply (erule_tac x = x2 in in_empty_interE)
+   apply (clarsimp simp:less_imp_le)
+   apply (rule conjI)
+    apply (subst add.commute)
+    apply (rule word_diff_ls')
+     apply (clarsimp simp:field_simps not_le plus_one_helper)
+    apply (subst add.commute)
+    apply (simp add: is_aligned_no_wrap' is_aligned_mask)
+   apply simp
+  apply auto
+  done
 
 lemma threadSet_det:
   "tcb_at' ptr s
@@ -3746,10 +3378,10 @@ lemma threadSet_det:
   apply (clarsimp simp:setObject_def gets_def get_def)
   apply (subst bind_def)
   apply (clarsimp simp:split_def)
-  apply (simp add:lookupAround2_known1 bind_assoc projectKO_def gets_the_def
-    assert_opt_def updateObject_default_def projectKO_opt_tcb omonad_defs)
-  apply (clarsimp simp: read_alignCheck_def omonad_defs
-    alignCheck_def unless_def when_def gets_the_def
+  apply (simp add:lookupAround2_known1 bind_assoc projectKO_def
+    assert_opt_def updateObject_default_def projectKO_opt_tcb)
+  apply (clarsimp simp add:
+    alignCheck_def unless_def when_def
     is_aligned_mask objBits_simps)
   apply (clarsimp simp:magnitudeCheck_det bind_def)
   apply (cut_tac ko = "KOTCB obj" in magnitudeCheck_det)
@@ -3760,11 +3392,12 @@ lemma threadSet_det:
 
 lemma setCTE_modify_tcbDomain_commute:
  " monad_commute
-    (tcb_at' ptr and cte_wp_at' (\<lambda>_. True) src and pspace_distinct' and pspace_aligned' and pspace_bounded')
-    (setCTE src cte)
+    (tcb_at' ptr and cte_wp_at' (\<lambda>_. True) src and pspace_distinct' and pspace_aligned') (setCTE src cte)
     (threadSet (tcbDomain_update (\<lambda>_. ra)) ptr)"
   proof -
-    note blah[simp del] =  atLeastAtMost_simps
+    note blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
 
     have hint:
       "\<And>P ptr a cte b src ra. monad_commute (tcb_at' ptr and ko_wp_at' P a )
@@ -3777,16 +3410,15 @@ lemma setCTE_modify_tcbDomain_commute:
       prefer 2
        apply (clarsimp simp:obj_at'_def)
        apply (intro conjI impI)
-            apply simp
-           apply (clarsimp simp: projectKO_eq projectKO_opt_tcb
-                          split: Structures_H.kernel_object.split_asm)
-           apply (simp add:cte_update_def)
-          apply (clarsimp simp: projectKO_eq projectKO_opt_tcb
-                         split: Structures_H.kernel_object.split_asm)
-          apply (simp add:ps_clear_def)
-         apply clarsimp
-        apply (clarsimp simp: projectKO_eq projectKO_opt_tcb
-                       split: Structures_H.kernel_object.split_asm)
+           apply simp
+          apply (clarsimp simp:projectKO_eq
+            projectKO_opt_tcb split:Structures_H.kernel_object.split_asm)
+          apply (simp add:cte_update_def)
+         apply (clarsimp simp:projectKO_eq
+           projectKO_opt_tcb split:Structures_H.kernel_object.split_asm)
+         apply (simp add:ps_clear_def)
+        apply (clarsimp simp:projectKO_eq
+          projectKO_opt_tcb split:Structures_H.kernel_object.split_asm)
        apply (simp add:ps_clear_def)
        apply (rule ccontr,simp)
        apply (erule in_emptyE)
@@ -3851,23 +3483,24 @@ crunch curDomain
   for inv[wp]: P
 
 lemma placeNewObject_tcb_at':
-  "\<lbrace>pspace_aligned' and pspace_distinct'
-    and pspace_no_overlap' ptr (objBits (makeObject::tcb))
-    and  K (is_aligned ptr (objBits (makeObject::tcb))) \<rbrace>
-   placeNewObject ptr (makeObject::tcb) 0
-   \<lbrace>\<lambda>rv s. tcb_at' ptr s \<rbrace>"
+  notes [simp del] = atLeastatMost_subset_iff atLeastLessThan_iff
+                     Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex atLeastAtMost_iff
+  shows "\<lbrace> pspace_aligned' and pspace_distinct'
+             and pspace_no_overlap' ptr (objBits (makeObject::tcb))
+             and  K(is_aligned ptr  (objBits (makeObject::tcb))) \<rbrace>
+         placeNewObject ptr (makeObject::tcb) 0
+         \<lbrace>\<lambda>_ s. tcb_at' ptr s \<rbrace>"
   apply (simp add: placeNewObject_def placeNewObject'_def split_def)
-  apply (wp unless_wp | wpc | simp add: alignError_def)+
-  apply (auto simp: obj_at'_def is_aligned_mask lookupAround2_None1 lookupAround2_char1 field_simps
-                    projectKO_opt_tcb projectKO_def return_def ps_clear_def objBits_simps' oassert_opt_def
-                    word_bits_def
-              split: if_splits
-             dest!: pspace_no_overlap_disjoint')
-  done
+  apply (wp unless_wp |wpc | simp add:alignError_def)+
+  by (auto simp: obj_at'_def is_aligned_mask lookupAround2_None1
+                    lookupAround2_char1 field_simps objBits_simps
+                    projectKO_opt_tcb projectKO_def return_def ps_clear_def
+           split: if_splits
+           dest!: pspace_no_overlap_disjoint')
 
 lemma monad_commute_if_weak_r:
-  "\<lbrakk>monad_commute P1 f h1; monad_commute P2 f h2\<rbrakk> \<Longrightarrow>
-    monad_commute (P1 and P2) f (if d then h1 else h2)"
+"\<lbrakk>monad_commute P1 f h1; monad_commute P2 f h2\<rbrakk> \<Longrightarrow>
+  monad_commute (P1 and P2) f (if d then h1 else h2)"
   apply (clarsimp)
   apply (intro conjI impI)
    apply (erule monad_commute_guard_imp,simp)+
@@ -3876,13 +3509,11 @@ lemma monad_commute_if_weak_r:
 lemma createObject_setCTE_commute:
   "monad_commute
      (cte_wp_at' (\<lambda>_. True) src and
-        pspace_aligned' and pspace_distinct' and pspace_bounded' and
+        pspace_aligned' and pspace_distinct' and
         pspace_no_overlap' ptr (Types_H.getObjectSize ty us) and
         valid_arch_state' and K (ptr \<noteq> src) and
         K (is_aligned ptr (Types_H.getObjectSize ty us)) and
-        K (Types_H.getObjectSize ty us < word_bits) and
-        K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow>
-             sc_size_bounds us))
+        K (Types_H.getObjectSize ty us < word_bits))
      (RetypeDecls_H.createObject ty ptr us d)
      (setCTE src cte)"
   apply (rule commute_grab_asm)+
@@ -3894,54 +3525,54 @@ lemma createObject_setCTE_commute:
          simp_all add: ARM_H.toAPIType_def)
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type)
-              apply (simp_all add: ARM_H.getObjectSize_def apiGetObjectSize_def
-                                   tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def
-                                   cteSizeBits_def)
-              \<comment> \<open>Untyped\<close>
-              apply (simp add: monad_commute_guard_imp[OF return_commute])
-             \<comment> \<open>TCB\<close>
-             apply (rule monad_commute_guard_imp[OF commute_commute])
-              apply (rule monad_commute_split[OF monad_commute_split[OF commute_commute]])
-                  apply (rule return_commute)
-                 apply (rule setCTE_placeNewObject_commute)
+            apply (simp_all add:
+                       ARM_H.getObjectSize_def apiGetObjectSize_def
+                       tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def
+                       cteSizeBits_def)
+            \<comment> \<open>Untyped\<close>
+            apply (simp add: monad_commute_guard_imp[OF return_commute])
+           \<comment> \<open>TCB, EP, NTFN\<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 (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)+
-               apply (rule return_commute[THEN commute_commute])
-              apply (rule setCTE_modify_gsCNode_commute[of \<top>])
-             apply (rule hoare_triv[of \<top>])
-             apply wp
-            apply (rule setCTE_placeNewObject_commute)
-         apply (wpsimp simp: objBits_simps')+
-           \<comment> \<open>SchedContext, Reply\<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' scBits_simps)+)+
+               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')+)+
+        \<comment> \<open>CNode\<close>
+        apply (rule monad_commute_guard_imp[OF commute_commute])
+         apply (rule monad_commute_split)+
+             apply (rule return_commute[THEN commute_commute])
+            apply (rule setCTE_modify_gsCNode_commute[of \<top>])
+           apply (rule hoare_triv[of \<top>])
+           apply wp
+          apply (rule setCTE_placeNewObject_commute)
+         apply (wp|clarsimp simp: objBits_simps')+
        \<comment> \<open>Arch Objects\<close>
-       apply ((rule monad_commute_guard_imp[OF commute_commute],
-               rule monad_commute_split[OF commute_commute[OF return_commute]],
-               clarsimp simp: ARM_H.createObject_def
-                              placeNewDataObject_def bind_assoc split
-                         del: if_splits,
-               (rule monad_commute_split return_commute[THEN commute_commute]
+       apply ((rule monad_commute_guard_imp[OF commute_commute]
+              , rule monad_commute_split[OF commute_commute[OF return_commute]]
+              , clarsimp simp: ARM_H.createObject_def
+                               placeNewDataObject_def bind_assoc split
+                          del: if_splits
+              ,(rule monad_commute_split return_commute[THEN commute_commute]
                      setCTE_modify_gsUserPages_commute[of \<top>]
                      modify_wp[of "%_. \<top>"]
                      setCTE_doMachineOp_commute
+                     setCTE_when_doMachineOp_commute
                      setCTE_placeNewObject_commute
                      monad_commute_if_weak_r
                      copyGlobalMappings_setCTE_commute[THEN commute_commute]
                  | wp placeNewObject_pspace_distinct'
                       placeNewObject_pspace_aligned'
-                      placeNewObject_pspace_bounded'
                       placeNewObject_cte_wp_at'
                       placeNewObject_valid_arch_state placeNewObject_pd_at'
                  | erule is_aligned_weaken
@@ -3955,12 +3586,10 @@ lemma createObject_updateMDB_commute:
   "monad_commute
      ((\<lambda>s. src \<noteq> 0 \<longrightarrow> cte_wp_at' (\<lambda>_. True) src s) and
       pspace_no_overlap' ptr (Types_H.getObjectSize ty us) and
-      pspace_aligned' and pspace_distinct' and pspace_bounded' and valid_arch_state' and
+      pspace_aligned' and pspace_distinct' and valid_arch_state' and
       K (ptr \<noteq> src) and
       K (is_aligned ptr (Types_H.getObjectSize ty us)) and
-      K ((Types_H.getObjectSize ty us) < word_bits) and
-      K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow>
-           sc_size_bounds us))
+      K ((Types_H.getObjectSize ty us)< word_bits))
      (updateMDB src f) (RetypeDecls_H.createObject ty ptr us d)"
   apply (clarsimp simp:updateMDB_def split:if_split_asm)
   apply (intro conjI impI)
@@ -3970,11 +3599,11 @@ lemma createObject_updateMDB_commute:
      apply (rule createObject_setCTE_commute)
     apply (rule createObject_getCTE_commute)
    apply wp
-  apply (auto simp:range_cover_full sc_size_bounds_def)
+  apply (auto simp:range_cover_full)
   done
 
 lemma updateMDB_pspace_no_overlap':
-  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz\<rbrace>
+  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\<rbrace>
    updateMDB slot f
    \<lbrace>\<lambda>rv s. pspace_no_overlap' ptr sz s\<rbrace>"
   apply (rule hoare_pre)
@@ -4069,14 +3698,13 @@ lemma threadSet_gsUntypedZeroRanges_commute':
   "monad_commute \<top>
      (threadSet fn ptr)
      (modify (\<lambda>s. s \<lparr> gsUntypedZeroRanges := f (gsUntypedZeroRanges s) \<rparr> ))"
-  apply (simp add: threadSet_def getObject_def setObject_def readObject_def)
+  apply (simp add: threadSet_def getObject_def setObject_def)
   apply (rule commute_commute)
   apply (strengthen monad_commute_guard_imp[OF monad_commute_split[where P="\<top>" and Q="\<top>\<top>"], OF _ _ hoare_vcg_prop]
-     | simp add: modify_commute updateObject_default_def alignCheck_assert obind_def
+     | simp add: modify_commute updateObject_default_def alignCheck_assert
                  magnitudeCheck_assert return_commute return_commute[THEN commute_commute]
-                 projectKO_def assert_commute2 assert_commute2[THEN commute_commute]
-                 assert_opt_def2 loadObject_default_def gets_the_def omonad_defs
-                 read_magnitudeCheck_assert
+                 projectKO_def2 assert_commute2 assert_commute2[THEN commute_commute]
+                 assert_opt_def2 loadObject_default_def
           split: option.split prod.split)+
   apply (simp add: monad_commute_def exec_gets exec_modify)
   done
@@ -4100,13 +3728,12 @@ lemma copyGlobalMappings_gsUntypedZeroRanges_commute':
   apply (rule monad_commute_guard_imp)
    apply (rule commute_commute[OF monad_commute_split[where P="\<top>"]])
      apply (rule mapM_x_commute[where f = id and P="\<top>\<top>"])
-      apply (simp add: storePDE_def getObject_def setObject_def readObject_def cong: bind_cong)
+      apply (simp add: storePDE_def getObject_def setObject_def cong: bind_cong)
       apply (strengthen monad_commute_guard_imp[OF monad_commute_split[where P="\<top>" and Q="\<top>\<top>"], OF _ _ hoare_vcg_prop]
          | simp add: modify_commute updateObject_default_def alignCheck_assert
                      magnitudeCheck_assert return_commute return_commute[THEN commute_commute]
-                     projectKO_def assert_commute2 assert_commute2[THEN commute_commute]
-                     assert_opt_def2 loadObject_default_def gets_the_def
-                     read_magnitudeCheck_assert omonad_defs obind_def
+                     projectKO_def2 assert_commute2 assert_commute2[THEN commute_commute]
+                     assert_opt_def2 loadObject_default_def
               split: option.split prod.split)+
       apply (simp add: monad_commute_def exec_gets exec_modify)
      apply wp
@@ -4115,6 +3742,13 @@ lemma copyGlobalMappings_gsUntypedZeroRanges_commute':
   apply simp
   done
 
+lemma dmo_gsUntypedZeroRanges_commute:
+  "monad_commute \<top> (modify (\<lambda>s. s\<lparr>gsUntypedZeroRanges := f (gsUntypedZeroRanges s)\<rparr>))
+                   (doMachineOp m)"
+  apply (clarsimp simp: monad_commute_def doMachineOp_def)
+  apply monad_eq
+  by (auto simp: select_f_def)
+
 lemma createObject_gsUntypedZeroRanges_commute:
   "monad_commute
      \<top>
@@ -4152,9 +3786,8 @@ lemma case_eq_if_isUntypedCap:
 lemma createObject_updateTrackedFreeIndex_commute:
   "monad_commute
      (cte_wp_at' (\<lambda>_. True) slot and pspace_aligned' and pspace_distinct' and
-      pspace_bounded' and pspace_no_overlap' ptr (Types_H.getObjectSize ty us) and
+      pspace_no_overlap' ptr (Types_H.getObjectSize ty us) and
       valid_arch_state' and
-      K (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us) and
       K (ptr \<noteq> slot) and K (Types_H.getObjectSize ty us < word_bits) and
       K (is_aligned ptr (Types_H.getObjectSize ty us)))
      (RetypeDecls_H.createObject ty ptr us dev) (updateTrackedFreeIndex slot idx)"
@@ -4170,9 +3803,8 @@ lemma createObject_updateTrackedFreeIndex_commute:
 lemma createObject_updateNewFreeIndex_commute:
   "monad_commute
      (cte_wp_at' (\<lambda>_. True) slot and pspace_aligned' and pspace_distinct' and
-      pspace_bounded' and pspace_no_overlap' ptr (Types_H.getObjectSize ty us) and
+      pspace_no_overlap' ptr (Types_H.getObjectSize ty us) and
       valid_arch_state' and
-      K (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us) and
       K (ptr \<noteq> slot) and K (Types_H.getObjectSize ty us < word_bits) and
       K (is_aligned ptr (Types_H.getObjectSize ty us)))
      (RetypeDecls_H.createObject ty ptr us dev) (updateNewFreeIndex slot)"
@@ -4189,7 +3821,7 @@ lemma createObject_updateNewFreeIndex_commute:
 
 lemma new_cap_object_comm_helper:
   "monad_commute
-     (pspace_aligned' and pspace_distinct' and pspace_bounded' and (\<lambda>s. no_0 (ctes_of s)) and
+     (pspace_aligned' and pspace_distinct' and (\<lambda>s. no_0 (ctes_of s)) and
       (\<lambda>s. weak_valid_dlist (ctes_of s)) and
       (\<lambda>s. valid_nullcaps (ctes_of s)) and
       cte_wp_at' (\<lambda>c. isUntypedCap (cteCap c)) parent and
@@ -4198,9 +3830,7 @@ lemma new_cap_object_comm_helper:
       valid_arch_state' and
       K (Types_H.getObjectSize ty us<word_bits) and
       K (cap \<noteq> capability.NullCap) and
-      K (is_aligned ptr (Types_H.getObjectSize ty us) \<and> ptr \<noteq> 0 \<and> parent \<noteq> 0) and
-      K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow>
-           sc_size_bounds us))
+      K (is_aligned ptr (Types_H.getObjectSize ty us) \<and> ptr \<noteq> 0 \<and> parent \<noteq> 0))
      (RetypeDecls_H.createObject ty ptr us d) (insertNewCap parent slot cap)"
   apply (clarsimp simp:insertNewCap_def bind_assoc liftM_def)
   apply (rule monad_commute_guard_imp)
@@ -4212,13 +3842,13 @@ lemma new_cap_object_comm_helper:
         apply (rule createObject_updateNewFreeIndex_commute)
        apply (wp getCTE_wp hoare_vcg_imp_lift hoare_vcg_disj_lift valid_arch_state'_updateMDB
          updateMDB_pspace_no_overlap' setCTE_pspace_no_overlap'
-         | clarsimp simp: conj_comms)+
+         | clarsimp simp:conj_comms)+
   apply (clarsimp simp:cte_wp_at_ctes_of)
   apply (frule_tac slot = slot in pspace_no_overlapD2')
    apply simp+
   apply (frule_tac slot = parent in pspace_no_overlapD2')
    apply simp+
-  apply (case_tac ctea, clarsimp simp: sc_size_bounds_def)
+  apply (case_tac ctea,clarsimp)
   apply (frule_tac p = slot in nullcapsD')
      apply simp+
   apply (subgoal_tac "(mdbNext (cteMDBNode cte) = 0 \<or>
@@ -4235,11 +3865,14 @@ lemma new_cap_object_comm_helper:
 
 crunch updateNewFreeIndex
   for pspace_aligned'[wp]: "pspace_aligned'"
-  and pspace_distinct'[wp]: "pspace_distinct'"
-  and pspace_bounded'[wp]: "pspace_bounded'"
-  and valid_arch_state'[wp]: "valid_arch_state'"
-  and pspace_no_overlap'[wp]: "pspace_no_overlap' ptr n"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
+crunch updateNewFreeIndex
+  for pspace_distinct'[wp]: "pspace_distinct'"
+crunch updateNewFreeIndex
+  for valid_arch_state'[wp]: "valid_arch_state'"
+crunch updateNewFreeIndex
+  for pspace_no_overlap'[wp]: "pspace_no_overlap' ptr n"
+crunch updateNewFreeIndex
+  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
 
 lemma updateNewFreeIndex_cte_wp_at[wp]:
   "\<lbrace>\<lambda>s. P (cte_wp_at' P' p s)\<rbrace> updateNewFreeIndex slot \<lbrace>\<lambda>rv s. P (cte_wp_at' P' p s)\<rbrace>"
@@ -4254,9 +3887,7 @@ lemma new_cap_object_commute:
       K (distinct (map fst (zip list caps))) and
       K (\<forall>cap \<in> set caps. cap \<noteq> capability.NullCap) and
       K (Types_H.getObjectSize ty us <word_bits) and
-      K (is_aligned ptr (Types_H.getObjectSize ty us) \<and> ptr \<noteq> 0) and
-      K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow>
-           sc_size_bounds us))
+      K (is_aligned ptr (Types_H.getObjectSize ty us) \<and> ptr \<noteq> 0))
      (RetypeDecls_H.createObject ty ptr us d)
      (zipWithM_x (insertNewCap parent) list caps)"
   apply (clarsimp simp:zipWithM_x_mapM_x)
@@ -4265,9 +3896,9 @@ lemma new_cap_object_commute:
     apply (simp add:split_def)
     apply (rule new_cap_object_comm_helper)
    apply (clarsimp simp:insertNewCap_def split_def)
-   apply (wpsimp wp: updateMDB_weak_cte_wp_at updateMDB_pspace_no_overlap'
-                     getCTE_wp valid_arch_state'_updateMDB
-                     setCTE_weak_cte_wp_at setCTE_pspace_no_overlap')
+   apply (wp updateMDB_weak_cte_wp_at updateMDB_pspace_no_overlap'
+             getCTE_wp valid_arch_state'_updateMDB
+             setCTE_weak_cte_wp_at setCTE_pspace_no_overlap')
    apply (clarsimp simp:cte_wp_at_ctes_of simp del:fun_upd_apply)
    apply (case_tac "parent \<noteq> aa")
     prefer 2
@@ -4314,7 +3945,9 @@ lemma createObjects'_pspace_no_overlap:
    createObjects' ptr (Suc n) val us
    \<lbrace>\<lambda>addrs s. pspace_no_overlap' (ptr + (1 + of_nat n << gz)) gz s\<rbrace>"
 proof -
-  note simps [simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
+  note simps [simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff
+                          atLeastatMost_subset_iff atLeastLessThan_iff
+                          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
   assume "gz = (objBitsKO val) + us"
   thus ?thesis
     apply -
@@ -4386,13 +4019,13 @@ lemma createNewCaps_not_nc:
   by (wpsimp simp: Arch_createNewCaps_def split_del: if_split)
 
 lemma doMachineOp_psp_no_overlap:
-  "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>
+  "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> pspace_aligned' s \<and> pspace_distinct' s \<rbrace>
    doMachineOp f
    \<lbrace>\<lambda>y s. pspace_no_overlap' ptr sz s\<rbrace>"
-  by (wpsimp wp: pspace_no_overlap'_lift2)
+  by (wp pspace_no_overlap'_lift,simp)
 
 lemma createObjects'_psp_distinct:
-  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_bounded' and
+  "\<lbrace>pspace_aligned' and pspace_distinct' and
     pspace_no_overlap' ptr sz and
     K (range_cover ptr sz ((objBitsKO ko) + us) n \<and> n \<noteq> 0
     \<and> is_aligned ptr (objBitsKO ko + us) \<and> objBitsKO ko + us < word_bits)\<rbrace>
@@ -4409,7 +4042,7 @@ lemma createObjects'_psp_distinct:
   apply clarsimp
   apply (subst data_map_insert_def[symmetric])+
   apply (simp add: range_cover.unat_of_nat_n_shift)
-  apply (drule (3) retype_aligned_distinct'(1)[where ko = ko and n= "n*2^us" ])
+  apply (drule(2) retype_aligned_distinct'(1)[where ko = ko and n= "n*2^us" ])
    apply (erule range_cover_rel)
     apply simp
    apply clarsimp
@@ -4417,7 +4050,7 @@ lemma createObjects'_psp_distinct:
   done
 
 lemma createObjects'_psp_aligned:
-  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_bounded' and
+  "\<lbrace>pspace_aligned' and pspace_distinct' and
     pspace_no_overlap' ptr sz and
     K (range_cover ptr sz ((objBitsKO ko) + us) n \<and> n \<noteq> 0
     \<and> is_aligned ptr (objBitsKO ko + us) \<and> objBitsKO ko + us < word_bits)\<rbrace>
@@ -4432,31 +4065,7 @@ lemma createObjects'_psp_aligned:
   apply (rule hoare_pre)
    apply (wpc|wp|simp add: unless_def alignError_def del: fun_upd_apply hoare_fail_any)+
   apply clarsimp
-  apply (frule (3) retype_aligned_distinct'(3)[where ko = ko and n= "n*2^us" ])
-   apply (erule range_cover_rel)
-    apply simp
-   apply clarsimp
-  apply (subst data_map_insert_def[symmetric])+
-  apply (simp add: range_cover.unat_of_nat_n_shift)
-  done
-
-lemma createObjects'_psp_bounded:
-  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_bounded' and
-    pspace_no_overlap' ptr sz and
-    K (range_cover ptr sz ((objBitsKO ko) + us) n \<and> n \<noteq> 0
-    \<and> is_aligned ptr (objBitsKO ko + us) \<and> objBitsKO ko + us < word_bits)\<rbrace>
-   createObjects' ptr n ko us
-   \<lbrace>\<lambda>rv s. pspace_bounded' s\<rbrace>"
-  apply (rule hoare_name_pre_state)
-  apply (clarsimp simp: createObjects'_def split_def)
-  apply (subst new_cap_addrs_fold')
-   apply (drule range_cover_not_zero_shift[where gbits = us,rotated])
-     apply simp+
-   apply unat_arith
-  apply (rule hoare_pre)
-   apply (wpc|wp|simp add: unless_def alignError_def del: fun_upd_apply hoare_fail_any)+
-  apply clarsimp
-  apply (frule (3) retype_aligned_distinct'(2)[where ko = ko and n= "n*2^us" ])
+  apply (frule(2) retype_aligned_distinct'(2)[where ko = ko and n= "n*2^us" ])
    apply (erule range_cover_rel)
     apply simp
    apply clarsimp
@@ -4465,12 +4074,12 @@ lemma createObjects'_psp_bounded:
   done
 
 lemma copyGlobalMappings_pspace_no_overlap':
-  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz\<rbrace>
+  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\<rbrace>
    copyGlobalMappings xa
    \<lbrace>\<lambda>ya. pspace_no_overlap' ptr sz\<rbrace>"
   apply (rule hoare_pre)
    apply (clarsimp simp:copyGlobalMappings_def)
-   apply (wpsimp wp: mapM_x_wp_inv pspace_no_overlap'_lift2)
+   apply (wp mapM_x_wp_inv pspace_no_overlap'_lift)
   apply clarsimp
   done
 
@@ -4479,7 +4088,8 @@ lemma pspace_no_overlap'_le:
   assumes b: "sz < word_bits"
   shows "pspace_no_overlap' ptr sz' s"
   proof -
-  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
+  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
   have diff_cancel: "\<And>a b c. (a::word32) + b - c = b + (a - c)"
    by simp
   have bound :"(ptr && ~~ mask sz') - (ptr && ~~ mask sz) \<le> 2 ^ sz - 2 ^ sz'"
@@ -4508,7 +4118,8 @@ lemma pspace_no_overlap'_le2:
   assumes "pspace_no_overlap' ptr sz s" "ptr \<le> ptr'"  "ptr' &&~~ mask sz = ptr && ~~ mask sz"
   shows "pspace_no_overlap' ptr' sz s"
   proof -
-  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
+  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
   show ?thesis
     using assms
     apply (clarsimp simp:pspace_no_overlap'_def)
@@ -4530,8 +4141,7 @@ lemma pspace_no_overlap'_tail:
 
 lemma createNewCaps_pspace_no_overlap':
   "\<lbrace>\<lambda>s. range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n)) \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and> pspace_no_overlap' ptr sz s \<and>
-        (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us) \<and>
+        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s \<and>
         ptr \<noteq> 0\<rbrace>
    createNewCaps ty ptr (Suc n) us d
    \<lbrace>\<lambda>r s. pspace_no_overlap'
@@ -4558,22 +4168,19 @@ lemma createNewCaps_pspace_no_overlap':
                               createObjects_def)
         apply (rule hoare_pre)
          apply wpc
-               apply (clarsimp simp: apiGetObjectSize_def curDomain_def ARM_H.toAPIType_def
-                                     tcbBlockSizeBits_def ARM_H.getObjectSize_def objBits_simps
-                                     epSizeBits_def ntfnSizeBits_def cteSizeBits_def pageBits_def
-                                     ptBits_def archObjSize_def pdBits_def createObjects_def
-                                     Arch_createNewCaps_def scBits_simps word_bits_def
-                                     range_cover_le[where n = "Suc n"] range_cover.aligned
-                              split: apiobject_type.splits
-                     | wp doMachineOp_psp_no_overlap
-                          createObjects'_pspace_no_overlap[where sz = sz]
-                          createObjects'_psp_aligned[where sz = sz]
-                          createObjects'_psp_distinct[where sz = sz]
-                          copyGlobalMappings_pspace_aligned' mapM_x_wp_inv
-                          copyGlobalMappings_pspace_no_overlap'[where sz = sz]
-                     | (frule range_cover_sz'; fastforce simp: untypedBits_defs)
-                     | assumption)+
-       apply ((clarsimp simp: apiGetObjectSize_def
+    apply (clarsimp simp: apiGetObjectSize_def  curDomain_def
+                          ARM_H.toAPIType_def tcbBlockSizeBits_def
+                          ARM_H.getObjectSize_def objBits_simps epSizeBits_def ntfnSizeBits_def
+                          cteSizeBits_def pageBits_def ptBits_def archObjSize_def pdBits_def
+                          createObjects_def Arch_createNewCaps_def
+                    split: apiobject_type.splits
+           | wp doMachineOp_psp_no_overlap createObjects'_pspace_no_overlap[where sz = sz]
+                createObjects'_psp_aligned[where sz = sz] createObjects'_psp_distinct[where sz = sz]
+                copyGlobalMappings_pspace_aligned' mapM_x_wp_inv
+                copyGlobalMappings_pspace_no_overlap'[where sz = sz] | assumption)+
+           apply (intro conjI range_cover_le[where n = "Suc n"] | simp)+
+            apply ((simp add:objBits_simps pageBits_def range_cover_def word_bits_def)+)[5]
+       by ((clarsimp simp: apiGetObjectSize_def
                               ARM_H.toAPIType_def tcbBlockSizeBits_def
                               ARM_H.getObjectSize_def objBits_simps epSizeBits_def ntfnSizeBits_def
                               cteSizeBits_def pageBits_def ptBits_def archObjSize_def pdBits_def
@@ -4583,12 +4190,10 @@ lemma createNewCaps_pspace_no_overlap':
                         split: apiobject_type.splits
                | wp doMachineOp_psp_no_overlap createObjects'_pspace_no_overlap
                     createObjects'_psp_aligned createObjects'_psp_distinct
-                    createObjects'_psp_bounded
                     copyGlobalMappings_pspace_aligned' mapM_x_wp_inv
                     copyGlobalMappings_pspace_no_overlap'
                | assumption | clarsimp simp: word_bits_def
                | intro conjI range_cover_le[where n = "Suc n"] range_cover.aligned)+)[6]
-  done
 
 lemma objSize_eq_capBits:
   "Types_H.getObjectSize ty us = APIType_capBits ty us"
@@ -4617,7 +4222,8 @@ lemma createNewCaps_ret_len:
           erule hoare_strengthen_post[OF createObjects_ret],clarsimp+ | intro conjI impI)+
        apply (rule hoare_pre,
           ((wp+)
-              | simp add: Arch_createNewCaps_def toAPIType_def unat_of_nat_minus_1
+              | simp add: Arch_createNewCaps_def toAPIType_def
+                          ARM_H.toAPIType_def unat_of_nat_minus_1
               | erule hoare_strengthen_post[OF createObjects_ret],clarsimp+
               | intro conjI impI)+)+
    done
@@ -4754,7 +4360,8 @@ lemma pspace_no_overlap'_modify:
           (((1::word32) + of_nat n << objBitsKO val + us) + ptr)
           (objBitsKO val + us)\<rbrace>"
   proof -
-  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
+  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
   show ?thesis
   apply (clarsimp simp:simpler_modify_def valid_def pspace_no_overlap'_def)
   apply (frule(1) range_cover_tail_mask)
@@ -4787,7 +4394,7 @@ qed
 
 lemma placeNewObject_copyGlobalMapping_commute:
   "monad_commute
-     (valid_arch_state' and pspace_distinct' and pspace_aligned' and pspace_bounded' and
+     (valid_arch_state' and pspace_distinct' and pspace_aligned' and
       page_directory_at' r and
       pspace_no_overlap' ptr (objBitsKO (injectKOS val) + us) and
       K (objBitsKO (injectKOS val) + us < word_bits \<and>
@@ -4800,7 +4407,7 @@ lemma placeNewObject_copyGlobalMapping_commute:
       apply (rule monad_commute_split[OF _ getPDE_placeNewObject_commute])
        apply (rule storePDE_placeNewObject_commute)
       apply wp
-      apply (wp pspace_no_overlap'_lift2 | clarsimp)+
+      apply (wp pspace_no_overlap'_lift | clarsimp)+
     apply (rule placeNewObject_gets_globalPD_commute)
    apply wp
   apply clarsimp
@@ -4812,7 +4419,7 @@ lemma placeNewObject_copyGlobalMapping_commute:
 
 lemma createObjects_Cons:
   "\<lbrakk>range_cover ptr sz (objBitsKO val + us) (Suc (Suc n));
-    pspace_distinct' s;pspace_aligned' s; pspace_bounded' s;
+    pspace_distinct' s;pspace_aligned' s;
     pspace_no_overlap' ptr sz s;pspace_aligned' s; ptr \<noteq> 0\<rbrakk>
    \<Longrightarrow> createObjects' ptr (Suc (Suc n)) val us s =
        (do createObjects' ptr (Suc n) val us;
@@ -4889,7 +4496,7 @@ lemma createObjects_Cons:
           apply (simp add:range_cover_def)
          apply (erule range_cover.sz(1)[where 'a=32, folded word_bits_def])
         apply (subst data_map_insert_def[symmetric])
-        apply (drule(3) retype_aligned_distinct'(3))
+        apply (drule(2) retype_aligned_distinct'(2))
          prefer 2
          apply (simp cong: kernel_state.fold_congs)
         apply (drule range_cover_le[where n = "Suc n"])
@@ -4910,7 +4517,7 @@ lemma placeNewObject_doMachineOp_commute:
   "monad_commute
      (K (us < word_bits \<and> is_aligned ptr (objBitsKO (injectKOS ty) + us) \<and>
          objBitsKO (injectKOS ty) + us < word_bits) and
-      pspace_aligned' and pspace_distinct' and pspace_bounded' and
+      pspace_aligned' and pspace_distinct' and
       pspace_no_overlap' ptr ((objBitsKO (injectKOS ty)) +  us))
      (placeNewObject ptr ty us) (doMachineOp f)"
   apply (rule commute_name_pre_state)
@@ -4945,29 +4552,100 @@ lemma doMachineOp_ksArchState_commute:
     apply clarsimp+
   done
 
+lemma doMachineOp_ksPSpace:
+  "monad_commute \<top> (doMachineOp f) (gets ksPSpace)"
+  apply (clarsimp simp: monad_commute_def doMachineOp_def bind_assoc)
+  apply monad_eq
+  apply (auto simp add: select_f_def)
+  done
+
+lemma doMachineOp_assert_opt:
+  "empty_fail f \<Longrightarrow> monad_commute \<top> (doMachineOp f) (assert_opt m)"
+  apply (clarsimp simp: monad_commute_def doMachineOp_def bind_assoc)
+  apply monad_eq
+  apply (force simp add: select_f_def empty_fail_def)
+  done
+
+lemma doMachineOp_assert:
+  "empty_fail f \<Longrightarrow> monad_commute \<top> (doMachineOp f) (assert P)"
+  apply (clarsimp simp: monad_commute_def doMachineOp_def bind_assoc)
+  apply monad_eq
+  apply (force simp add: select_f_def empty_fail_def)
+  done
+
+lemma doMachineOp_projectKO_pde:
+  "empty_fail f \<Longrightarrow> monad_commute \<top> (doMachineOp f) (projectKO ko :: pde kernel)"
+  apply (clarsimp simp: monad_commute_def doMachineOp_def bind_assoc projectKO_def)
+  apply monad_eq
+  by (force split: option.splits simp: fail_def return_def select_f_def empty_fail_def)
+
+lemma doMachineOp_alignCheck:
+  "empty_fail f \<Longrightarrow> monad_commute \<top> (doMachineOp f) (alignCheck ko n)"
+  apply (clarsimp simp: monad_commute_def doMachineOp_def bind_assoc alignCheck_def split_def
+                        alignError_def unless_def)
+  apply monad_eq
+  by (force simp: select_f_def empty_fail_def)
+
+lemma doMachineOp_magnitudeCheck:
+  "empty_fail f \<Longrightarrow> monad_commute \<top> (doMachineOp f) (magnitudeCheck x y n)"
+  apply (clarsimp simp: monad_commute_def doMachineOp_def bind_assoc magnitudeCheck_def split_def)
+  apply monad_eq
+  apply (force simp: select_f_def empty_fail_def return_def when_def fail_def split: option.splits)
+  done
+
+lemma doMachineOp_storePDE_commute_T:
+  "empty_fail f \<Longrightarrow> monad_commute \<top> (doMachineOp f) (storePDE src pde)"
+  apply (clarsimp simp: storePDE_def setObject_def updateObject_default_def bind_assoc split_def)
+  apply (rule monad_commute_guard_imp)
+   apply (rule monad_commute_split [OF _ doMachineOp_ksPSpace])
+    apply (rule monad_commute_split [OF _ doMachineOp_assert_opt])
+      apply (rule monad_commute_split [OF _ doMachineOp_assert])
+        apply (rule monad_commute_split [OF _ doMachineOp_projectKO_pde])
+          apply (rule monad_commute_split [OF _ doMachineOp_alignCheck])
+            apply (rule monad_commute_split [OF _ doMachineOp_magnitudeCheck])
+              apply (rule doMachineOp_upd_heap_commute)
+             apply (assumption | wp)+
+  apply simp
+  done
+
+lemma getPDE_doMachineOp_commute_T:
+  "empty_fail f \<Longrightarrow> monad_commute \<top> (doMachineOp f) (getObject src :: pde kernel)"
+  apply (clarsimp simp: storePDE_def getObject_def loadObject_default_def bind_assoc split_def)
+  apply (rule monad_commute_guard_imp)
+   apply (rule monad_commute_split [OF _ doMachineOp_ksPSpace])
+    apply (rule monad_commute_split [OF _ doMachineOp_assert_opt])
+      apply (rule monad_commute_split [OF _ doMachineOp_assert])
+        apply (rule monad_commute_split [OF _ doMachineOp_projectKO_pde])
+          apply (rule monad_commute_split [OF _ doMachineOp_alignCheck])
+            apply (rule monad_commute_split [OF _ doMachineOp_magnitudeCheck])
+              apply (rule commute_commute, rule return_commute)
+             apply (assumption | wp)+
+  apply simp
+  done
+
 lemma doMachineOp_copyGlobalMapping_commute:
-  "monad_commute (valid_arch_state' and page_directory_at' r)
-                 (doMachineOp f) (copyGlobalMappings r)"
-  apply (clarsimp simp:copyGlobalMappings_def)
+  "empty_fail f \<Longrightarrow> monad_commute \<top> (doMachineOp f) (copyGlobalMappings r)"
+  apply (clarsimp simp: copyGlobalMappings_def)
   apply (rule monad_commute_guard_imp)
    apply (rule monad_commute_split)
-     apply (rule mapM_x_commute[where f = id])
-      apply (rule monad_commute_split[OF _ getPDE_doMachineOp_commute])
-       apply (rule doMachineOp_storePDE_commute)
-      apply wp+
-     apply clarsimp
+     apply (rule commute_commute, rule mapM_x_commute_T)
+     apply (rule commute_commute)
+     apply (rule monad_commute_guard_imp)
+      apply (rule monad_commute_split[OF _ getPDE_doMachineOp_commute_T])
+        apply (rule doMachineOp_storePDE_commute_T)
+        apply (assumption | wp)+
+     apply simp
     apply (rule doMachineOp_ksArchState_commute)
    apply wp
   apply clarsimp
-  apply (clarsimp simp: valid_arch_state'_def page_directory_at'_def objBits_simps archObjSize_def
-                        pdBits_def pageBits_def)
-  apply (drule le_m1_iff_lt[where x = "(0x1000::word32)",simplified,THEN iffD1])
-  apply (clarsimp simp: pdeBits_def)
   done
 
+lemmas mapM_doMachineOp_copyGlobalMapping_commute =
+  doMachineOp_copyGlobalMapping_commute[THEN mapM_x_commute_T]
+
 lemma createObjects'_page_directory_at':
   "\<lbrace>K (range_cover ptr sz 14 (Suc n)) and
-    pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz\<rbrace>
+    pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\<rbrace>
    createObjects' ptr (Suc n) (KOArch (KOPDE makeObject)) 12
    \<lbrace>\<lambda>rv s. (\<forall>x\<le>of_nat n. page_directory_at' (ptr + (x << 14)) s)\<rbrace>"
   apply (rule createObjects'_wp_subst)
@@ -5078,7 +4756,7 @@ lemma createObjects_setDomain_commute:
   "monad_commute
   (\<lambda>s. range_cover ptr'  (objBitsKO (KOTCB makeObject))
        (objBitsKO (KOTCB makeObject) + 0) (Suc 0) \<and>
-  pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  pspace_aligned' s \<and> pspace_distinct' s \<and>
   pspace_no_overlap' ptr' (objBitsKO (KOTCB makeObject)) s \<and>
   tcb_at' ptr s \<and> is_aligned ptr' (objBitsKO (KOTCB makeObject)))
   (createObjects' ptr' (Suc 0) (KOTCB makeObject) 0)
@@ -5095,6 +4773,35 @@ lemma createObjects_setDomain_commute:
   apply (clarsimp split:Structures_H.kernel_object.splits)
   done
 
+
+lemma createObjects_setDomains_commute:
+  "monad_commute
+      (\<lambda>s. \<forall>x\<in> set xs. tcb_at' (f x) s \<and>
+      range_cover ptr (objBitsKO (KOTCB makeObject)) (objBitsKO (KOTCB makeObject)) (Suc 0) \<and>
+      pspace_aligned' s \<and>
+      pspace_distinct' s \<and>
+      pspace_no_overlap' ptr (objBitsKO (KOTCB makeObject)) s \<and>
+      is_aligned ptr (objBitsKO (KOTCB makeObject)))
+  (mapM_x (threadSet (tcbDomain_update (\<lambda>_. r))) (map f xs))
+  (createObjects' ptr (Suc 0) (KOTCB makeObject) 0)"
+  proof (induct xs)
+    case Nil
+    show ?case
+      apply (simp add:monad_commute_def mapM_x_Nil)
+    done
+    next
+    case (Cons x xs)
+    show ?case
+    apply (simp add:mapM_x_Cons)
+    apply (rule monad_commute_guard_imp)
+    apply (rule commute_commute[OF monad_commute_split])
+     apply (rule commute_commute[OF Cons.hyps])
+     apply (rule createObjects_setDomain_commute)
+     apply (wp hoare_vcg_ball_lift)
+    apply clarsimp
+   done
+  qed
+
 lemma createObjects'_pspace_no_overlap2:
   "\<lbrace>pspace_no_overlap' (ptr + (1 + of_nat n << gz)) sz
        and K (gz = (objBitsKO val) + us)
@@ -5102,7 +4809,8 @@ lemma createObjects'_pspace_no_overlap2:
     createObjects' ptr (Suc n) val us
   \<lbrace>\<lambda>addrs s. pspace_no_overlap' (ptr + (1 + of_nat n << gz)) sz s\<rbrace>"
 proof -
-  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
+  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
   show ?thesis
   apply (rule hoare_gen_asm)+
   apply (clarsimp simp:createObjects'_def split_def new_cap_addrs_fold')
@@ -5160,6 +4868,85 @@ proof -
   done
 qed
 
+lemma dmo'_when_fail_comm:
+  assumes "empty_fail f"
+  shows "doMachineOp f >>= (\<lambda>x. when P fail >>= (\<lambda>_. m x)) =
+         when P fail >>= (\<lambda>_. doMachineOp f >>= m)"
+  apply (rule ext)
+  apply (cut_tac ef_dmo'[OF assms])
+  apply (auto simp add: empty_fail_def when_def fail_def return_def
+                        bind_def split_def image_def, fastforce)
+  done
+
+lemma dmo'_gets_ksPSpace_comm:
+  "doMachineOp f >>= (\<lambda>y. gets ksPSpace >>= m y) =
+   gets ksPSpace >>= (\<lambda>x. doMachineOp f >>= (\<lambda>y. m y x))"
+  apply (rule ext)
+  apply (clarsimp simp: doMachineOp_def simpler_modify_def simpler_gets_def
+                        return_def select_f_def bind_def split_def image_def
+                  cong: SUP_cong_simp)
+  apply (rule conjI; clarsimp)
+   apply (rule equalityI; clarsimp;
+           rule exI, rule conjI[rotated], assumption,
+           (rule exI)+,
+           rule conjI, rule bexI, rule refl, assumption, fastforce)
+  apply (rule iffI; clarsimp;
+           (rule exI)+,
+           rule conjI,
+             erule bexI[rotated], rule refl,
+             fastforce dest: prod_injects)+
+  done
+
+lemma dmo'_ksPSpace_update_comm':
+  assumes "empty_fail f"
+  shows "doMachineOp f >>= (\<lambda>x. modify (ksPSpace_update g) >>= (\<lambda>_. m x)) =
+         modify (ksPSpace_update g) >>= (\<lambda>_. doMachineOp f >>= m)"
+proof -
+  have ksMachineState_ksPSpace_update:
+    "\<forall>s. ksMachineState (ksPSpace_update g s) = ksMachineState s"
+    by simp
+  have updates_independent:
+    "\<And>f. ksPSpace_update g \<circ> ksMachineState_update f =
+          ksMachineState_update f \<circ> ksPSpace_update g"
+    by (rule ext) simp
+  from assms
+  show ?thesis
+    apply (simp add: doMachineOp_def split_def bind_assoc)
+    apply (simp add: gets_modify_comm2[OF ksMachineState_ksPSpace_update])
+    apply (rule arg_cong_bind1)
+    apply (simp add: empty_fail_def select_f_walk[OF empty_fail_modify]
+                     modify_modify_bind updates_independent)
+    done
+qed
+
+lemma dmo'_createObjects'_commute:
+  assumes ef: "empty_fail f"
+  shows "monad_commute \<top> (doMachineOp f) (createObjects' ptr n obj us)"
+  apply (clarsimp simp: createObjects'_def bind_assoc split_def unless_def
+                        alignError_def monad_commute_def
+                        dmo'_when_fail_comm[OF ef]
+                        dmo'_gets_ksPSpace_comm
+                        dmo'_ksPSpace_update_comm'[OF ef, symmetric])
+  apply (rule_tac x=s in fun_cong)
+  apply (rule arg_cong_bind1)
+  apply (rule arg_cong_bind1)
+  apply (rename_tac u w)
+  apply (case_tac "fst (lookupAround2 (ptr + of_nat (shiftL n (objBitsKO obj +
+                                         us) - Suc 0)) w)", clarsimp+)
+  apply (simp add: assert_into_when dmo'_when_fail_comm[OF ef])
+  done
+
+lemmas map_dmo'_createObjects'_comm = dmo'_createObjects'_commute[THEN mapM_x_commute_T]
+
+lemma dmo'_gsUserPages_upd_commute:
+  "monad_commute \<top> (doMachineOp f) (modify (gsUserPages_update g))"
+  apply (clarsimp simp: monad_commute_def doMachineOp_def bind_assoc)
+  apply monad_eq
+  apply (auto simp: select_f_def)
+  done
+
+lemmas dmo'_gsUserPages_upd_map_commute = dmo'_gsUserPages_upd_commute[THEN mapM_x_commute_T]
+
 lemma new_cap_addrs_def2:
   "n < 2 ^ 32
    \<Longrightarrow> new_cap_addrs (Suc n) ptr obj
@@ -5167,11 +4954,11 @@ lemma new_cap_addrs_def2:
   by (simp add:new_cap_addrs_def upto_enum_word unat_of_nat Fun.comp_def)
 
 lemma createTCBs_tcb_at':
-  "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and>
    pspace_no_overlap' ptr sz s \<and>
    range_cover ptr sz
-  (objBitsKO (KOTCB (tcbDomain_update (\<lambda>_. curdom) makeObject))) (Suc n) \<rbrace>
-  createObjects' ptr (Suc n) (KOTCB (tcbDomain_update (\<lambda>_. curdom) makeObject)) 0
+  (objBitsKO (KOTCB makeObject)) (Suc n) \<rbrace>
+  createObjects' ptr (Suc n) (KOTCB makeObject) 0
   \<lbrace>\<lambda>rv s.
   (\<forall>x\<in>set [0.e.of_nat n]. tcb_at' (ptr + x * 2^tcbBlockSizeBits) s)\<rbrace>"
   apply (simp add:createObjects'_def split_def alignError_def)
@@ -5180,8 +4967,8 @@ lemma createTCBs_tcb_at':
   apply clarsimp
   apply (subgoal_tac "(\<forall>x\<le>of_nat n.
     tcb_at' (ptr + x * 2^tcbBlockSizeBits) (s\<lparr>ksPSpace :=
-    foldr (\<lambda>addr. data_map_insert addr (KOTCB (tcbDomain_update (\<lambda>_. curdom) makeObject)))
-    (new_cap_addrs (Suc n) ptr (KOTCB (tcbDomain_update (\<lambda>_. curdom) makeObject)))
+    foldr (\<lambda>addr. data_map_insert addr (KOTCB makeObject))
+    (new_cap_addrs (Suc n) ptr (KOTCB makeObject))
     (ksPSpace s)\<rparr>))")
   apply (subst (asm) new_cap_addrs_def2)
    apply (drule range_cover.weak)
@@ -5197,39 +4984,10 @@ 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"
   and "pspace_no_overlap' ptr sz s"
-  and "ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us"
   and "ptr \<noteq> 0"
   shows "createNewCaps ty ptr (Suc (Suc n)) us d s
  = (do x \<leftarrow> createNewCaps ty ptr (Suc n) us d;
@@ -5312,325 +5070,315 @@ proof -
                          Arch_createNewCaps_def)
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type)
-              apply (simp_all add: bind_assoc ARM_H.toAPIType_def)
-              \<comment> \<open>Untyped\<close>
-              apply (simp add:
-                bind_assoc ARM_H.getObjectSize_def
-                mapM_def sequence_def Retype_H.createObject_def
-                ARM_H.toAPIType_def
-                createObjects_def ARM_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])
-             \<comment> \<open>TCB\<close>
-              apply (simp add:
-                bind_assoc ARM_H.getObjectSize_def
-                mapM_def sequence_def Retype_H.createObject_def
-                ARM_H.toAPIType_def objBitsKO_def
-                createObjects_def ARM_H.createObject_def
-                Arch_createNewCaps_def comp_def append
-                apiGetObjectSize_def shiftl_t2n field_simps
-                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:
-                        ARM_H.getObjectSize_def
-                        mapM_def sequence_def Retype_H.createObject_def
-                        ARM_H.toAPIType_def
-                        createObjects_def ARM_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]
-          \<comment> \<open>CNode\<close>
-          apply (simp add: cteSizeBits_def pageBits_def tcbBlockSizeBits_def
-                        epSizeBits_def ntfnSizeBits_def pdBits_def bind_assoc
-                        ARM_H.getObjectSize_def
-                        mapM_def sequence_def Retype_H.createObject_def
-                        ARM_H.toAPIType_def
-                        createObjects_def ARM_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])+
-          apply (subst monad_eq, rule createObjects_Cons)
-                apply (simp add: field_simps shiftl_t2n bind_assoc pageBits_def
-                                 objBits_simps' placeNewObject_def2)+
-          apply (subst gsCNodes_update gsCNodes_upd_createObjects'_comm)+
-          apply (simp add: modify_modify_bind)
-          apply (rule fun_cong[where x=s])
-          apply (rule arg_cong_bind[OF refl ext])+
-          apply (rule arg_cong_bind[OF _ refl])
-          apply (rule arg_cong[where f=modify, OF ext], simp)
-          apply (rule arg_cong2[where f=gsCNodes_update, OF ext refl])
-          apply (rule ext)
-          apply simp
-         \<comment> \<open>SC, Reply\<close>
-         apply ((simp add: cteSizeBits_def pageBits_def tcbBlockSizeBits_def scBits_simps
-                           epSizeBits_def ntfnSizeBits_def pdBits_def bind_assoc objBits_simps
-                           mapM_def sequence_def Retype_H.createObject_def ARM_H.toAPIType_def
-                           createObjects_def ARM_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 ARM_H.getObjectSize_def
-                           integral_inv[unfolded Fun.comp_def],
-                 subst monad_eq, rule createObjects_Cons;
-                 fastforce simp: field_simps shiftl_t2n bind_assoc pageBits_def objBits_simps'
-                                 placeNewObject_def2 scBits_simps)+)[2]
+            apply (simp_all add: bind_assoc ARM_H.toAPIType_def
+                                 )
+            \<comment> \<open>Untyped\<close>
+            apply (simp add:
+              bind_assoc ARM_H.getObjectSize_def
+              mapM_def sequence_def Retype_H.createObject_def
+              ARM_H.toAPIType_def
+              createObjects_def ARM_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])
+           \<comment> \<open>TCB, EP, NTFN\<close>
+           apply (simp add: bind_assoc
+                      ARM_H.getObjectSize_def
+                      sequence_def Retype_H.createObject_def
+                      ARM_H.toAPIType_def
+                      createObjects_def ARM_H.createObject_def
+                      Arch_createNewCaps_def comp_def
+                      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+)[2]
+             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) = ra" in monad_eq_split2)
+                  apply simp
+                 apply (rule_tac Q = "\<lambda>x s. (ksCurDomain s) = ra" in monad_eq_split)
+                   apply (subst rewrite_step[where f = curDomain and
+                     P ="\<lambda>s. ksCurDomain s = ra" and f' = "return ra"])
+                     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')
+           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:
+                      ARM_H.getObjectSize_def
+                      mapM_def sequence_def Retype_H.createObject_def
+                      ARM_H.toAPIType_def
+                      createObjects_def ARM_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]
+        \<comment> \<open>CNode\<close>
+        apply (simp add: cteSizeBits_def pageBits_def tcbBlockSizeBits_def
+                      epSizeBits_def ntfnSizeBits_def pdBits_def bind_assoc
+                      ARM_H.getObjectSize_def
+                      mapM_def sequence_def Retype_H.createObject_def
+                      ARM_H.toAPIType_def
+                      createObjects_def ARM_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])+
+        apply (subst monad_eq, rule createObjects_Cons)
+              apply (simp add: field_simps shiftl_t2n bind_assoc pageBits_def
+                               objBits_simps' placeNewObject_def2)+
+        apply (subst gsCNodes_update gsCNodes_upd_createObjects'_comm)+
+        apply (simp add: modify_modify_bind)
+        apply (rule fun_cong[where x=s])
+        apply (rule arg_cong_bind[OF refl ext])+
+        apply (rule arg_cong_bind[OF _ refl])
+        apply (rule arg_cong[where f=modify, OF ext], simp)
+        apply (rule arg_cong2[where f=gsCNodes_update, OF ext refl])
+        apply (rule ext)
+        apply simp
+
        \<comment> \<open>SmallPageObject\<close>
        apply (simp add: Arch_createNewCaps_def
-                        Retype_H.createObject_def createObjects_def bind_assoc
-                        ARM_H.toAPIType_def ARM_H.toAPIType_def
+                        Retype_H.createObject_def createObjects_def bind_assoc toAPIType_def
                         ARM_H.createObject_def placeNewDataObject_def)
        apply (intro conjI impI)
+        (* device *)
         apply (subst monad_eq, rule createObjects_Cons)
-             apply (simp_all add: field_simps shiftl_t2n pageBits_def
-                        getObjectSize_def ARM_H.getObjectSize_def
-                        objBits_simps)[7]
-        apply (simp add: bind_assoc placeNewObject_def2 objBits_simps
-                         getObjectSize_def ARM_H.getObjectSize_def
+              apply (simp_all add: field_simps shiftl_t2n pageBits_def
+                                   getObjectSize_def objBits_simps)[6]
+        apply (simp add: bind_assoc placeNewObject_def2 objBits_simps getObjectSize_def
                          pageBits_def add.commute append)
         apply ((subst gsUserPages_update gsCNodes_update
-                    gsUserPages_upd_createObjects'_comm
-                   | simp add: modify_modify_bind o_def)+)[1]
-        apply (subst monad_eq, rule createObjects_Cons)
+                      gsUserPages_upd_createObjects'_comm
+                      monad_commute_simple'[OF dmo'_gsUserPages_upd_map_commute]
+                | simp add: modify_modify_bind o_def)+)[1]
+       (* not device *)
+       apply (subst monad_eq, rule createObjects_Cons)
              apply (simp_all add: field_simps shiftl_t2n pageBits_def
-                        getObjectSize_def ARM_H.getObjectSize_def
-                        objBits_simps)[7]
-        apply (simp add: bind_assoc placeNewObject_def2 objBits_simps
-                         getObjectSize_def ARM_H.getObjectSize_def
-                         pageBits_def add.commute append)
-        apply (subst gsUserPages_update gsCNodes_update
+                                  getObjectSize_def objBits_simps)[6]
+       apply (simp add: bind_assoc placeNewObject_def2 objBits_simps getObjectSize_def
+                        pageBits_def add.commute append mapM_x_append mapM_x_singleton)
+       apply (subst gsUserPages_update gsCNodes_update
                     gsUserPages_upd_createObjects'_comm
-                   | simp add: modify_modify_bind o_def)+
+                    monad_commute_simple'[OF map_dmo'_createObjects'_comm]
+                    monad_commute_simple'[OF dmo'_gsUserPages_upd_map_commute]
+              | simp add: modify_modify_bind o_def)+
       \<comment> \<open>LargePageObject\<close>
       apply (simp add: Arch_createNewCaps_def
-                       Retype_H.createObject_def createObjects_def bind_assoc
-                       ARM_H.toAPIType_def ARM_H.toAPIType_def
+                       Retype_H.createObject_def createObjects_def bind_assoc toAPIType_def
                        ARM_H.createObject_def placeNewDataObject_def)
       apply (intro conjI impI)
+       (* device *)
        apply (subst monad_eq, rule createObjects_Cons)
-            apply (simp_all add: field_simps shiftl_t2n pageBits_def
-                       getObjectSize_def ARM_H.getObjectSize_def
-                       objBits_simps)[7]
-       apply (simp add: bind_assoc placeNewObject_def2 objBits_simps
-                        getObjectSize_def ARM_H.getObjectSize_def
+             apply (simp_all add: field_simps shiftl_t2n pageBits_def
+                                  getObjectSize_def objBits_simps)[6]
+       apply (simp add: bind_assoc placeNewObject_def2 objBits_simps getObjectSize_def
                         pageBits_def add.commute append)
        apply ((subst gsUserPages_update gsCNodes_update
-                   gsUserPages_upd_createObjects'_comm
-                  | simp add: modify_modify_bind o_def)+)[1]
+                     gsUserPages_upd_createObjects'_comm
+                     monad_commute_simple'[OF dmo'_gsUserPages_upd_map_commute]
+               | simp add: modify_modify_bind o_def)+)[1]
+      (* not device *)
       apply (subst monad_eq, rule createObjects_Cons)
             apply (simp_all add: field_simps shiftl_t2n pageBits_def
-                       ARM_H.getObjectSize_def objBits_simps)[7]
-      apply (simp add: bind_assoc placeNewObject_def2 objBits_simps
-                        ARM_H.getObjectSize_def
-                       pageBits_def add.commute append)
+                                 getObjectSize_def objBits_simps)[6]
+      apply (simp add: bind_assoc placeNewObject_def2 objBits_simps getObjectSize_def
+                       pageBits_def add.commute append mapM_x_append mapM_x_singleton)
       apply (subst gsUserPages_update gsCNodes_update
                    gsUserPages_upd_createObjects'_comm
+                   monad_commute_simple'[OF map_dmo'_createObjects'_comm]
+                   monad_commute_simple'[OF dmo'_gsUserPages_upd_map_commute]
              | simp add: modify_modify_bind o_def)+
-     \<comment> \<open>SectionObject\<close>
+    \<comment> \<open>SectionObject\<close>
      apply (simp add: Arch_createNewCaps_def
-                      Retype_H.createObject_def createObjects_def bind_assoc
-                      toAPIType_def ARM_H.toAPIType_def
+                      Retype_H.createObject_def createObjects_def bind_assoc toAPIType_def
                       ARM_H.createObject_def placeNewDataObject_def)
      apply (intro conjI impI)
+      (* device *)
       apply (subst monad_eq, rule createObjects_Cons)
-           apply (simp_all add: field_simps shiftl_t2n pageBits_def
-                      getObjectSize_def ARM_H.getObjectSize_def
-                      objBits_simps)[7]
-      apply (simp add: bind_assoc placeNewObject_def2 objBits_simps
-                       getObjectSize_def ARM_H.getObjectSize_def
+            apply (simp_all add: field_simps shiftl_t2n pageBits_def
+                                 getObjectSize_def objBits_simps)[6]
+      apply (simp add: bind_assoc placeNewObject_def2 objBits_simps getObjectSize_def
                        pageBits_def add.commute append)
       apply ((subst gsUserPages_update gsCNodes_update
                     gsUserPages_upd_createObjects'_comm
+                    monad_commute_simple'[OF dmo'_gsUserPages_upd_map_commute]
               | simp add: modify_modify_bind o_def)+)[1]
+     (* not device *)
      apply (subst monad_eq, rule createObjects_Cons)
            apply (simp_all add: field_simps shiftl_t2n pageBits_def
-                      ARM_H.getObjectSize_def objBits_simps)[7]
-     apply (simp add: bind_assoc placeNewObject_def2 objBits_simps
-                       ARM_H.getObjectSize_def
-                      pageBits_def add.commute append)
+                                getObjectSize_def objBits_simps)[6]
+     apply (simp add: bind_assoc placeNewObject_def2 objBits_simps getObjectSize_def
+                      pageBits_def add.commute append mapM_x_append mapM_x_singleton)
      apply (subst gsUserPages_update gsCNodes_update
                   gsUserPages_upd_createObjects'_comm
+                  monad_commute_simple'[OF map_dmo'_createObjects'_comm]
+                  monad_commute_simple'[OF dmo'_gsUserPages_upd_map_commute]
             | simp add: modify_modify_bind o_def)+
     \<comment> \<open>SuperSectionObject\<close>
     apply (simp add: Arch_createNewCaps_def
-                     Retype_H.createObject_def createObjects_def bind_assoc
-                     toAPIType_def ARM_H.toAPIType_def
+                     Retype_H.createObject_def createObjects_def bind_assoc toAPIType_def
                      ARM_H.createObject_def placeNewDataObject_def)
     apply (intro conjI impI)
+     (* device *)
      apply (subst monad_eq, rule createObjects_Cons)
-          apply (simp_all add: field_simps shiftl_t2n pageBits_def
-                     getObjectSize_def ARM_H.getObjectSize_def
-                     objBits_simps)[7]
-     apply (simp add: bind_assoc placeNewObject_def2 objBits_simps
-                      getObjectSize_def ARM_H.getObjectSize_def
+           apply (simp_all add: field_simps shiftl_t2n pageBits_def
+                                getObjectSize_def objBits_simps)[6]
+     apply (simp add: bind_assoc placeNewObject_def2 objBits_simps getObjectSize_def
                       pageBits_def add.commute append)
      apply ((subst gsUserPages_update gsCNodes_update
-                 gsUserPages_upd_createObjects'_comm
-               | simp add: modify_modify_bind o_def)+)[1]
+                   gsUserPages_upd_createObjects'_comm
+                   monad_commute_simple'[OF dmo'_gsUserPages_upd_map_commute]
+             | simp add: modify_modify_bind o_def)+)[1]
+    (* not device *)
     apply (subst monad_eq, rule createObjects_Cons)
           apply (simp_all add: field_simps shiftl_t2n pageBits_def
-                     ARM_H.getObjectSize_def objBits_simps)[7]
-    apply (simp add: bind_assoc placeNewObject_def2 objBits_simps
-                      ARM_H.getObjectSize_def
-                     pageBits_def add.commute append)
+                               getObjectSize_def objBits_simps)[6]
+    apply (simp add: bind_assoc placeNewObject_def2 objBits_simps getObjectSize_def
+                     pageBits_def add.commute append mapM_x_append mapM_x_singleton)
     apply (subst gsUserPages_update gsCNodes_update
                  gsUserPages_upd_createObjects'_comm
+                 monad_commute_simple'[OF map_dmo'_createObjects'_comm]
+                 monad_commute_simple'[OF dmo'_gsUserPages_upd_map_commute]
            | simp add: modify_modify_bind o_def)+
    \<comment> \<open>PageTableObject\<close>
-   apply (simp add:Arch_createNewCaps_def Retype_H.createObject_def
-           createObjects_def bind_assoc ARM_H.toAPIType_def
-           ARM_H.createObject_def)
-         apply (subst monad_eq,rule createObjects_Cons)
-             apply ((simp add: field_simps shiftl_t2n pageBits_def archObjSize_def
-               getObjectSize_def ARM_H.getObjectSize_def
-               objBits_simps ptBits_def)+)[7]
-         apply (simp add:bind_assoc placeNewObject_def2)
-         apply (simp add: pageBits_def field_simps
-               getObjectSize_def  ptBits_def archObjSize_def
-               ARM_H.getObjectSize_def placeNewObject_def2
-               objBits_simps append)
-
-\<comment> \<open>PageDirectoryObject\<close>
-         apply (simp add:Arch_createNewCaps_def Retype_H.createObject_def
-           createObjects_def bind_assoc ARM_H.toAPIType_def
-           ARM_H.createObject_def)
-         apply (subgoal_tac "distinct (map (\<lambda>n. ptr + (n << 14)) [0.e.((of_nat n)::word32)])")
-         prefer 2
-          apply (clarsimp simp: objBits_simps archObjSize_def pdBits_def pageBits_def
-                                ARM_H.getObjectSize_def)
-          apply (subst upto_enum_word)
-          apply (clarsimp simp:distinct_map)
-          apply (frule range_cover.range_cover_n_le)
-          apply (frule range_cover.range_cover_n_less)
-          apply (rule conjI)
-           apply (clarsimp simp:inj_on_def)
-           apply (rule ccontr)
-           apply (erule_tac bnd = "2^(word_bits - 14)" in shift_distinct_helper[rotated 3])
-                apply simp
-               apply (simp add:word_bits_def)
-              apply (erule less_le_trans[OF word_of_nat_less])
-              apply (simp add: word_of_nat_le word_bits_def pdeBits_def)
-              apply (erule less_le_trans[OF word_of_nat_less])
-              apply (simp add:word_of_nat_le word_bits_def pdeBits_def)
-            apply (frule range_cover.unat_of_nat_n[OF range_cover_le[where n = n]])
-             apply simp
-            apply (rule ccontr)
-            apply simp
-            apply (drule of_nat_inj32[THEN iffD1,rotated -1])
-             apply (simp_all add: word_bits_def)[3]
-           apply (clarsimp)
-           apply (erule_tac bnd = "2^(word_bits - 14)" in shift_distinct_helper[rotated 3])
-                apply simp
-               apply (simp add:word_bits_def)
-             apply (simp add:word_of_nat_less word_bits_def pdeBits_def)
-             apply (erule less_le_trans[OF word_of_nat_less])
-             apply (simp add:word_of_nat_le word_bits_def pdeBits_def)
-           apply (rule ccontr)
-           apply (frule range_cover.unat_of_nat_n[OF range_cover_le[where n = n]])
-            apply simp
-           apply simp
-           apply (drule of_nat_inj32[THEN iffD1,rotated -1])
-            apply (simp_all add: word_bits_def)[3]
-         apply (subst monad_eq,rule createObjects_Cons)
-               apply ((simp add: field_simps shiftl_t2n pageBits_def archObjSize_def
-                 ARM_H.getObjectSize_def pdBits_def
-                 objBits_simps ptBits_def)+)[7]
-         apply (simp add:objBits_simps archObjSize_def pdBits_def pageBits_def ARM_H.getObjectSize_def)
-         apply (simp add:bind_assoc)
-         apply (simp add: placeNewObject_def2[where val = "makeObject::ARM_H.pde",simplified,symmetric])
-         apply (rule_tac Q = "\<lambda>r s. valid_arch_state' s \<and>
-           (\<forall>x\<le>of_nat n. page_directory_at' (ptr + (x << 14)) s) \<and> Q s" for Q in monad_eq_split)
-           apply (rule sym)
-           apply (subst bind_assoc[symmetric])
-           apply (subst monad_commute_simple)
-             apply (rule commute_commute[OF monad_commute_split])
-               apply (rule placeNewObject_doMachineOp_commute)
-              apply (rule mapM_x_commute[where f = id])
-               apply (rule placeNewObject_copyGlobalMapping_commute)
-              apply (rule hoare_pre)
-               apply (wp copyGlobalMappings_pspace_no_overlap' mapM_x_wp'| clarsimp simp: pdeBits_def)+
-            apply (clarsimp simp:objBits_simps archObjSize_def pdBits_def pageBits_def word_bits_conv)
-            apply assumption (* resolve assumption , yuck *)
-           apply (simp add:append mapM_x_append bind_assoc pdeBits_def)
-           apply (rule monad_eq_split[where Q = "\<lambda> r s.  pspace_aligned' s \<and> pspace_distinct' s
-             \<and> valid_arch_state' s \<and> (\<forall>r \<le> of_nat n. page_directory_at' (ptr + (r << 14)) s)
-             \<and>  page_directory_at' (ptr + ((1 + of_nat n) << 14)) s"])
-           apply (rule monad_eq_split[where Q = "\<lambda> r s.  pspace_aligned' s \<and> pspace_distinct' s
-             \<and> valid_arch_state' s \<and> (\<forall>r \<le> of_nat n. page_directory_at' (ptr + (r << 14)) s)
-             \<and>  page_directory_at' (ptr + ((1 + of_nat n) << 14)) s"])
-              apply (subst monad_commute_simple)
-                apply (rule doMachineOp_copyGlobalMapping_commute)
-               apply (clarsimp simp:field_simps)
-              apply (simp add:field_simps mapM_x_singleton)
-              apply (rule monad_eq_split[where Q = "\<lambda> r s.  pspace_aligned' s \<and> pspace_distinct' s
-             \<and> valid_arch_state' s \<and> page_directory_at' (ptr + (1 + of_nat n << 14)) s"])
-                apply (subst doMachineOp_bind)
-                  apply (wp empty_fail_mapM_x empty_fail_cleanCacheRange_PoU)+
-                apply (simp add:bind_assoc objBits_simps field_simps archObjSize_def shiftL_nat)
-               apply wp
-              apply simp
-             apply (rule mapM_x_wp')
-             apply (rule hoare_pre)
-             apply (wp copyGlobalMappings_pspace_no_overlap' | clarsimp)+
-                apply (clarsimp simp:page_directory_at'_def)
-                apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift)
-                apply ((clarsimp simp:page_directory_at'_def)+)[2]
-              apply (wp placeNewObject_pspace_aligned' placeNewObject_pspace_distinct')
-              apply (simp add:placeNewObject_def2 field_simps)
-              apply (rule hoare_vcg_conj_lift)
-               apply (rule createObjects'_wp_subst)
-               apply (wp createObjects_valid_arch[where sz = 14])
-              apply (rule hoare_vcg_conj_lift)
-               apply (clarsimp simp:page_directory_at'_def)
-               apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift createObjects'_typ_at[where sz = 14])
-              apply (rule hoare_strengthen_post[OF createObjects'_page_directory_at'[where sz = 14]])
-              apply simp
-             apply (clarsimp simp:objBits_simps page_directory_at'_def pdeBits_def
-               field_simps archObjSize_def word_bits_conv range_cover_full
-               aligned_add_aligned range_cover.aligned is_aligned_shiftl_self)
-             apply (simp add: pdeBits_def)
-             apply (frule pspace_no_overlap'_le2[where ptr' = "(ptr + (1 + of_nat n << 14))"])
-               apply (subst shiftl_t2n,subst mult.commute, subst suc_of_nat)
-               apply (rule order_trans[OF range_cover_bound,where n1 = "1 + n"])
-                 apply (erule range_cover_le,simp)
-                apply simp
-               apply (rule word_sub_1_le)
-               apply (drule(1) range_cover_no_0[where p = "n+1"])
-                apply simp
-               apply simp
-              apply (erule(1) range_cover_tail_mask)
-           apply (rule hoare_vcg_conj_lift)
-           apply (rule createObjects'_wp_subst)
-            apply (wp createObjects_valid_arch[where sz = sz])
-           apply (wp createObjects'_page_directory_at'[where sz = sz]
-             createObjects'_psp_aligned[where sz = sz]
-             createObjects'_psp_bounded[where sz = sz]
-             createObjects'_psp_distinct[where sz = sz] hoare_vcg_imp_lift
-             createObjects'_pspace_no_overlap[where sz = sz]
-            | simp add:objBits_simps archObjSize_def field_simps pdeBits_def)+
-         apply (drule range_cover_le[where n = "Suc n"])
-          apply simp
-         apply (clarsimp simp:word_bits_def valid_pspace'_def)
-         apply (clarsimp simp:aligned_add_aligned[OF range_cover.aligned] is_aligned_shiftl_self word_bits_def)+
-    done
+   apply (simp add: Arch_createNewCaps_def Retype_H.createObject_def createObjects_def bind_assoc
+                    ARM_H.toAPIType_def ARM_H.createObject_def)
+   apply (subst monad_eq, rule createObjects_Cons)
+         apply ((simp add: field_simps shiftl_t2n  archObjSize_def
+                           getObjectSize_def objBits_simps ptBits_def)+)[6]
+   apply (simp add: bind_assoc placeNewObject_def2)
+   apply (simp add: field_simps bind_assoc gets_modify_def
+                    getObjectSize_def placeNewObject_def2 objBits_simps append mapM_x_append
+                    mapM_x_singleton archObjSize_def)
+   apply (subst monad_commute_simple'[OF map_dmo'_createObjects'_comm]
+          | simp add: modify_modify_bind o_def
+          | simp only: o_def cong: if_cong)+
+    apply (simp add: pteBits_def ptBits_def)
+
+  \<comment> \<open>PageDirectoryObject\<close>
+   apply (simp add: Arch_createNewCaps_def toAPIType_def bind_assoc
+                    createObjects_def createObject_def ARM_H.createObject_def)
+   apply (subst monad_eq, rule createObjects_Cons; simp?)
+    apply (simp add: objBits_simps getObjectSize_def archObjSize_def pdeBits_def pdBits_def)
+   apply (simp add: getObjectSize_def placeNewObject_def2 objBits_simps append mapM_x_append
+                    mapM_x_singleton bind_assoc archObjSize_def pdBits_def pdeBits_def)
+   apply (subst monad_commute_simple'[OF map_dmo'_createObjects'_comm]
+          | simp add: modify_modify_bind o_def
+          | simp only: o_def cong: if_cong)+
+  apply (simp add: placeNewObject_def2[where val = "makeObject::ARM_H.pde",simplified,symmetric])
+  apply (rule_tac Q = "\<lambda>r s. valid_arch_state' s \<and>
+                             (\<forall>x\<le>of_nat n. page_directory_at' (ptr + (x << 14)) s) \<and> Q s" for Q
+                  in monad_eq_split)
+    apply (subst monad_commute_simple)
+      apply (rule mapM_x_commute[where f=id])
+       apply (rule placeNewObject_copyGlobalMapping_commute)
+      apply (wp copyGlobalMappings_pspace_no_overlap')
+      apply clarsimp
+     apply (clarsimp simp:objBits_simps archObjSize_def pdBits_def pageBits_def word_bits_conv)
+     apply (erule TrueE) (* resolve schematic assumption P *)
+     apply assumption (* resolve schematic assumption Q *)
+    apply clarsimp
+    apply (subst monad_commute_simple'[OF mapM_doMachineOp_copyGlobalMapping_commute], simp)
+    apply (simp add: field_simps)
+   apply (wpsimp wp: createObjects'_wp_subst[OF createObjects_valid_arch] hoare_vcg_const_imp_lift
+                     createObjects'_page_directory_at'[where sz=sz]
+                     createObjects'_psp_aligned[where sz=sz]
+                     createObjects'_psp_distinct[where sz=sz]
+                     createObjects'_pspace_no_overlap[where sz=sz]
+                 simp: field_simps pdeBits_def objBits_simps archObjSize_def)
+  apply clarsimp
+  apply (drule range_cover_le[where n = "Suc n"], simp)
+  apply (rule conjI, assumption)
+  apply (clarsimp simp: objBits_simps archObjSize_def pdeBits_def word_bits_def cong: conj_cong)
+  apply (clarsimp simp: aligned_add_aligned[OF range_cover.aligned] is_aligned_shiftl_self)
+  (* distinct (map (\<lambda>n. ptr + (n << 14)) [0 .e. word_of_nat n]) *)
+  apply (subst upto_enum_word)
+  apply (clarsimp simp:distinct_map)
+  apply (frule range_cover.range_cover_n_le)
+  apply (frule range_cover.range_cover_n_less)
+  apply (rule conjI)
+   apply (clarsimp simp:inj_on_def)
+   apply (rule ccontr)
+   apply (erule_tac bnd = "2^(word_bits - 14)" in shift_distinct_helper[rotated 3])
+       apply simp
+      apply (simp add:word_bits_def)
+     apply (erule less_le_trans[OF word_of_nat_less])
+     apply (simp add: word_of_nat_le word_bits_def pdeBits_def)
+    apply (erule less_le_trans[OF word_of_nat_less])
+    apply (simp add:word_of_nat_le word_bits_def pdeBits_def)
+   apply (frule range_cover.unat_of_nat_n[OF range_cover_le[where n = n]])
+    apply simp
+   apply (rule ccontr)
+   apply simp
+   apply (drule of_nat_inj32[THEN iffD1,rotated -1])
+     apply (simp_all add: word_bits_def)[3]
+  apply (clarsimp)
+  apply (erule_tac bnd = "2^(word_bits - 14)" in shift_distinct_helper[rotated 3])
+      apply simp
+     apply (simp add:word_bits_def)
+    apply (simp add:word_of_nat_less word_bits_def pdeBits_def)
+   apply (erule less_le_trans[OF word_of_nat_less])
+   apply (simp add:word_of_nat_le word_bits_def pdeBits_def)
+  apply (rule ccontr)
+  apply (frule range_cover.unat_of_nat_n[OF range_cover_le[where n = n]])
+   apply simp
+  apply simp
+  apply (drule of_nat_inj32[THEN iffD1,rotated -1]; simp add: word_bits_def)
+  done
 qed
 
 lemma createObject_def2:
@@ -5670,8 +5418,7 @@ lemma createNewObjects_def2:
     valid_arch_state' s;
     range_cover ptr sz (Types_H.getObjectSize ty us) (length dslots);
     ptr \<noteq> 0;
-    ksCurDomain s \<le> maxDomain;
-    ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow> sc_size_bounds us\<rbrakk>
+    ksCurDomain s \<le> maxDomain\<rbrakk>
    \<Longrightarrow> createNewObjects ty parent dslots ptr us d s =
        insertNewCaps ty parent dslots ptr us d s"
   apply (clarsimp simp:insertNewCaps_def createNewObjects_def neq_Nil_conv)
@@ -5693,8 +5440,6 @@ lemma createNewObjects_def2:
     {ptr..ptr +  (1 + of_nat (length ys)) * 2 ^ (Types_H.getObjectSize ty us) - 1} s"
   assume range_cover: "range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (length ys))"
   assume unt_at: "cte_wp_at' (\<lambda>c. isUntypedCap (cteCap c)) parent s"
-  assume min_sched_bits: "ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow>
-                            sc_size_bounds us"
   show "zipWithM_x
         (\<lambda>num slot.
             RetypeDecls_H.createObject ty ((num << Types_H.getObjectSize ty us) + ptr) us d >>=
@@ -5743,8 +5488,8 @@ lemma createNewObjects_def2:
       apply (simp add:snoc.hyps bind_assoc)
       apply (rule sym)
       apply (subst monad_eq)
-       apply (erule createNewCaps_Cons[OF _ valid_psp valid_arch_state psp_no_overlap min_sched_bits
-                                         not_0])
+       apply (erule createNewCaps_Cons[OF _ valid_psp valid_arch_state psp_no_overlap not_0])
+      apply (rule sym)
       apply (simp add:bind_assoc del:upto_enum_nat)
       apply (rule_tac Q = "(\<lambda>r s. (\<forall>cap\<in>set r. cap \<noteq> capability.NullCap) \<and>
                             cte_wp_at' (\<lambda>c. isUntypedCap (cteCap c)) parent s \<and>
@@ -5752,37 +5497,40 @@ lemma createNewObjects_def2:
                             (\<forall>slot\<in>set as. cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) slot s) \<and>
                             pspace_no_overlap' (ptr + (1 + of_nat (length as) << Types_H.getObjectSize ty us))
                             (Types_H.getObjectSize ty us) s
-                            \<and> valid_pspace' s \<and> valid_arch_state' s
-                            \<and> (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us)
-                            \<and> Q r s)" for Q in monad_eq_split)
+                            \<and> valid_pspace' s \<and> valid_arch_state' s \<and> Q r s)" for Q in monad_eq_split)
         apply (subst append_Cons[symmetric])
-         apply (subst zipWithM_x_append1)
-         apply clarsimp
-         apply assumption
+        apply (subst zipWithM_x_append1)
+        apply clarsimp
+        apply assumption
         apply (clarsimp simp:field_simps)
-        apply (subst monad_commute_simple)
+        apply (subst monad_commute_simple[OF commute_commute])
          apply (rule new_cap_object_commute)
-        apply (frule_tac p = "1 + length as" in range_cover_no_0[rotated]; clarsimp)
-        apply (intro conjI)
-          apply (simp add:range_cover_def word_bits_def)
-         apply (rule aligned_add_aligned[OF range_cover.aligned],simp)
-          apply (rule is_aligned_shiftl_self)
-         apply simp
-         apply (metis range_cover_ptr_le snoc(8) word_le_0_iff)
-        apply (clarsimp simp: createNewCaps_def min_sched_bits)
+         apply (clarsimp)
+        apply (frule_tac p = "1 + length as" in range_cover_no_0[rotated])
+          apply clarsimp
+          apply simp
+          apply (subst (asm) Abs_fnat_hom_add[symmetric])
+         apply (intro conjI)
+         apply (simp add:range_cover_def word_bits_def)
+           apply (rule aligned_add_aligned[OF range_cover.aligned],simp)
+         apply (rule is_aligned_shiftl_self)
+         apply (simp add:range_cover_def)
+           apply (simp add:range_cover_def)
+          apply (clarsimp simp:field_simps shiftl_t2n)
+         apply (clarsimp simp:createNewCaps_def)
         apply (wp createNewCaps_not_nc createNewCaps_pspace_no_overlap'[where sz = sz]
                   createNewCaps_cte_wp_at'[where sz = sz] hoare_vcg_ball_lift
                   createNewCaps_valid_pspace[where sz = sz]
                   createNewCaps_obj_at'[where sz=sz])
           apply simp
          apply (rule range_cover_le)
-           apply (simp add:objSize_eq_capBits caps_r min_sched_bits)+
+           apply (simp add:objSize_eq_capBits caps_r)+
         apply (wp createNewCaps_ret_len createNewCaps_valid_arch_state)
        apply (frule range_cover_le[where n = "Suc (length as)"])
         apply simp+
        using psp_no_overlap caps_r valid_psp unt_at caps_no_overlap valid_arch_state
-       apply (clarsimp simp: valid_pspace'_def objSize_eq_capBits min_sched_bits)
-       apply (auto simp: kscd min_sched_bits[unfolded sc_size_bounds_def])
+       apply (clarsimp simp: valid_pspace'_def objSize_eq_capBits)
+       apply (auto simp: kscd)
        done
   qed
 qed
@@ -5798,8 +5546,7 @@ assumes check: "distinct dslots"
   \<and> caps_no_overlap'' ptr sz s
   \<and> caps_overlap_reserved'
    {ptr..ptr + of_nat (length dslots) * 2^ (Types_H.getObjectSize ty us) - 1} s
-  \<and> valid_pspace' s \<and> valid_arch_state' s \<and> ksCurDomain s \<le> maxDomain
-  \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow> sc_size_bounds us))"
+  \<and> valid_pspace' s \<and> valid_arch_state' s \<and> ksCurDomain s \<le> maxDomain)"
 shows "corres r P P' f (createNewObjects ty parent dslots ptr us d)"
   using check cover not_0
   apply (clarsimp simp:corres_underlying_def)
@@ -5825,10 +5572,7 @@ lemma createNewObjects_wp_helper:
   and valid_pspace'
   and valid_arch_state'
   and caps_overlap_reserved'
-   {ptr..ptr + of_nat (length dslots) * 2^ (Types_H.getObjectSize ty us) - 1}
-  and (\<lambda>s. ksCurDomain s \<le> maxDomain)
-  and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow>
-           sc_size_bounds us))
+   {ptr..ptr + of_nat (length dslots) * 2^ (Types_H.getObjectSize ty us) - 1} and (\<lambda>s. ksCurDomain s \<le> maxDomain))
   \<rbrace> (createNewObjects ty parent dslots ptr us d) \<lbrace>Q\<rbrace>"
   using assms
   apply (clarsimp simp:valid_def)
@@ -5849,28 +5593,26 @@ lemma createObject_def3:
 lemma ArchCreateObject_pspace_no_overlap':
   "\<lbrace>\<lambda>s. pspace_no_overlap'
           (ptr + (of_nat n << APIType_capBits ty userSize)) sz s \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+        pspace_aligned' s \<and> pspace_distinct' s \<and>
         range_cover ptr sz (APIType_capBits ty userSize) (n + 2) \<and> ptr \<noteq> 0\<rbrace>
    ARM_H.createObject ty
      (ptr + (of_nat n << APIType_capBits ty userSize)) userSize d
    \<lbrace>\<lambda>archCap. pspace_no_overlap'
                 (ptr + (1 + of_nat n << APIType_capBits ty userSize)) sz\<rbrace>"
-  apply (rule hoare_pre)
-   apply (clarsimp simp:ARM_H.createObject_def)
-   apply wpc
-          apply (wp doMachineOp_psp_no_overlap
-              createObjects'_pspace_no_overlap2 hoare_when_weak_wp
-              copyGlobalMappings_pspace_no_overlap'
-              createObjects'_psp_aligned[where sz = sz]
-              createObjects'_psp_distinct[where sz = sz]
-              createObjects'_psp_bounded[where sz = sz]
-            | simp add: placeNewObject_def2 word_shiftl_add_distrib
-            | simp add: placeNewObject_def2 word_shiftl_add_distrib
-            | simp add: placeNewDataObject_def placeNewObject_def2 word_shiftl_add_distrib
-                        field_simps  split del: if_split
-            | clarsimp simp add: add.assoc[symmetric],wp createObjects'_pspace_no_overlap2[where n =0 and sz = sz,simplified]
-            | clarsimp simp add: APIType_capBits_def objBits_simps pageBits_def)+
-
+  supply if_split[split del]
+  apply (clarsimp simp:ARM_H.createObject_def)
+  apply wpc
+         apply (wp doMachineOp_psp_no_overlap
+                   createObjects'_pspace_no_overlap2
+                   createObjects'_psp_aligned[where sz = sz]
+                   createObjects'_psp_distinct[where sz = sz]
+                   copyGlobalMappings_pspace_no_overlap'
+                | simp add: placeNewObject_def2 word_shiftl_add_distrib
+                | simp add: placeNewDataObject_def placeNewObject_def2 word_shiftl_add_distrib
+                            field_simps
+                | clarsimp simp add: add.assoc[symmetric],
+                  wp createObjects'_pspace_no_overlap2[where n =0 and sz = sz,simplified]
+                | clarsimp simp add: APIType_capBits_def objBits_simps pageBits_def)+
   apply (clarsimp simp: conj_comms)
   apply (frule(1) range_cover_no_0[where p = n])
    apply simp
@@ -5886,7 +5628,7 @@ lemma ArchCreateObject_pspace_no_overlap':
    apply simp
   apply (frule pspace_no_overlap'_le2)
     apply (rule range_cover_compare_offset)
-     apply simp+
+      apply simp+
    apply (clarsimp simp:word_shiftl_add_distrib
               ,simp add:field_simps)
    apply (clarsimp simp:add.assoc[symmetric])
@@ -5909,9 +5651,8 @@ lemma to_from_apiTypeD: "toAPIType ty = Some x \<Longrightarrow> ty = fromAPITyp
 lemma createObject_pspace_no_overlap':
   "\<lbrace>\<lambda>s. pspace_no_overlap'
           (ptr + (of_nat n << APIType_capBits ty userSize)) sz s \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+        pspace_aligned' s \<and> pspace_distinct' s
         \<and> range_cover ptr sz (APIType_capBits ty userSize) (n + 2)
-        \<and> (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds userSize)
         \<and> ptr \<noteq> 0\<rbrace>
    createObject ty (ptr + (of_nat n << APIType_capBits ty userSize)) userSize d
    \<lbrace>\<lambda>rv s. pspace_no_overlap'
@@ -5921,19 +5662,35 @@ lemma createObject_pspace_no_overlap':
    apply wpc
     apply (wp ArchCreateObject_pspace_no_overlap')
    apply wpc
-         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 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 clarsimp
   apply (frule(1) range_cover_no_0[where p = n])
    apply simp
@@ -5951,30 +5708,29 @@ lemma createObject_pspace_no_overlap':
    apply (simp add:shiftl_t2n field_simps)
   apply (frule range_cover_offset[rotated,where p = n])
    apply simp+
-  by (auto simp: word_shiftl_add_distrib field_simps shiftl_t2n elim: range_cover_le)
-     (auto simp add: APIType_capBits_def fromAPIType_def objBits_def scBits_simps objBits_simps
-              dest!: to_from_apiTypeD)
+  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
 
 lemma createObject_pspace_aligned_distinct':
-  "\<lbrace>pspace_aligned' and K (is_aligned ptr (APIType_capBits ty us)) and pspace_bounded'
+  "\<lbrace>pspace_aligned' and K (is_aligned ptr (APIType_capBits ty us))
    and pspace_distinct' and pspace_no_overlap' ptr (APIType_capBits ty us)
-   and K (ty = APIObjectType apiobject_type.CapTableObject \<longrightarrow> us < 28)
-   and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow>
-            sc_size_bounds us)\<rbrace>
+   and K (ty = APIObjectType apiobject_type.CapTableObject \<longrightarrow> us < 28)\<rbrace>
   createObject ty ptr us d
-  \<lbrace>\<lambda>xa s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>"
+  \<lbrace>\<lambda>xa s. pspace_aligned' s \<and> pspace_distinct' s\<rbrace>"
   apply (rule hoare_pre)
   apply (wp placeNewObject_pspace_aligned' unless_wp
-      placeNewObject_pspace_distinct' placeNewObject_pspace_bounded'
+      placeNewObject_pspace_distinct'
     | simp add:ARM_H.createObject_def
       Retype_H.createObject_def objBits_simps
       curDomain_def placeNewDataObject_def
           split del: if_split
     | wpc | intro conjI impI)+
-  by (auto simp: APIType_capBits_def pdBits_def objBits_simps' pteBits_def pdeBits_def
-                 pageBits_def word_bits_def archObjSize_def ptBits_def ARM_H.toAPIType_def
-                 untypedBits_defs scBits_simps
-          split: ARM_H.object_type.splits apiobject_type.splits)
+  apply (auto simp:APIType_capBits_def pdBits_def objBits_simps' pteBits_def pdeBits_def
+    pageBits_def word_bits_def archObjSize_def ptBits_def ARM_H.toAPIType_def
+    split:ARM_H.object_type.splits apiobject_type.splits)
+  done
 
 declare objSize_eq_capBits [simp]
 
@@ -6030,23 +5786,22 @@ lemma insertNewCap_wps[wp]:
       insertNewCap parent slot cap
    \<lbrace>\<lambda>rv s. P (cteCaps_of s)\<rbrace>"
   apply (simp_all add: insertNewCap_def)
-   apply (wpsimp wp: hoare_drop_imps)+
+   apply (wp hoare_drop_imps
+            | simp add: o_def)+
   apply (fastforce elim!: rsubst[where P=P])
   done
 
 crunch insertNewCap
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and pspace_bounded'[wp]: pspace_bounded'
   (wp: crunch_wps)
 
 lemma createNewObjects_pspace_no_overlap':
-  "\<lbrace>pspace_no_overlap' ptr sz and pspace_aligned' and pspace_distinct' and pspace_bounded'
+  "\<lbrace>pspace_no_overlap' ptr sz and pspace_aligned' and pspace_distinct'
   and K (range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (length dests)))
   and K (ptr \<noteq> 0)
-  and K (ty = APIObjectType apiobject_type.CapTableObject \<longrightarrow> us < 28)
-  and K (ty = APIObjectType apiobject_type.SchedContextObject \<longrightarrow> sc_size_bounds us)\<rbrace>
+  and K (ty = APIObjectType apiobject_type.CapTableObject \<longrightarrow> us < 28)\<rbrace>
   createNewObjects ty src dests ptr us d
-  \<lbrace>\<lambda>rv s.  pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  \<lbrace>\<lambda>rv s.  pspace_aligned' s \<and> pspace_distinct' s \<and>
   pspace_no_overlap' ((of_nat (length dests) << APIType_capBits ty us) + ptr) sz s\<rbrace>"
   apply (rule hoare_gen_asm)+
   proof (induct rule:rev_induct )
@@ -6065,39 +5820,41 @@ lemma createNewObjects_pspace_no_overlap':
      apply (subst createNewObjects_Cons)
       apply (drule range_cover.weak)
       apply (simp add: word_bits_def)
-     apply (wpsimp wp: pspace_no_overlap'_lift2)
-       apply (simp add: conj_comms)
-       apply (subst conj_assoc[symmetric])
-       apply (subst conj_assoc[symmetric])
-       apply (rule hoare_vcg_conj_lift)
-        apply (rule hoare_post_imp[OF _ createObject_pspace_aligned_distinct'])
-        apply simp
-       apply (simp add:field_simps)
-       apply (wp createObject_pspace_no_overlap')
-      apply (clarsimp simp: conj_comms)
-      apply (rule hoare_pre)
-       apply (subst conj_assoc[symmetric])
-       apply (subst conj_assoc[symmetric])
-       apply (rule hoare_vcg_conj_lift)
-        apply (rule hoare_post_imp[OF _ snoc.hyps])
-            apply (simp add:snoc)+
-       apply wp
-       apply (simp add: conj_comms field_simps)
-       apply (rule hoare_post_imp)
-        apply (erule context_conjI)
-        apply (intro conjI)
-         apply (rule aligned_add_aligned[OF range_cover.aligned
-                                            is_aligned_shiftl_self])
+     apply (wp pspace_no_overlap'_lift)
+      apply (simp add: conj_comms)
+      apply (rule hoare_vcg_conj_lift)
+       apply (rule hoare_post_imp[OF _ createObject_pspace_aligned_distinct'])
+       apply simp
+      apply (rule hoare_vcg_conj_lift)
+       apply (rule hoare_post_imp[OF _ createObject_pspace_aligned_distinct'])
+       apply simp
+      apply (simp add:field_simps)
+      apply (wp createObject_pspace_no_overlap')
+     apply (clarsimp simp: conj_comms)
+     apply (rule hoare_pre)
+      apply (rule hoare_vcg_conj_lift)
+       apply (rule hoare_post_imp[OF _ snoc.hyps])
+       apply (simp add:snoc)+
+      apply (rule hoare_vcg_conj_lift)
+       apply (rule hoare_post_imp[OF _ snoc.hyps])
+       apply (simp add:snoc)+
+      apply wp
+     apply (simp add: conj_comms field_simps)
+     apply (rule hoare_post_imp)
+     apply (erule context_conjI)
+      apply (intro conjI)
+        apply (rule aligned_add_aligned[OF range_cover.aligned
+                                           is_aligned_shiftl_self])
           apply simp
          apply simp
         apply simp
-        apply (erule pspace_no_overlap'_le)
-         apply (simp add: range_cover.sz[where 'a=32, folded word_bits_def])+
-       apply (rule hoare_post_imp[OF _ snoc.hyps])
-           apply (simp add:field_simps snoc)+
-     using snoc
-     apply simp
-     done
+       apply (erule pspace_no_overlap'_le)
+       apply (simp add: range_cover.sz[where 'a=32, folded word_bits_def])+
+     apply (rule hoare_post_imp[OF _ snoc.hyps])
+     apply (simp add:field_simps snoc)+
+    using snoc
+    apply simp
+  done
 qed
 
 end
diff --git a/proof/refine/ARM/EmptyFail.thy b/proof/refine/ARM/EmptyFail.thy
index 259d293eb3..9db1629920 100644
--- a/proof/refine/ARM/EmptyFail.thy
+++ b/proof/refine/ARM/EmptyFail.thy
@@ -12,26 +12,38 @@ begin
    Unless there is a good reason, they should all be [intro!, wp, simp] *)
 
 lemma empty_fail_projectKO [simp, intro!]:
-  "empty_fail (gets_the $ projectKO v)" by wpsimp
+  "empty_fail (projectKO v)"
+  unfolding empty_fail_def projectKO_def
+  by (simp add: return_def fail_def split: option.splits)
 
 lemma empty_fail_alignCheck [intro!, wp, simp]:
   "empty_fail (alignCheck a b)"
-  unfolding alignCheck_def by wpsimp
+  unfolding alignCheck_def
+  by (fastforce simp: alignError_def)
 
 lemma empty_fail_magnitudeCheck [intro!, wp, simp]:
   "empty_fail (magnitudeCheck a b c)"
-  unfolding magnitudeCheck_def by wpsimp
+  unfolding magnitudeCheck_def
+  by (fastforce split: option.splits)
 
 lemma empty_fail_loadObject_default [intro!, wp, simp]:
-  shows "empty_fail (gets_the $ loadObject_default x b c d)" by wpsimp
+  shows "empty_fail (loadObject_default x b c d)"
+  by (auto simp: loadObject_default_def
+           split: option.splits)
 
 lemma empty_fail_threadGet [intro!, wp, simp]:
   "empty_fail (threadGet f p)"
-  by (wpsimp simp: threadGet_def)
+  by (fastforce simp: threadGet_def getObject_def split_def)
 
 lemma empty_fail_getCTE [intro!, wp, simp]:
   "empty_fail (getCTE slot)"
-  by (wpsimp simp: getCTE_def getObject_def)
+  apply (simp add: getCTE_def getObject_def split_def)
+  apply (intro empty_fail_bind, simp_all)
+  apply (simp add: loadObject_cte typeError_def alignCheck_def alignError_def
+                   magnitudeCheck_def
+            split: Structures_H.kernel_object.split)
+  apply (auto split: option.split)
+  done
 
 lemma empty_fail_updateObject_cte [intro!, wp, simp]:
   "empty_fail (updateObject (v :: cte) ko a b c)"
@@ -50,16 +62,18 @@ lemma empty_fail_getSlotCap [intro!, wp, simp]:
   "empty_fail (getSlotCap a)"
   unfolding getSlotCap_def by fastforce
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma empty_fail_getObject:
-  "empty_fail (getObject x :: 'a :: pspace_storable kernel)"
-  apply (wpsimp simp: getObject_def split_def)
+  assumes "\<And>b c d. empty_fail (loadObject x b c d::'a :: pspace_storable kernel)"
+  shows "empty_fail (getObject x :: 'a :: pspace_storable kernel)"
+  apply (simp add: getObject_def split_def)
+  apply (safe intro!: assms)
   done
 
 lemma empty_fail_getObject_tcb [intro!, wp, simp]:
   shows "empty_fail (getObject x :: tcb kernel)"
-  by (wpsimp wp: empty_fail_getObject)
+  by (auto intro: empty_fail_getObject)
 
 lemma empty_fail_updateTrackedFreeIndex [intro!, wp, simp]:
   shows "empty_fail (updateTrackedFreeIndex p idx)"
@@ -82,7 +96,7 @@ lemma empty_fail_getIRQSlot [intro!, wp, simp]:
 
 lemma empty_fail_getObject_ntfn [intro!, wp, simp]:
   "empty_fail (getObject p :: Structures_H.notification kernel)"
-  by (wpsimp wp: empty_fail_getObject)
+  by (simp add: empty_fail_getObject)
 
 lemma empty_fail_getNotification [intro!, wp, simp]:
   "empty_fail (getNotification ep)"
@@ -96,11 +110,11 @@ lemma empty_fail_lookupIPCBuffer [intro!, wp, simp]:
 
 lemma empty_fail_updateObject_default [intro!, wp, simp]:
   "empty_fail (updateObject_default v ko a b c)"
-  by (wpsimp simp: updateObject_default_def)
+  by (fastforce simp: updateObject_default_def typeError_def unless_def split: kernel_object.splits)
 
 lemma empty_fail_threadSet [intro!, wp, simp]:
   "empty_fail (threadSet f p)"
-  by (wpsimp simp: threadSet_def setObject_def)
+  by (fastforce simp: threadSet_def getObject_def setObject_def split_def)
 
 lemma empty_fail_getThreadState[iff]:
   "empty_fail (getThreadState t)"
diff --git a/proof/refine/ARM/EmptyFail_H.thy b/proof/refine/ARM/EmptyFail_H.thy
index 3468e6b262..b2327d07fb 100644
--- a/proof/refine/ARM/EmptyFail_H.thy
+++ b/proof/refine/ARM/EmptyFail_H.thy
@@ -9,11 +9,11 @@ imports Refine
 begin
 
 crunch_ignore (empty_fail)
-  (add: handleE' getCTE getObject updateObject ifM andM orM whileM ifM
+  (add: handleE' getCTE getObject updateObject
         CSpaceDecls_H.resolveAddressBits
         doMachineOp suspend restart schedule)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemmas forM_empty_fail[intro!, wp, simp] = empty_fail_mapM[simplified forM_def[symmetric]]
 lemmas forM_x_empty_fail[intro!, wp, simp] = empty_fail_mapM_x[simplified forM_x_def[symmetric]]
@@ -93,10 +93,6 @@ lemma empty_fail_getObject_ep [intro!, wp, simp]:
   "empty_fail (getObject p :: endpoint kernel)"
   by (simp add: empty_fail_getObject)
 
-lemma empty_fail_getObject_reply [intro!, wp, simp]:
-  "empty_fail (getObject p :: reply kernel)"
-  by (simp add: empty_fail_getObject)
-
 lemma getEndpoint_empty_fail [intro!, wp, simp]:
   "empty_fail (getEndpoint ep)"
   by (simp add: getEndpoint_def)
@@ -167,22 +163,14 @@ lemma ignoreFailure_empty_fail[intro!, wp, simp]:
   "empty_fail x \<Longrightarrow> empty_fail (ignoreFailure x)"
   by (simp add: ignoreFailure_def empty_fail_catch)
 
-lemma empty_fail_getObject_sc [intro!, wp, simp]:
-   "empty_fail (getObject p :: sched_context kernel)"
-   by (simp add: empty_fail_getObject)
-
-crunch "SchedContextDecls_H.postpone"
- for (empty_fail) "_H_empty_fail"[intro!, wp, simp]
-  (simp: getSchedContext_def)
-
 context
 notes option.case_cong_weak[cong]
 begin
 crunch
-  cancelIPC, setThreadState, tcbSchedDequeue, isStopped, possibleSwitchTo, tcbSchedAppend,
-  refillUnblockCheck, schedContextResume, ifCondRefillUnblockCheck
- for (empty_fail) empty_fail[intro!, wp, simp]
-  (simp: Let_def wp: empty_fail_whileLoop)
+  cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isStopped,
+  possibleSwitchTo, tcbSchedAppend
+  for (empty_fail) empty_fail[intro!, wp, simp]
+  (simp: crunch_simps)
 end
 
 crunch "ThreadDecls_H.suspend"
@@ -191,7 +179,7 @@ crunch "ThreadDecls_H.suspend"
 
 lemma ThreadDecls_H_restart_empty_fail[intro!, wp, simp]:
   "empty_fail (ThreadDecls_H.restart target)"
-  unfolding restart_def getCurSc_def by wpsimp
+  by (fastforce simp: restart_def)
 
 crunch finaliseCap, preemptionPoint, capSwapForDelete
   for (empty_fail) empty_fail[intro!, wp, simp]
@@ -271,44 +259,24 @@ lemma catchError_empty_fail[intro!, wp, simp]:
   by fastforce
 
 crunch
-  chooseThread, getDomainTime, nextDomain, isHighestPrio, switchSchedContext, setNextInterrupt
- for (empty_fail) empty_fail[intro!, wp, simp]
-  (wp: empty_fail_catch empty_fail_setDeadline empty_fail_whileLoop)
-
-crunch tcbReleaseDequeue
- for (empty_fail) empty_fail[intro!, wp, simp]
-
-lemma awaken_empty_fail[intro!, wp, simp]:
-  "empty_fail awaken"
-  apply (clarsimp simp: awaken_def awakenBody_def)
-  apply (wpsimp wp: empty_fail_whileLoop)
-  done
+  chooseThread, getDomainTime, nextDomain, isHighestPrio
+  for (empty_fail) empty_fail[intro!, wp, simp]
+  (wp: empty_fail_catch)
 
 lemma ThreadDecls_H_schedule_empty_fail[intro!, wp, simp]:
   "empty_fail schedule"
-  apply (simp add: schedule_def scAndTimer_def checkDomainTime_def)
-  apply (clarsimp simp: scheduleChooseNewThread_def split: if_split | wp | wpc | intro conjI impI)+
+  apply (simp add: schedule_def)
+  apply (clarsimp simp: scheduleChooseNewThread_def split: if_split | wp | wpc)+
   done
 
-lemma tcbEPFindIndex_empty_fail[intro!, wp, simp]:
-  "empty_fail (tcbEPFindIndex t qs ci)"
-  by (induct ci; subst tcbEPFindIndex.simps; wpsimp)
-
 crunch callKernel
- for (empty_fail) empty_fail
+  for (empty_fail) empty_fail
   (wp: empty_fail_catch)
 
 theorem call_kernel_serial:
   "\<lbrakk> (einvs and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running s) and (ct_running or ct_idle) and
-                schact_is_rct and
-                current_time_bounded and
-                consumed_time_bounded and
-                valid_machine_time and
-                ct_not_in_release_q and
-                cur_sc_active and
-                (\<lambda>s. cur_sc_offset_ready (consumed_time s) s) and
-                (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s) and
-                (\<lambda>s. 0 < domain_time s \<and> valid_domain_list s)) s;
+              schact_is_rct and
+              (\<lambda>s. 0 < domain_time s \<and> valid_domain_list s)) s;
        \<exists>s'. (s, s') \<in> state_relation \<and>
             (invs' and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running' s) and (ct_running' or ct_idle') and
               (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
diff --git a/proof/refine/ARM/Finalise_R.thy b/proof/refine/ARM/Finalise_R.thy
index 7d7f44acc0..3d04c44a1e 100644
--- a/proof/refine/ARM/Finalise_R.thy
+++ b/proof/refine/ARM/Finalise_R.thy
@@ -10,7 +10,7 @@ imports
   InterruptAcc_R
   Retype_R
 begin
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 declare doUnbindNotification_def[simp]
 
@@ -37,8 +37,6 @@ lemma updateCap_cte_wp_at_cases:
 crunch postCapDeletion, updateTrackedFreeIndex
   for cte_wp_at'[wp]: "cte_wp_at' P p"
 
-end
-
 lemma updateFreeIndex_cte_wp_at:
   "\<lbrace>\<lambda>s. cte_at' p s \<and> P (cte_wp_at' (if p = p' then P'
       o (cteCap_update (capFreeIndex_update (K idx))) else P') p' s)\<rbrace>
@@ -66,13 +64,10 @@ lemma emptySlot_cte_wp_cap_other:
               | wp (once) hoare_drop_imps)+
   done
 
-crunch clearUntypedFreeIndex
-  for sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-
-global_interpretation clearUntypedFreeIndex: typ_at_all_props' "clearUntypedFreeIndex slot"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+crunch emptySlot
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+lemmas clearUntypedFreeIndex_typ_ats[wp]
+    = typ_at_lifts[OF clearUntypedFreeIndex_typ_at']
 
 crunch postCapDeletion
   for tcb_at'[wp]: "tcb_at' t"
@@ -83,26 +78,20 @@ crunch clearUntypedFreeIndex
   (wp: cur_tcb_lift)
 
 crunch emptySlot
- for ksRQ[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  for ksRQ[wp]: "\<lambda>s. P (ksReadyQueues s)"
 crunch emptySlot
- for ksRLQ[wp]: "\<lambda>s. P (ksReleaseQueue s)"
+  for ksRQL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
 crunch emptySlot
- for ksRQL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
-crunch emptySlot
- for ksRQL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  for ksRQL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
 crunch postCapDeletion
- for obj_at'[wp]: "\<lambda>s. Q (obj_at' P p s)"
+  for obj_at'[wp]: "obj_at' P p"
 
 crunch clearUntypedFreeIndex
- for inQ[wp]: "\<lambda>s. P (obj_at' (inQ d p) t s)"
-crunch clearUntypedFreeIndex
- for tcbInReleaseQueue[wp]: "\<lambda>s. P (obj_at' (tcbInReleaseQueue) t s)"
+  for inQ[wp]: "\<lambda>s. P (obj_at' (inQ d p) t s)"
 crunch clearUntypedFreeIndex
- for tcbDomain[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
-crunch clearUntypedFreeIndex
- for tcbPriority[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
+  for tcbDomain[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
 crunch clearUntypedFreeIndex
- for tcbQueued[wp]: "obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t"
+  for tcbPriority[wp]: "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
 
 crunch emptySlot
   for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
@@ -161,8 +150,9 @@ lemma mdb_chunked2D:
   done
 
 lemma nullPointer_eq_0_simp[simp]:
+  "(nullPointer = 0) = True"
   "(0 = nullPointer) = True"
-  by (simp add: nullPointer_def)
+  by (simp add: nullPointer_def)+
 
 lemma no_0_no_0_lhs_trancl [simp]:
   "no_0 m \<Longrightarrow> \<not> m \<turnstile> 0 \<leadsto>\<^sup>+ x"
@@ -191,7 +181,7 @@ locale mdb_empty =
                slot (cteCap_update (%_. capability.NullCap)))
               slot (cteMDBNode_update (const nullMDBNode))"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 
 lemmas m_slot_prev = m_p_prev
 lemmas m_slot_next = m_p_next
@@ -1068,6 +1058,24 @@ lemma irq_control_n [simp]: "irq_control n"
   apply (erule (1) irq_controlD, rule irq_control)
   done
 
+lemma reply_masters_rvk_fb_m: "reply_masters_rvk_fb m"
+  using valid by auto
+
+lemma reply_masters_rvk_fb_n [simp]: "reply_masters_rvk_fb n"
+  using reply_masters_rvk_fb_m
+  apply (simp add: reply_masters_rvk_fb_def n_def
+                   ball_ran_modify_map_eq
+                   modify_map_comp[symmetric])
+  apply (subst ball_ran_modify_map_eq)
+   apply (frule bspec, rule ranI, rule slot)
+   apply (simp add: nullMDBNode_def isCap_simps modify_map_def
+                    slot)
+  apply (subst ball_ran_modify_map_eq)
+   apply (clarsimp simp add: modify_map_def)
+   apply fastforce
+  apply (simp add: ball_ran_modify_map_eq)
+  done
+
 lemma vmdb_n: "valid_mdb_ctes n"
   by (simp add: valid_mdb_ctes_def valid_dlist_n
                 no_0_n mdb_chain_0_n valid_badges_n
@@ -1109,8 +1117,9 @@ end
 lemma if_live_then_nonz_cap'_def2:
   "if_live_then_nonz_cap' = (\<lambda>s. \<forall>ptr. ko_wp_at' live' ptr s
                                \<longrightarrow> (\<exists>p zr. (option_map zobj_refs' o cteCaps_of s) p = Some zr \<and> ptr \<in> zr))"
-  by (fastforce simp: if_live_then_nonz_cap'_def ex_nonz_cap_to'_def
-                      cte_wp_at_ctes_of cteCaps_of_def)
+  by (fastforce intro!: ext
+                 simp: if_live_then_nonz_cap'_def ex_nonz_cap_to'_def
+                       cte_wp_at_ctes_of cteCaps_of_def)
 
 lemma updateMDB_ko_wp_at_live[wp]:
   "\<lbrace>\<lambda>s. P (ko_wp_at' live' p' s)\<rbrace>
@@ -1128,9 +1137,21 @@ lemma updateCap_ko_wp_at_live[wp]:
   unfolding updateCap_def
   by wp
 
-fun threadCapRefs :: "capability \<Rightarrow> word32 set" where
-  "threadCapRefs (ThreadCap r) = {r}"
-| "threadCapRefs _             = {}"
+primrec
+  threadCapRefs :: "capability \<Rightarrow> word32 set"
+where
+  "threadCapRefs (ThreadCap r)                  = {r}"
+| "threadCapRefs (ReplyCap t m x)               = {}"
+| "threadCapRefs NullCap                        = {}"
+| "threadCapRefs (UntypedCap d r n i)           = {}"
+| "threadCapRefs (EndpointCap r badge x y z t)  = {}"
+| "threadCapRefs (NotificationCap r badge x y)  = {}"
+| "threadCapRefs (CNodeCap r b g gsz)           = {}"
+| "threadCapRefs (Zombie r b n)                 = {}"
+| "threadCapRefs (ArchObjectCap ac)             = {}"
+| "threadCapRefs (IRQHandlerCap irq)            = {}"
+| "threadCapRefs (IRQControlCap)                = {}"
+| "threadCapRefs (DomainCap)                    = {}"
 
 definition
   "isFinal cap p m \<equiv>
@@ -1191,7 +1212,8 @@ lemma emptySlot_iflive'[wp]:
              hoare_vcg_ex_lift
              | wp (once) hoare_vcg_imp_lift
              | simp add: cte_wp_at_ctes_of del: comp_apply)+
-  apply (clarsimp simp: modify_map_same imp_conjR[symmetric])
+  apply (clarsimp simp: modify_map_same
+    imp_conjR[symmetric])
   apply (drule spec, drule(1) mp)
   apply (clarsimp simp: cte_wp_at_ctes_of modify_map_def split: if_split_asm)
   apply (case_tac "p \<noteq> sl")
@@ -1199,13 +1221,16 @@ lemma emptySlot_iflive'[wp]:
   apply (simp add: removeable'_def cteCaps_of_def)
   apply (erule disjE)
    apply (clarsimp simp: cte_wp_at_ctes_of modify_map_def
-                   dest!: capMaster_same_refs)
+                  dest!: capMaster_same_refs)
    apply fastforce
   apply clarsimp
   apply (drule(1) bspec)
   apply (clarsimp simp: ko_wp_at'_def)
   done
 
+crunch doMachineOp
+  for irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+
 lemma setIRQState_irq_node'[wp]:
   "\<lbrace>\<lambda>s. P (irq_node' s)\<rbrace> setIRQState state irq \<lbrace>\<lambda>_ s. P (irq_node' s)\<rbrace>"
   apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def)
@@ -1250,7 +1275,10 @@ lemma emptySlot_ifunsafe'[wp]:
 
 lemma ctes_of_valid'[elim]:
   "\<lbrakk>ctes_of s p = Some cte; valid_objs' s\<rbrakk> \<Longrightarrow> s \<turnstile>' cteCap cte"
-  by (rule ctes_of_valid_cap'')
+  by (cases cte, simp) (rule ctes_of_valid_cap')
+
+crunch postCapDeletion
+  for ksrq[wp]: "\<lambda>s. P (ksReadyQueues s)"
 
 crunch setInterruptState
   for valid_idle'[wp]: "valid_idle'"
@@ -1298,7 +1326,7 @@ lemma emptySlot_valid_global_refs[wp]:
   done
 
 lemmas doMachineOp_irq_handlers[wp]
-    = valid_irq_handlers_lift'' [OF doMachineOp_ctes doMachineOp_ksInterrupt]
+    = valid_irq_handlers_lift'' [OF doMachineOp_ctes doMachineOp_ksInterruptState]
 
 lemma deletedIRQHandler_irq_handlers'[wp]:
   "\<lbrace>\<lambda>s. valid_irq_handlers' s \<and> (IRQHandlerCap irq \<notin> ran (cteCaps_of s))\<rbrace>
@@ -1358,15 +1386,9 @@ lemma deletedIRQHandler_irqs_masked'[wp]:
   apply (simp add: irqs_masked'_def)
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemma setObject_cte_irq_masked'[wp]:
-  "setObject p (v::cte) \<lbrace>irqs_masked'\<rbrace>"
-  unfolding setObject_def
-  by (wpsimp simp: irqs_masked'_def Ball_def wp: hoare_vcg_all_lift hoare_vcg_imp_lift' updateObject_cte_inv)
-
+context begin interpretation Arch . (*FIXME: arch-split*)
 crunch emptySlot
- for irqs_masked'[wp]: "irqs_masked'"
+  for irqs_masked'[wp]: "irqs_masked'"
 
 lemma setIRQState_umm:
  "\<lbrace>\<lambda>s. P (underlying_memory (ksMachineState s))\<rbrace>
@@ -1387,8 +1409,30 @@ lemma emptySlot_vms'[wp]:
 
 crunch emptySlot
   for pspace_domain_valid[wp]: "pspace_domain_valid"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+
+crunch emptySlot
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+crunch emptySlot
+  for ct[wp]: "\<lambda>s. P (ksCurThread s)"
+crunch emptySlot
+  for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
+crunch emptySlot
+  for ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
+crunch emptySlot
+  for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+
+lemma deletedIRQHandler_ct_not_inQ[wp]:
+  "\<lbrace>ct_not_inQ\<rbrace> deletedIRQHandler irq \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+  apply (rule ct_not_inQ_lift [OF deletedIRQHandler_nosch])
+  apply (rule hoare_weaken_pre)
+   apply (wps deletedIRQHandler_ct)
+   apply (simp add: deletedIRQHandler_def setIRQState_def)
+   apply (wp)
+  apply (simp add: comp_def)
+  done
+
+crunch emptySlot
+  for ct_not_inQ[wp]: "ct_not_inQ"
 
 crunch emptySlot
   for tcbDomain[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
@@ -1430,18 +1474,21 @@ lemma emptySlot_untyped_ranges[wp]:
   done
 
 crunch emptySlot
-  for replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
-  and pspace_bounded'[wp]: pspace_bounded'
+  for valid_bitmaps[wp]: valid_bitmaps
+  and tcbQueued_opt_pred[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and sched_projs[wp]: "\<lambda>s. P (tcbSchedNexts_of s) (tcbSchedPrevs_of s)"
+  (wp: valid_bitmaps_lift)
 
 lemma emptySlot_invs'[wp]:
   "\<lbrace>\<lambda>s. invs' s \<and> cte_wp_at' (\<lambda>cte. removeable' sl s (cteCap cte)) sl s
             \<and> (\<forall>sl'. info \<noteq> NullCap \<longrightarrow> sl' \<noteq> sl \<longrightarrow> cteCaps_of s sl' \<noteq> Some info)\<rbrace>
      emptySlot sl info
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
   apply (rule hoare_pre)
-   apply (wp valid_arch_state_lift' valid_irq_node_lift cur_tcb_lift valid_replies'_lift)
-  apply (clarsimp simp: cte_wp_at_ctes_of o_def)
+   apply (wp valid_arch_state_lift' valid_irq_node_lift cur_tcb_lift)
+  apply (clarsimp simp: cte_wp_at_ctes_of)
   done
 
 lemma deletedIRQHandler_corres:
@@ -1467,7 +1514,7 @@ lemma set_cap_trans_state:
   "((),s') \<in> fst (set_cap c p s) \<Longrightarrow> ((),trans_state f s') \<in> fst (set_cap c p (trans_state f s))"
   apply (cases p)
   apply (clarsimp simp add: set_cap_def in_monad set_object_def get_object_def)
-  apply (rename_tac obj s'' obj' kobj; case_tac obj)
+  apply (case_tac y)
   apply (auto simp add: in_monad set_object_def split: if_split_asm)
   done
 
@@ -1490,7 +1537,8 @@ lemma clearUntypedFreeIndex_noop_corres:
 lemma clearUntypedFreeIndex_valid_pspace'[wp]:
   "\<lbrace>valid_pspace'\<rbrace> clearUntypedFreeIndex slot \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   apply (simp add: valid_pspace'_def)
-  apply (wpsimp wp: valid_replies'_lift valid_mdb'_lift)
+  apply (rule hoare_pre)
+   apply (wp | simp add: valid_mdb'_def)+
   done
 
 lemma emptySlot_corres:
@@ -1540,20 +1588,36 @@ 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, fastforce, fastforce)
-   apply (clarsimp simp: invs'_def valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
+  apply (drule updateMDB_the_lot, fastforce simp: pspace_relations_def, fastforce, fastforce)
+   apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
+                         valid_mdb'_def valid_mdb_ctes_def)
   apply (elim conjE)
   apply (drule (4) updateMDB_the_lot, elim conjE)
   apply clarsimp
-  apply (drule_tac s'=s''a and c=cap.NullCap in set_cap_not_quite_corres; (simp (no_asm_simp))?)
-      subgoal by fastforce
-     subgoal by fastforce
-    subgoal by fastforce
-   apply (erule cte_wp_at_weakenE, rule TrueI)
+  apply (drule_tac s'=s''a and c=cap.NullCap in set_cap_not_quite_corres)
+                     subgoal by simp
+                    subgoal by simp
+                   subgoal by simp
+                  subgoal by fastforce
+                 subgoal by fastforce
+                subgoal by fastforce
+               subgoal by fastforce
+              subgoal by fastforce
+             apply fastforce
+            subgoal by fastforce
+           subgoal by fastforce
+          subgoal by fastforce
+         apply (erule cte_wp_at_weakenE, rule TrueI)
+        apply assumption
+       subgoal by simp
+      subgoal by simp
+     subgoal by simp
+    subgoal by simp
+   apply (rule refl)
   apply clarsimp
   apply (drule updateCap_stuff, elim conjE, erule (1) impE)
   apply clarsimp
-  apply (drule updateMDB_the_lot, force, assumption+, simp)
+  apply (drule updateMDB_the_lot, force simp: pspace_relations_def, assumption+, simp)
   apply (rule bexI)
    prefer 2
    apply (simp only: trans_state_update[symmetric])
@@ -1577,11 +1641,11 @@ lemma emptySlot_corres:
    apply (rule mdb_empty.intro)
    apply (rule mdb_ptr.intro)
     apply (rule vmdb.intro)
-    subgoal by (simp add: invs'_def valid_pspace'_def valid_mdb'_def)
+    subgoal by (simp add: invs'_def valid_state'_def valid_pspace'_def valid_mdb'_def)
    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 (rule conjI)
    apply (clarsimp simp: data_at_def ghost_relation_typ_at set_cap_a_type_inv)
   apply (rule conjI)
@@ -1614,7 +1678,7 @@ lemma emptySlot_corres:
       prefer 2
       apply(drule_tac cte="CTE s_cap s_node" in valid_mdbD2')
         subgoal by (clarsimp simp: valid_mdb_ctes_def no_0_def)
-       subgoal by (clarsimp simp: invs'_def valid_pspace'_def)
+       subgoal by (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
       apply(clarsimp)
       apply(rule cte_map_inj_eq)
            apply(assumption)
@@ -1734,9 +1798,7 @@ where
  "final_matters' cap \<equiv> case cap of
     EndpointCap ref bdg s r g gr \<Rightarrow> True
   | NotificationCap ref bdg s r \<Rightarrow> True
-  | ReplyCap ref gr \<Rightarrow> True
   | ThreadCap ref \<Rightarrow> True
-  | SchedContextCap ref sz \<Rightarrow> True
   | CNodeCap ref bits gd gs \<Rightarrow> True
   | Zombie ptr zb n \<Rightarrow> True
   | IRQHandlerCap irq \<Rightarrow> True
@@ -1957,7 +2019,7 @@ lemma (in vmdb) isFinal_untypedParent:
                    sameObjectAs_sym)
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma no_fail_isFinalCapability [wp]:
   "no_fail (valid_mdb' and cte_wp_at' ((=) cte) p) (isFinalCapability cte)"
@@ -2011,13 +2073,6 @@ lemma obj_refs_Master:
   by (clarsimp simp: isCap_simps
               split: cap_relation_split_asm arch_cap.split_asm)
 
-(* FIXME RT: this should maybe replace is_sc_obj_def in is_obj_defs *)
-lemma is_sc_obj_def':
-  "is_sc_obj n ko = (\<exists>sc. ko = kernel_object.SchedContext sc n \<and> valid_sched_context_size n)"
-  unfolding is_sc_obj_def
-  apply (case_tac ko; simp)
-  by fastforce
-
 lemma isFinalCapability_corres':
   "final_matters' (cteCap cte) \<Longrightarrow>
    corres (=) (invs and cte_wp_at ((=) cap) ptr)
@@ -2094,12 +2149,11 @@ lemma isFinalCapability_corres':
    apply (rule classical)
    apply (frule(1) zombies_finalD2[OF _ _ _ invs_zombies],
           simp?, clarsimp, assumption+)
-    apply (clarsimp simp: sameObjectAs_def3 isCap_simps valid_cap_def is_sc_obj_def'
-                          obj_at_def is_obj_defs a_type_def final_matters'_def
-                simp del: is_sc_obj_def
-                   split: cap.split_asm arch_cap.split_asm
-                          option.split_asm if_split_asm,
-           simp_all add: is_cap_defs)
+   subgoal by (clarsimp simp: sameObjectAs_def3 isCap_simps valid_cap_def
+                         obj_at_def is_obj_defs a_type_def final_matters'_def
+                  split: cap.split_asm arch_cap.split_asm
+                         option.split_asm if_split_asm,
+          simp_all add: is_cap_defs)
   apply (rule classical)
   by (clarsimp simp: cap_irqs_def cap_irq_opt_def sameObjectAs_def3 isCap_simps arch_gen_obj_refs_def
                  split: cap.split_asm)
@@ -2129,6 +2183,11 @@ definition
   finaliseCapTrue_standin_simple_def:
   "finaliseCapTrue_standin cap fin \<equiv> finaliseCap cap fin True"
 
+context
+begin
+
+declare if_cong [cong]
+
 lemmas finaliseCapTrue_standin_def
     = finaliseCapTrue_standin_simple_def
         [unfolded finaliseCap_def, simplified]
@@ -2140,16 +2199,14 @@ lemmas cteDeleteOne_def
 
 crunch cteDeleteOne, suspend, prepareThreadDelete
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: crunch_wps  hoare_vcg_if_lift2 hoare_vcg_all_lift
+  (wp: crunch_wps getObject_inv loadObject_default_inv
    simp: crunch_simps unless_def o_def)
 
 end
 
-global_interpretation cancelIPC: typ_at_all_props' "cancelIPC x" by typ_at_props'
-global_interpretation cancelAllIPC: typ_at_all_props' "cancelAllIPC x" by typ_at_props'
-global_interpretation cancelAllSignals: typ_at_all_props' "cancelAllSignals x" by typ_at_props'
-global_interpretation suspend: typ_at_all_props' "suspend x" by typ_at_props'
+lemmas cancelAllIPC_typs[wp] = typ_at_lifts [OF cancelAllIPC_typ_at']
+lemmas cancelAllSignals_typs[wp] = typ_at_lifts [OF cancelAllSignals_typ_at']
+lemmas suspend_typs[wp] = typ_at_lifts [OF suspend_typ_at']
 
 definition
   arch_cap_has_cleanup' :: "arch_capability \<Rightarrow> bool"
@@ -2187,24 +2244,32 @@ lemma finaliseCap_cases[wp]:
   apply (auto simp add: isCap_simps cap_has_cleanup'_def)
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 crunch finaliseCap
   for aligned'[wp]: "pspace_aligned'"
-  and distinct'[wp]:"pspace_distinct'"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and it'[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  (wp: crunch_wps setObject_asidpool.getObject_inv hoare_vcg_all_lift simp: crunch_simps)
+  (simp: crunch_simps assertE_def unless_def o_def
+     wp: getObject_inv loadObject_default_inv crunch_wps)
 
-end
+crunch finaliseCap
+  for distinct'[wp]: "pspace_distinct'"
+  (simp: crunch_simps assertE_def unless_def o_def
+     wp: getObject_inv loadObject_default_inv crunch_wps)
+
+crunch finaliseCap
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (simp: crunch_simps assertE_def
+     wp: getObject_inv loadObject_default_inv crunch_wps)
+lemmas finaliseCap_typ_ats[wp] = typ_at_lifts[OF finaliseCap_typ_at']
+
+crunch finaliseCap
+  for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (wp: mapM_x_wp_inv mapM_wp' hoare_drop_imps getObject_inv loadObject_default_inv
+   simp: crunch_simps o_def)
 
-global_interpretation unbindFromSC: typ_at_all_props' "unbindFromSC t"
-  by typ_at_props'
+crunch flush_space
+  for vs_lookup[wp]: "\<lambda>s. P (vs_lookup s)"
+  (wp: crunch_wps)
 
-global_interpretation finaliseCap: typ_at_all_props' "finaliseCap cap final x"
-  by typ_at_props'
+declare doUnbindNotification_def[simp]
 
 lemma ntfn_q_refs_of'_mult:
   "ntfn_q_refs_of' ntfn = (case ntfn of Structures_H.WaitingNtfn q \<Rightarrow> set q | _ \<Rightarrow> {}) \<times> {NTFNSignal}"
@@ -2215,566 +2280,112 @@ lemma tcb_st_not_Bound:
   "(p, TCBBound) \<notin> tcb_st_refs_of' ts"
   by (auto simp: tcb_st_refs_of'_def split: Structures_H.thread_state.split)
 
-lemma get_refs_NTFNSchedContext_not_Bound:
-  "(tcb, NTFNBound) \<notin> get_refs NTFNSchedContext (ntfnSc ntfn)"
-  by (clarsimp simp: get_refs_def split: option.splits)
-
-lemma tcb_bound_refs'_not_Bound:
-  "(y, TCBBound) \<notin> tcb_bound_refs' None sc_ptr yieldto_ptr"
-  by (clarsimp simp: tcb_bound_refs'_def get_refs_def split: option.splits)
+crunch setBoundNotification
+  for valid_bitmaps[wp]: valid_bitmaps
+  and tcbSchedNexts_of[wp]: "\<lambda>s. P (tcbSchedNexts_of s)"
+  and tcbSchedPrevs_of[wp]: "\<lambda>s. P (tcbSchedPrevs_of s)"
+  and tcbQueued[wp]: "\<lambda>s. P (tcbQueued |< tcbs_of' s)"
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  (wp: valid_bitmaps_lift)
 
 lemma unbindNotification_invs[wp]:
-  "unbindNotification tcb \<lbrace>invs'\<rbrace>"
-  apply (simp add: unbindNotification_def invs'_def valid_dom_schedule'_def)
+  "\<lbrace>invs'\<rbrace> unbindNotification tcb \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: unbindNotification_def invs'_def valid_state'_def)
   apply (rule bind_wp[OF _ gbn_sp'])
   apply (case_tac ntfnPtr, clarsimp, wp, clarsimp)
   apply clarsimp
   apply (rule bind_wp[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-   apply (wp sbn'_valid_pspace'_inv sbn_sch_act' sbn_valid_queues valid_irq_node_lift
-             irqs_masked_lift setBoundNotification_ct_not_inQ
-             untyped_ranges_zero_lift | clarsimp simp: cteCaps_of_def o_def)+
+  apply (wp sbn'_valid_pspace'_inv sbn_sch_act' valid_irq_node_lift
+            irqs_masked_lift setBoundNotification_ct_not_inQ sym_heap_sched_pointers_lift
+            untyped_ranges_zero_lift | clarsimp simp: cteCaps_of_def o_def)+
   apply (rule conjI)
-   apply (frule obj_at_valid_objs', clarsimp+)
-   apply (simp add: valid_ntfn'_def valid_obj'_def projectKOs
-             split: ntfn.splits)
-  apply (rule conjI)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
+   apply (clarsimp elim!: obj_atE'
+                    simp: projectKOs
+                   dest!: pred_tcb_at')
   apply (clarsimp simp: pred_tcb_at' conj_comms)
+  apply (frule bound_tcb_ex_cap'', clarsimp+)
+  apply (frule(1) sym_refs_bound_tcb_atD')
+  apply (frule(1) sym_refs_obj_atD')
+  apply (clarsimp simp: refs_of_rev')
+  apply normalise_obj_at'
+  apply (subst delta_sym_refs, assumption)
+    apply (auto split: if_split_asm)[1]
+   apply (auto simp: tcb_st_not_Bound ntfn_q_refs_of'_mult split: if_split_asm)[1]
+  apply (frule obj_at_valid_objs', clarsimp+)
+  apply (simp add: valid_ntfn'_def valid_obj'_def projectKOs
+            split: ntfn.splits)
   apply (erule if_live_then_nonz_capE')
-  apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs live_ntfn'_def)
+  apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
   done
 
 lemma ntfn_bound_tcb_at':
-  "\<lbrakk>sym_refs (state_refs_of' s); ko_at' ntfn ntfnptr s;
+  "\<lbrakk>sym_refs (state_refs_of' s); valid_objs' s; ko_at' ntfn ntfnptr s;
     ntfnBoundTCB ntfn = Some tcbptr; P (Some ntfnptr)\<rbrakk>
   \<Longrightarrow> bound_tcb_at' P tcbptr s"
   apply (drule_tac x=ntfnptr in sym_refsD[rotated])
    apply (clarsimp simp: obj_at'_def projectKOs)
    apply (fastforce simp: state_refs_of'_def)
-  apply (auto simp: state_refs_of'_def pred_tcb_at'_def obj_at'_def
-                    refs_of_rev' projectKOs
+  apply (auto simp: pred_tcb_at'_def obj_at'_def valid_obj'_def valid_ntfn'_def
+                    state_refs_of'_def refs_of_rev' projectKOs
+          simp del: refs_of_simps
+             elim!: valid_objsE
              split: option.splits if_split_asm)
   done
 
+
 lemma unbindMaybeNotification_invs[wp]:
-  "unbindMaybeNotification ntfnptr \<lbrace>invs'\<rbrace>"
-  apply (simp add: unbindMaybeNotification_def invs'_def valid_dom_schedule'_def)
+  "\<lbrace>invs'\<rbrace> unbindMaybeNotification ntfnptr \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: unbindMaybeNotification_def invs'_def valid_state'_def)
   apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (wpsimp wp: sbn'_valid_pspace'_inv sbn_sch_act' sbn_valid_queues
-                    valid_irq_node_lift irqs_masked_lift setBoundNotification_ct_not_inQ
-                    untyped_ranges_zero_lift
-              simp: cteCaps_of_def)
-  by (auto simp: pred_tcb_at' valid_pspace'_def projectKOs valid_obj'_def
-                 valid_ntfn'_def ko_wp_at'_def live_ntfn'_def o_def
-          elim!: obj_atE' if_live_then_nonz_capE'
-          split: option.splits ntfn.splits)
-
-lemma setNotification_invs':
-  "\<lbrace>invs'
-    and (\<lambda>s. live_ntfn' ntfn \<longrightarrow> ex_nonz_cap_to' ntfnPtr s)
-    and valid_ntfn' ntfn\<rbrace>
-    setNotification ntfnPtr ntfn
-    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add:  invs'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: valid_pde_mappings_lift' untyped_ranges_zero_lift simp: cteCaps_of_def o_def)
-  done
-
-lemma schedContextUnbindNtfn_valid_objs'[wp]:
-  "schedContextUnbindNtfn scPtr \<lbrace>valid_objs'\<rbrace>"
-  unfolding schedContextUnbindNtfn_def
-  apply (wpsimp wp: getNotification_wp hoare_vcg_all_lift hoare_vcg_imp_lift')
-  apply normalise_obj_at'
-  apply (rename_tac ntfnPtr ntfn sc)
-  apply (frule_tac k=ntfn in ko_at_valid_objs'; clarsimp simp: projectKOs)
-  apply (frule_tac k=sc in ko_at_valid_objs'; clarsimp simp: projectKOs valid_obj'_def)
-  by (auto simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps'
-                 valid_ntfn'_def
-          split: ntfn.splits)
-
-lemma schedContextUnbindNtfn_invs'[wp]:
-  "schedContextUnbindNtfn scPtr \<lbrace>invs'\<rbrace>"
-  unfolding invs'_def valid_pspace'_def valid_dom_schedule'_def
-  apply wpsimp \<comment> \<open>this handles valid_objs' separately\<close>
-   unfolding schedContextUnbindNtfn_def
-   apply (wpsimp wp: getNotification_wp hoare_vcg_all_lift hoare_vcg_imp_lift'
-                     typ_at_lifts valid_ntfn_lift' valid_pde_mappings_lift')
-  by (auto simp: ko_wp_at'_def obj_at'_def projectKOs live_sc'_def live_ntfn'_def o_def
-          elim!: if_live_then_nonz_capE')
-
-crunch schedContextMaybeUnbindNtfn
-  for invs'[wp]: invs'
-  (simp: crunch_simps wp: crunch_wps ignore: setReply)
-
-lemma replyUnlink_invs'[wp]:
-  "\<lbrace>invs' and (\<lambda>s. replyTCBs_of s replyPtr = Some tcbPtr \<longrightarrow> \<not> is_reply_linked replyPtr s)\<rbrace>
-   replyUnlink replyPtr tcbPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def valid_dom_schedule'_def
-  by wpsimp
-
-crunch replyRemove
-  for sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  and if_unsafe_then_cap'[wp]: if_unsafe_then_cap'
-  and valid_global_refs'[wp]: valid_global_refs'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and valid_irq_node'[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
-  and valid_irq_handlers'[wp]: valid_irq_handlers'
-  and valid_irq_states'[wp]: valid_irq_states'
-  and valid_machine_state'[wp]: valid_machine_state'
-  and irqs_masked'[wp]: irqs_masked'
-  and valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and ct_not_inQ[wp]: ct_not_inQ
-  and ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and valid_pde_mappings'[wp]: valid_pde_mappings'
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and untyped_ranges_zero'[wp]: untyped_ranges_zero'
-  and cur_tcb'[wp]: cur_tcb'
-  and no_0_obj'[wp]: no_0_obj'
-  and valid_dom_schedule'[wp]: valid_dom_schedule'
-  and pspace_bounded'[wp]: pspace_bounded'
-  (simp: crunch_simps)
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-crunch replyRemove, handleFaultReply
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' ptr"
-  (wp: crunch_wps simp: crunch_simps)
-
-end
-
-global_interpretation replyRemove: typ_at_all_props' "replyRemove replyPtr tcbPtr"
-  by typ_at_props'
-
-lemma replyNext_update_valid_objs':
-  "\<lbrace>valid_objs' and
-      (\<lambda>s. ((\<forall>r. next_opt = Some (Next r) \<longrightarrow> reply_at' r s) \<and>
-            (\<forall>sc. next_opt = Some (Head sc) \<longrightarrow> sc_at' sc s)))\<rbrace>
-   updateReply replyPtr (replyNext_update (\<lambda>_. next_opt))
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  apply (case_tac next_opt
-         ; wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def)
-  by (case_tac a; clarsimp)
-
-lemma replyPop_valid_objs'[wp]:
-  "replyPop replyPtr tcbPtr \<lbrace>valid_objs'\<rbrace>"
-  unfolding replyPop_def
-  supply if_split[split del]
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: schedContextDonate_valid_objs' hoare_vcg_if_lift_strong threadGet_const)
-                  apply (clarsimp simp: obj_at'_def)
-                 apply (wpsimp wp: replyNext_update_valid_objs' hoare_drop_imp hoare_vcg_if_lift2)+
-                apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_if_lift2 )+
-  apply (simp add: isHead_to_head)
-  apply (drule_tac k=x in ko_at_valid_objs'; clarsimp simp: projectKOs valid_obj'_def
-                 valid_sched_context'_def valid_sched_context_size'_def objBits_def objBitsKO_def)
-  apply (drule_tac k=ko in ko_at_valid_objs'; clarsimp simp: projectKOs valid_obj'_def
-                 valid_sched_context'_def valid_sched_context_size'_def objBits_def objBitsKO_def)
-  apply (clarsimp simp: valid_reply'_def)
-  done
-
-lemma replyRemove_valid_objs'[wp]:
-  "replyRemove replyPtr tcbPtr \<lbrace>valid_objs'\<rbrace>"
-  apply (clarsimp simp: replyRemove_def)
-  apply (wpsimp wp: updateReply_valid_objs' hoare_vcg_all_lift hoare_drop_imps
-              simp: valid_reply'_def
-         | intro conjI impI)+
-  done
-
-lemma replyPop_valid_replies'[wp]:
-  "\<lbrace>\<lambda>s. valid_replies' s \<and> pspace_aligned' s \<and> pspace_distinct' s
-        \<and> sym_refs (list_refs_of_replies' s)\<rbrace>
-   replyPop replyPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  unfolding replyPop_def
-  supply if_split[split del]
-  apply (wpsimp wp: hoare_vcg_imp_lift)
-                 apply (wpsimp wp: updateReply_valid_replies'_bound hoare_vcg_imp_lift
-                                   hoare_vcg_all_lift hoare_vcg_ex_lift hoare_vcg_if_lift)+
-  apply (rename_tac prevReplyPtr)
-  apply (drule_tac rptr=prevReplyPtr in valid_replies'D)
-   apply (frule reply_sym_heap_Prev_Next)
-   apply (frule_tac p=replyPtr in sym_heapD1)
-    apply (fastforce simp: opt_map_def obj_at'_def projectKOs)
-   apply clarsimp
-  apply (fastforce simp: obj_at'_def projectKOs elim!: opt_mapE)
-  done
-
-lemma replyRemove_valid_replies'[wp]:
-  "\<lbrace>\<lambda>s. valid_replies' s \<and> pspace_aligned' s \<and> pspace_distinct' s
-        \<and> sym_refs (list_refs_of_replies' s)\<rbrace>
-   replyRemove replyPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  unfolding replyRemove_def
-  by (wpsimp wp: hoare_vcg_imp_lift')
-
-lemma replyPop_valid_mdb'[wp]:
-  "replyPop replyPtr tcbPtr \<lbrace>valid_mdb'\<rbrace>"
-  unfolding replyPop_def
-  apply (wpsimp wp: schedContextDonate_valid_mdb' hoare_vcg_if_lift_strong threadGet_const)
-  apply (clarsimp simp: obj_at'_def)
-  by (wpsimp wp: gts_wp')+
-
-lemma replyRemove_valid_mdb'[wp]:
-  "replyRemove replyPtr tcbPtr \<lbrace>valid_mdb'\<rbrace>"
-  unfolding replyRemove_def
-  by (wpsimp wp: gts_wp')+
-
-lemma replyPop_valid_pspace'[wp]:
-  "\<lbrace>\<lambda>s. valid_pspace' s \<and> sym_refs (list_refs_of_replies' s)\<rbrace>
-   replyPop replyPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
-  by (wpsimp simp: valid_pspace'_def)
-
-lemma replyRemove_valid_pspace'[wp]:
-  "\<lbrace>\<lambda>s. valid_pspace' s \<and> sym_refs (list_refs_of_replies' s)\<rbrace>
-   replyRemove replyPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
-  by (wpsimp simp: valid_pspace'_def)
-
-lemma replyPop_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_objs'\<rbrace> replyPop replyPtr tcbPtr \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  supply if_split[split del]
-  apply (clarsimp simp: replyPop_def)
-  apply (wpsimp wp: schedContextDonate_valid_queues hoare_vcg_if_lift2 hoare_vcg_conj_lift
-                    hoare_vcg_imp_lift' threadGet_const)
-                apply (wp updateReply_obj_at'_only_st_qd_ft)
-               apply (wpsimp wp: replyNext_update_valid_objs')
-              apply (wpsimp wp: hoare_vcg_imp_lift updateReply_obj_at'_only_st_qd_ft)
-             apply (wpsimp wp: replyNext_update_valid_objs')
-             apply (wpsimp wp: hoare_vcg_imp_lift updateReply_obj_at'_only_st_qd_ft)
-              apply (rule_tac Q=
-                    "\<lambda>_ s. valid_queues s \<and> valid_objs' s \<and>
-                           (\<forall>r. replyNext reply = Some (Next r) \<longrightarrow> reply_at' r s) \<and>
-                           (\<forall>sc. replyNext reply = Some (Head sc) \<longrightarrow> sc_at' sc s) \<and>
-                           (obj_at' ((\<lambda>rv. rv = None) \<circ> tcbSchedContext) tcbPtr s \<or> valid_queues s)"
-                    in hoare_post_imp)
-               apply (clarsimp split: if_split)
-              apply (wpsimp wp: set_sc'.set_no_update gts_wp' schedContextDonate_valid_pspace'
-                             hoare_vcg_imp_lift')+
-              apply (case_tac reply; clarsimp)
-              apply (wpfix add: reply.sel)
-              apply (wpsimp wp: hoare_vcg_disj_lift hoare_vcg_all_lift replyNext_update_valid_objs'
-                             updateReply_obj_at'_only_st_qd_ft)
-             apply (wpsimp wp: hoare_vcg_disj_lift hoare_vcg_imp_lift
-                               updateReply_obj_at'_only_st_qd_ft)
-            apply (wpsimp wp: hoare_vcg_disj_lift hoare_vcg_imp_lift hoare_vcg_all_lift
-                              hoare_vcg_if_lift2)
-           apply (wpsimp wp: hoare_vcg_imp_lift set_sc'.valid_queues)
-          apply (wpsimp wp: gts_wp')+
-  apply (simp add: isHead_to_head split: if_splits)
-  apply (drule_tac k=ko in ko_at_valid_objs'; clarsimp simp: projectKOs valid_obj'_def
-                 valid_sched_context'_def valid_sched_context_size'_def objBits_def objBitsKO_def)
-  apply (drule_tac k=koa in ko_at_valid_objs'; clarsimp simp: projectKOs valid_obj'_def
-                 valid_sched_context'_def valid_sched_context_size'_def objBits_def objBitsKO_def)
-  apply (clarsimp simp: valid_reply'_def)
-  done
-
-lemma replyRemove_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_objs'\<rbrace>
-   replyRemove replyPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (clarsimp simp: replyRemove_def)
-  apply (wpsimp wp: gts_wp')
-  done
-
-lemma replyPop_list_refs_of_replies'[wp]:
-  "\<lbrace>\<lambda>s. sym_refs (list_refs_of_replies' s) \<and> obj_at' (\<lambda>reply. replyNext reply \<noteq> None) replyPtr s\<rbrace>
-   replyPop replyPtr tcbPtr
-   \<lbrace>\<lambda>_ s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  unfolding replyPop_def
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply clarsimp
-  apply (rule bind_wp[OF _ get_reply_sp'])
-  apply (rule bind_wp_fwd_skip, solves \<open>wpsimp\<close>, simp?)+
-  apply (rule bind_wp)
-   apply (wpsimp wp: cleanReply_list_refs_of_replies')
-  apply (rule hoare_when_cases)
-   apply (clarsimp simp: obj_at'_def)
-  apply (rule bind_wp[OF _ assert_sp])
-  apply (rule bind_wp_fwd_skip, solves \<open>wpsimp simp: comp_def\<close>, simp?)+
-  apply (subst bind_assoc[symmetric])
-  apply (rule bind_wp)
-   apply (rule bind_wp_fwd_skip, solves \<open>wpsimp\<close>, simp?)
-   apply (wpsimp wp: hoare_when_cases)
-   apply (wp updateReply_list_refs_of_replies' hoare_vcg_all_lift hoare_drop_imp)
-   apply (clarsimp simp: isHead_def split: reply_next.splits)
-  apply (intro conjI impI)
-   apply clarsimp
-   apply (rename_tac prevReplyPtr prevReply)
-   apply (frule_tac reply=prevReply in ko_at'_replies_of')
-   apply (frule_tac rp=prevReplyPtr and rp'=replyPtr in sym_refs_replyNext_replyPrev_sym)
-   apply (clarsimp?,
-          erule delta_sym_refs
-          ; clarsimp simp: isHead_def obj_at'_def projectKOs list_refs_of_reply'_def
-                           list_refs_of_replies'_def opt_map_def get_refs_def
-                    split: if_splits option.splits)+
-  done
-
-\<comment> \<open>An almost exact duplicate of replyRemoveTCB_list_refs_of_replies'\<close>
-lemma replyRemove_list_refs_of_replies'[wp]:
-  "replyRemove replyPtr tcbPtr \<lbrace>\<lambda>s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  unfolding replyRemove_def decompose_list_refs_of_replies'
-  supply if_cong[cong]
-  apply (wpsimp wp: cleanReply_list_refs_of_replies' hoare_vcg_if_lift hoare_vcg_imp_lift' gts_wp'
-                    haskell_assert_wp
-                    replyPop_list_refs_of_replies'[simplified decompose_list_refs_of_replies']
-              simp: pred_tcb_at'_def
-         split_del: if_split)
-  unfolding decompose_list_refs_of_replies'[symmetric] protected_sym_refs_def[symmetric]
-  \<comment>\<open> opt_mapE will sometimes destroy the @{term "(|>)"} inside @{term replyNexts_of}
-      and @{term replyPrevs_of}, but we're using those as our local normal form. \<close>
-  supply opt_mapE[rule del]
-  apply (intro conjI impI allI)
-       \<comment>\<open> Our 6 cases correspond to various cases of @{term replyNext} and @{term replyPrev}.
-           We use @{thm ks_reply_at'_repliesD} to turn those cases into facts about
-           @{term replyNexts_of} and @{term replyPrevs_of}. \<close>
-      apply (all \<open>normalise_obj_at'\<close>)
-     apply (all \<open>drule(1) ks_reply_at'_repliesD[OF ko_at'_replies_of',
-                                                   folded protected_sym_refs_def]
-                 , clarsimp simp: projectKO_reply isHead_to_head\<close>)
-     \<comment>\<open> Now, for each case we can blow open @{term sym_refs}, which will give us enough new
-           @{term "(replyNexts_of, replyPrevs_of)"} facts that we can throw it all at metis. \<close>
-     apply (clarsimp simp: sym_refs_def split_paired_Ball in_get_refs
-            , intro conjI impI allI
-            ; metis sym_refs_replyNext_replyPrev_sym[folded protected_sym_refs_def] option.sel
-                    option.inject)+
-  done
-
-lemma live'_HeadScPtr:
-  "\<lbrakk>replyNext reply = Some reply_next; sym_refs (state_refs_of' s); ko_at' reply replyPtr s;
-    isHead (Some reply_next); ko_at' sc (theHeadScPtr (Some reply_next)) s;
-    valid_bound_ntfn' (scNtfn sc) s\<rbrakk>
-   \<Longrightarrow> ko_wp_at' live' (theHeadScPtr (Some reply_next)) s"
-  apply (clarsimp simp: theHeadScPtr_def getHeadScPtr_def isHead_def
-                 split: reply_next.splits)
-  apply (rename_tac head)
-  apply (prop_tac "(head, ReplySchedContext) \<in> state_refs_of' s replyPtr")
-   apply (clarsimp simp: state_refs_of'_def get_refs_def2 obj_at'_def projectKOs)
-  apply (prop_tac "(replyPtr, SCReply) \<in> state_refs_of' s head")
-   apply (fastforce simp: sym_refs_def)
-  apply (clarsimp simp: state_refs_of'_def get_refs_def2 obj_at'_def projectKOs ko_wp_at'_def
-                        live_sc'_def)
-  done
-
-lemma replyPop_iflive:
-  "\<lbrace>(if_live_then_nonz_cap' and valid_objs' and ex_nonz_cap_to' tcbPtr)
-    and (\<lambda>s. sym_refs (list_refs_of_replies' s))\<rbrace>
-   replyPop replyPtr tcbPtr
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  (is "valid (?pred and _) _ ?post")
-  apply (clarsimp simp: replyPop_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (intro bind_wp[OF _ get_reply_sp']
-               bind_wp[OF _ assert_sp]
-               bind_wp[OF _ assert_opt_sp]
-               bind_wp[OF _ gts_sp'])
-  apply (rule_tac Q'="?post"  in bind_wp; (solves wpsimp)?)
-  apply clarsimp
-  apply (rename_tac reply tptr state)
-  apply (rule hoare_when_cases, simp)
-  apply (intro bind_wp[OF _ get_sc_sp']
-               bind_wp[OF _ assert_sp]
-               bind_wp[OF _ assert_opt_sp])
-
-  apply (rule_tac Q'="\<lambda>_ s. ?pred s \<and> sym_refs (list_refs_of_replies' s) \<and> ko_at' reply replyPtr s
-                           \<and> isHead (replyNext reply)
-                           \<and> ex_nonz_cap_to' (theHeadScPtr (replyNext reply)) s"
-               in bind_wp_fwd)
-   apply (wpsimp wp: setSchedContext_iflive' schedContextDonate_if_live_then_nonz_cap')
-   apply (frule (1) sc_ko_at_valid_objs_valid_sc')
-   apply (frule (1) reply_ko_at_valid_objs_valid_reply')
-   apply (clarsimp simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps
-                         comp_def valid_reply'_def getReplyNextPtr_def sym_refs_asrt_def)
-   apply (fastforce elim: if_live_then_nonz_capE'
-                   intro: live'_HeadScPtr)
-
-  apply clarsimp
-  apply (rename_tac reply_next)
-  apply (subst bind_assoc[symmetric])
-  apply (rule_tac Q'="\<lambda>_ s. ?pred s \<and> ex_nonz_cap_to' (theHeadScPtr (Some reply_next)) s"
-               in bind_wp_fwd)
-
-   apply (clarsimp simp: when_def)
-   apply (intro conjI impI)
-    apply clarsimp
-    apply (rename_tac replyPrevPtr)
-    apply (intro hoare_vcg_conj_lift_pre_fix; (solves wpsimp)?)
-     apply (rule_tac Q'="\<lambda>_ s. ?pred s \<and> ex_nonz_cap_to' replyPtr s" in bind_wp_fwd)
-      apply (wpsimp wp: updateReply_iflive'_strong updateReply_valid_objs')
-      apply (frule (1) reply_ko_at_valid_objs_valid_reply')
-      apply (clarsimp simp: valid_reply'_def getReplyNextPtr_def)
-      apply (rule conjI)
-       apply (clarsimp simp: live_reply'_def valid_reply'_def isHead_def
-                      split: reply_next.splits)
-       apply (erule if_live_then_nonz_capE')
-       apply (prop_tac "(replyPrevPtr, ReplyPrev) \<in> list_refs_of_replies' s replyPtr")
-        apply (clarsimp simp: list_refs_of_replies'_def get_refs_def2 obj_at'_def projectKOs
-                              comp_def opt_map_def list_refs_of_reply'_def)
-       apply (prop_tac "(replyPtr, ReplyNext) \<in> list_refs_of_replies' s replyPrevPtr")
-        apply (fastforce simp: sym_refs_def)
-       apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKOs list_refs_of_replies'_def
-                             opt_map_def list_refs_of_reply'_def)
-      apply (fastforce elim: if_live_then_nonz_capE'
-                       simp: ko_wp_at'_def obj_at'_def projectKOs live_reply'_def)
-     apply (clarsimp simp: obj_at'_def)
-     apply (wpsimp wp: updateReply_iflive'_strong updateReply_valid_objs')
-    apply (rule_tac Q'="\<lambda>_. valid_objs'" in bind_wp_fwd)
-     apply (wpsimp wp: updateReply_valid_objs' hoare_vcg_all_lift)
-     apply (fastforce dest: reply_ko_at_valid_objs_valid_reply'
-                      simp: valid_reply'_def getReplyNextPtr_def valid_bound_obj'_def)
-   apply (wpsimp wp: updateReply_valid_objs' hoare_vcg_all_lift)
-   apply (clarsimp simp: valid_reply'_def getReplyNextPtr_def valid_bound_obj'_def)
-
-   apply (wpsimp wp: updateReply_iflive'_strong updateReply_valid_objs')
-   apply (fastforce elim: if_live_then_nonz_capE'
-                    simp: valid_reply'_def ko_wp_at'_def obj_at'_def projectKOs live_reply'_def)
-
-  apply (rule bind_wp[OF _ threadGet_sp])
-  apply (wpsimp wp: schedContextDonate_if_live_then_nonz_cap')
-  done
-
-lemma replyRemove_if_live_then_nonz_cap':
-  "\<lbrace>if_live_then_nonz_cap' and valid_objs' and ex_nonz_cap_to' tcbPtr
-    and (\<lambda>s. sym_refs (list_refs_of_replies' s))\<rbrace>
-   replyRemove replyPtr tcbPtr
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: replyRemove_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (intro bind_wp[OF _ get_reply_sp']
-               bind_wp[OF _ assert_sp]
-               bind_wp[OF _ assert_opt_sp]
-               bind_wp[OF _ gts_sp'])
-  apply (rule hoare_if)
-   apply (wpsimp wp: replyPop_iflive)
-  apply (clarsimp simp: when_def)
-  apply (intro conjI impI; (solves wpsimp)?)
-    apply (clarsimp simp: theReplyNextPtr_def)
-    apply (rename_tac prev_reply next_reply)
-    apply (wpsimp wp: updateReply_iflive'_strong hoare_drop_imps)
-    apply (frule_tac rp'=replyPtr and rp=prev_reply in sym_refs_replyNext_replyPrev_sym)
-    apply (frule (1) reply_ko_at_valid_objs_valid_reply')
-    apply (fastforce elim: if_live_then_nonz_capE'
-                     simp: valid_reply'_def ko_wp_at'_def obj_at'_def projectKOs live_reply'_def
-                           opt_map_def)
-   apply (wpsimp wp: updateReply_iflive'_strong)
-   apply (fastforce simp: live_reply'_def)
-  apply (wpsimp wp: updateReply_iflive'_strong)
-  apply (fastforce simp: live_reply'_def)
-  done
-
-lemma replyPop_valid_idle':
-  "\<lbrace>\<lambda>s. valid_idle' s
-        \<and> tcbPtr \<noteq> ksIdleThread s
-        \<and> (\<forall>scPtr. obj_at' (\<lambda>r. replyNext r = Some (Head scPtr)) replyPtr s
-                    \<longrightarrow> obj_at' (\<lambda>sc. scTCB sc \<noteq> Some idle_thread_ptr) scPtr s)\<rbrace>
-   replyPop replyPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  apply (clarsimp simp: replyPop_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (intro bind_wp[OF _ get_reply_sp']
-               bind_wp[OF _ assert_sp]
-               bind_wp[OF _ assert_opt_sp]
-               bind_wp[OF _ gts_sp'])
-  apply (rule_tac Q'="\<lambda>_. valid_idle' and (\<lambda>s. tcbPtr \<noteq> ksIdleThread s)" in bind_wp)
-   apply wpsimp
-  apply (rule hoare_when_cases, simp)
-  apply clarsimp
-  apply (rename_tac reply_next)
-  apply (rule bind_wp[OF _ assert_sp])
-  apply (rule bind_wp[OF _ get_sc_sp'])
-  apply (rule_tac Q'="\<lambda>_ s. valid_idle' s \<and> tcbPtr \<noteq> idle_thread_ptr
-                           \<and> obj_at' (\<lambda>sc. scTCB sc \<noteq> Some idle_thread_ptr)
-                                      (theHeadScPtr (Some reply_next)) s"
-               in bind_wp)
-   apply (wpsimp wp: schedContextDonate_valid_idle' hoare_vcg_if_lift2 hoare_vcg_imp_lift'
-                     threadGet_const updateReply_obj_at'_only_st_qd_ft)
-   apply (clarsimp simp: valid_idle'_def)
-  apply (wpsimp wp: setSchedContext_valid_idle'
-         | wpsimp wp: set_sc'.set_wp)+
-  apply (auto simp: valid_idle'_def obj_at'_def projectKOs isHead_def objBits_simps ps_clear_def
-             split: reply_next.splits)
-  done
-
-lemma replyRemove_valid_idle'[wp]:
-  "\<lbrace>\<lambda>s. valid_idle' s \<and> tcbPtr \<noteq> ksIdleThread s \<and> valid_objs' s\<rbrace>
-   replyRemove replyPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  apply (clarsimp simp: replyRemove_def)
-  apply (wpsimp wp: replyPop_valid_idle' gts_wp')
-  apply (rename_tac reply scPtr reply_next)
-  apply (clarsimp simp: sym_refs_asrt_def)
-  apply (rule ccontr)
-  apply (prop_tac "obj_at' (\<lambda>sc. scTCB sc = Some idle_thread_ptr) scPtr s")
-   apply (prop_tac "sc_at' scPtr s")
-    apply (frule (1) reply_ko_at_valid_objs_valid_reply')
-    apply (fastforce simp: obj_at'_def  valid_reply'_def)
-   apply (fastforce simp: obj_at'_def)
-  apply (prop_tac "replySCs_of s replyPtr = Some scPtr")
-   apply (clarsimp simp: opt_map_def obj_at'_def projectKOs)
-  apply (prop_tac "(idle_thread_ptr, SCTcb) \<in> state_refs_of' s scPtr")
-   apply (clarsimp simp: state_refs_of'_def get_refs_def2 obj_at'_def projectKOs)
-  apply (prop_tac "scPtr = idle_sc_ptr")
-   apply (frule idle'_only_sc_refs)
-   apply (fastforce dest: sym_refsD
-                    simp: valid_idle'_def)
-  apply (prop_tac "(scPtr, ReplySchedContext) \<in> state_refs_of' s replyPtr")
-   apply (clarsimp simp: state_refs_of'_def obj_at'_def projectKOs)
-  apply (prop_tac "(replyPtr, SCReply) \<in> state_refs_of' s scPtr")
-   apply (fastforce simp: sym_refs_def)
-  apply (auto simp: valid_idle'_def obj_at'_def projectKOs state_refs_of'_def)
-  done
-
-lemma replyPop_invs':
-  "\<lbrace>invs' and obj_at' (\<lambda>reply. replyNext reply \<noteq> None) replyPtr
-          and ex_nonz_cap_to' tcbPtr\<rbrace>
-   replyPop replyPtr tcbPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def
-  apply (wpsimp wp: replyPop_iflive simp: valid_pspace'_def)
-  done
-
-lemma replyRemove_invs':
-  "\<lbrace>invs' and ex_nonz_cap_to' tcbPtr\<rbrace>
-   replyRemove replyPtr tcbPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def
-  apply (wpsimp wp: replyRemove_if_live_then_nonz_cap' replyRemove_valid_idle')
-  done
-
-lemma replyClear_invs'[wp]:
-  "replyClear replyPtr tcbPtr \<lbrace>invs'\<rbrace>"
-  unfolding replyClear_def
-  apply (wpsimp wp: replyRemove_invs' gts_wp')
-  apply (rule if_live_then_nonz_capE')
-   apply fastforce
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def ko_wp_at'_def projectKOs)
+  apply (rule hoare_pre)
+   apply (wp sbn'_valid_pspace'_inv sbn_sch_act' sym_heap_sched_pointers_lift valid_irq_node_lift
+             irqs_masked_lift setBoundNotification_ct_not_inQ
+             untyped_ranges_zero_lift
+             | wpc | clarsimp simp: cteCaps_of_def o_def)+
+  apply safe[1]
+           defer 3
+           defer 7
+           apply (fold_subgoals (prefix))[8]
+           subgoal premises prems using prems by (auto simp: pred_tcb_at' valid_pspace'_def projectKOs valid_obj'_def valid_ntfn'_def
+                             ko_wp_at'_def
+                      elim!: obj_atE' valid_objsE' if_live_then_nonz_capE'
+                      split: option.splits ntfn.splits)
+   apply (rule delta_sym_refs, assumption)
+    apply (fold_subgoals (prefix))[2]
+    subgoal premises prems using prems by (fastforce simp: symreftype_inverse' ntfn_q_refs_of'_def
+                    split: ntfn.splits if_split_asm
+                     dest!: ko_at_state_refs_ofD')+
+  apply (rule delta_sym_refs, assumption)
+   apply (clarsimp split: if_split_asm)
+   apply (frule ko_at_state_refs_ofD', simp)
+  apply (clarsimp split: if_split_asm)
+   apply (frule_tac P="(=) (Some ntfnptr)" in ntfn_bound_tcb_at', simp_all add: valid_pspace'_def)[1]
+   subgoal by (fastforce simp: ntfn_q_refs_of'_def state_refs_of'_def tcb_ntfn_is_bound'_def
+                          tcb_st_refs_of'_def
+                   dest!: bound_tcb_at_state_refs_ofD'
+                   split: ntfn.splits thread_state.splits)
+  apply (frule ko_at_state_refs_ofD', simp)
   done
 
 (* Ugh, required to be able to split out the abstract invs *)
-lemma finaliseCap_True_invs'[wp]:
-  "finaliseCap cap final True \<lbrace>invs'\<rbrace>"
-  unfolding finaliseCap_def sym_refs_asrt_def
-  apply (wpsimp wp: irqs_masked_lift simp: Let_def split_del: if_split)
-  apply clarsimp
+lemma finaliseCap_True_invs[wp]:
+  "\<lbrace>invs'\<rbrace> finaliseCap cap final True \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: finaliseCap_def Let_def)
+  apply safe
+    apply (wp irqs_masked_lift| simp | wpc)+
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 crunch flushSpace
- for invs'[wp]: "invs'" (ignore: doMachineOp)
+  for invs'[wp]: "invs'" (ignore: doMachineOp)
 
 lemma invs_asid_update_strg':
   "invs' s \<and> tab = armKSASIDTable (ksArchState s) \<longrightarrow>
    invs' (s\<lparr>ksArchState := armKSASIDTable_update
             (\<lambda>_. tab (asid := None)) (ksArchState s)\<rparr>)"
   apply (simp add: invs'_def)
-  apply (simp add: valid_global_refs'_def global_refs'_def valid_arch_state'_def
-                   valid_asid_table'_def valid_machine_state'_def ct_idle_or_in_cur_domain'_def
-                   tcb_in_cur_domain'_def valid_dom_schedule'_def)
+  apply (simp add: valid_state'_def)
+  apply (simp add: valid_global_refs'_def global_refs'_def valid_arch_state'_def valid_asid_table'_def valid_machine_state'_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
   apply (auto simp add: ran_def split: if_split_asm)
   done
 
@@ -2785,7 +2396,7 @@ lemma invalidateASIDEntry_invs' [wp]:
   apply (wp loadHWASID_wp | simp)+
   apply (clarsimp simp: fun_upd_def[symmetric])
   apply (rule conjI)
-   apply (clarsimp simp: invs'_def valid_dom_schedule'_def)
+   apply (clarsimp simp: invs'_def valid_state'_def)
    apply (rule conjI)
     apply (simp add: valid_global_refs'_def
                      global_refs'_def)
@@ -2797,12 +2408,13 @@ lemma invalidateASIDEntry_invs' [wp]:
                     valid_asid_map'_def
                     ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
    subgoal by (auto elim!: subset_inj_on)
-  apply (clarsimp simp: invs'_def valid_dom_schedule'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def)
   apply (rule conjI)
    apply (simp add: valid_global_refs'_def
                     global_refs'_def)
   apply (rule conjI)
-   apply (simp add: valid_arch_state'_def ran_def valid_asid_table'_def
+   apply (simp add: valid_arch_state'_def ran_def
+                    valid_asid_table'_def None_upd_eq
                     fun_upd_def[symmetric] comp_upd_simp)
   apply (simp add: valid_machine_state'_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
   done
@@ -2811,8 +2423,10 @@ lemma deleteASIDPool_invs[wp]:
   "\<lbrace>invs'\<rbrace> deleteASIDPool asid pool \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: deleteASIDPool_def)
   apply wp
-      apply (strengthen invs_asid_update_strg')
-      apply (wpsimp wp: mapM_wp' getObject_inv)+
+    apply (simp del: fun_upd_apply)
+    apply (strengthen invs_asid_update_strg')
+  apply (wp mapM_wp' getObject_inv loadObject_default_inv
+              | simp)+
   done
 
 lemma invalidateASIDEntry_valid_ap' [wp]:
@@ -2824,12 +2438,7 @@ lemma invalidateASIDEntry_valid_ap' [wp]:
   apply (clarsimp simp del: fun_upd_apply)
   done
 
-end
-
-sublocale Arch < flushSpace: typ_at_all_props' "flushSpace asid"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas flushSpace_typ_ats' [wp] = typ_at_lifts [OF flushSpace_typ_at']
 
 lemma deleteASID_invs'[wp]:
   "\<lbrace>invs'\<rbrace> deleteASID asid pd \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -2848,8 +2457,9 @@ lemma deleteASID_invs'[wp]:
       apply (drule subsetD, blast)
       apply clarsimp
      apply (auto dest!: ran_del_subset)[1]
-    apply (wpsimp wp: getObject_valid_obj getObject_inv
-                simp: objBits_simps archObjSize_def pageBits_def)+
+    apply (wp getObject_valid_obj getObject_inv loadObject_default_inv
+             | simp add: objBits_simps archObjSize_def pageBits_def)+
+  apply clarsimp
   done
 
 lemma arch_finaliseCap_invs[wp]:
@@ -2887,9 +2497,11 @@ lemma prepares_delete_helper'':
   apply (clarsimp simp: removeable'_def)
   done
 
+lemmas ctes_of_cteCaps_of_lift = cteCaps_of_ctes_of_lift
+
 crunch finaliseCapTrue_standin, unbindNotification
   for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  (wp: crunch_wps getObject_inv simp: crunch_simps)
+  (wp: crunch_wps getObject_inv loadObject_default_inv simp: crunch_simps)
 
 lemma cteDeleteOne_cteCaps_of:
   "\<lbrace>\<lambda>s. (cte_wp_at' (\<lambda>cte. \<exists>final. finaliseCap (cteCap cte) final True \<noteq> fail) p s \<longrightarrow>
@@ -2921,26 +2533,15 @@ lemma cteDeleteOne_isFinal:
   apply (clarsimp simp: isFinal_def sameObjectAs_def2)
   done
 
-lemmas setEndpoint_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_ep'.ctes_of]
-lemmas setNotification_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_ntfn'.ctes_of]
-lemmas setSchedContext_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_sc'.ctes_of]
-lemmas setReply_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_reply'.ctes_of]
-lemmas setQueue_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF setQueue_ctes_of]
-lemmas sts_cteCaps_of[wp] = ctes_of_cteCaps_of_lift[OF sts_ctes_of]
-
-crunch replyRemoveTCB
-  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  (simp: crunch_simps st_tcb_at'_def wp: crunch_wps)
-
-lemmas replyRemoveTCB_cteCaps_of[wp] = ctes_of_cteCaps_of_lift[OF replyRemoveTCB_ctes_of]
+lemmas setEndpoint_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_ep_ctes_of]
+lemmas setNotification_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_ntfn_ctes_of]
+lemmas threadSet_cteCaps_of = ctes_of_cteCaps_of_lift [OF threadSet_ctes_of]
 
-crunch
-  suspend, prepareThreadDelete, schedContextUnbindTCB, schedContextCompleteYieldTo,
-  unbindFromSC
-  for isFinal[wp]: "\<lambda>s. isFinal cap slot (cteCaps_of s)"
+crunch suspend, prepareThreadDelete
+  for isFinal: "\<lambda>s. isFinal cap slot (cteCaps_of s)"
   (ignore: threadSet
        wp: threadSet_cteCaps_of crunch_wps
-     simp: crunch_simps)
+     simp: crunch_simps unless_def o_def)
 
 lemma isThreadCap_threadCapRefs_tcbptr:
   "isThreadCap cap \<Longrightarrow> threadCapRefs cap = {capTCBPtr cap}"
@@ -2957,6 +2558,12 @@ lemma cteDeleteOne_deletes[wp]:
   apply clarsimp
   done
 
+crunch finaliseCap
+  for irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+  (wp: mapM_x_wp crunch_wps getObject_inv loadObject_default_inv
+       updateObject_default_inv setObject_ksInterrupt
+   simp: crunch_simps unless_def o_def)
+
 lemma deletingIRQHandler_removeable':
   "\<lbrace>invs' and (\<lambda>s. isFinal (IRQHandlerCap irq) slot (cteCaps_of s))
           and K (cap = IRQHandlerCap irq)\<rbrace>
@@ -2979,10 +2586,16 @@ lemma finaliseCap_cte_refs:
   apply (simp  add: finaliseCap_def Let_def getThreadCSpaceRoot
                     ARM_H.finaliseCap_def
              cong: if_cong split del: if_split)
-   apply wpsimp
+  apply (rule hoare_pre)
+   apply (wp | wpc | simp only: o_def)+
   apply (frule valid_capAligned)
   apply (cases cap, simp_all add: isCap_simps)
-  by (auto simp: capAligned_def objBits_simps shiftL_nat cte_refs'_def tcb_cte_cases_def word_count_from_top objBits_defs)
+   apply (clarsimp simp: tcb_cte_cases_def word_count_from_top objBits_defs)
+  apply clarsimp
+  apply (rule ext, simp)
+  apply (rule image_cong [OF _ refl])
+  apply (fastforce simp: capAligned_def objBits_simps shiftL_nat)
+  done
 
 lemma deletingIRQHandler_final:
   "\<lbrace>\<lambda>s. isFinal cap slot (cteCaps_of s)
@@ -3007,13 +2620,16 @@ lemma unbindNotification_valid_objs'_helper':
   by (clarsimp simp: valid_bound_tcb'_def valid_ntfn'_def
                   split: option.splits ntfn.splits)
 
+lemmas setNotification_valid_tcb' = typ_at'_valid_tcb'_lift [OF setNotification_typ_at']
+
 lemma unbindNotification_valid_objs'[wp]:
   "\<lbrace>valid_objs'\<rbrace>
      unbindNotification t
    \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (simp add: unbindNotification_def)
   apply (rule hoare_pre)
-  apply (wp threadSet_valid_objs' gbn_wp' set_ntfn_valid_objs' hoare_vcg_all_lift getNotification_wp
+  apply (wp threadSet_valid_objs' gbn_wp' set_ntfn_valid_objs' hoare_vcg_all_lift
+            setNotification_valid_tcb' getNotification_wp
         | wpc | clarsimp simp: setBoundNotification_def unbindNotification_valid_objs'_helper)+
   apply (clarsimp elim!: obj_atE' simp: projectKOs)
   apply (rule valid_objsE', assumption+)
@@ -3027,7 +2643,8 @@ lemma unbindMaybeNotification_valid_objs'[wp]:
   apply (simp add: unbindMaybeNotification_def)
   apply (rule bind_wp[OF _ get_ntfn_sp'])
   apply (rule hoare_pre)
-  apply (wp threadSet_valid_objs' gbn_wp' set_ntfn_valid_objs' hoare_vcg_all_lift getNotification_wp
+  apply (wp threadSet_valid_objs' gbn_wp' set_ntfn_valid_objs' hoare_vcg_all_lift
+            setNotification_valid_tcb' getNotification_wp
         | wpc | clarsimp simp: setBoundNotification_def unbindNotification_valid_objs'_helper)+
   apply (clarsimp elim!: obj_atE' simp: projectKOs)
   apply (rule valid_objsE', assumption+)
@@ -3048,9 +2665,9 @@ lemma valid_cong:
     \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> = \<lbrace>P'\<rbrace> f' \<lbrace>Q'\<rbrace>"
   by (clarsimp simp add: valid_def, blast)
 
-lemma unbindMaybeNotification_obj_at'_ntfnBound:
+lemma unbindMaybeNotification_obj_at'_bound:
   "\<lbrace>\<top>\<rbrace>
-   unbindMaybeNotification r
+     unbindMaybeNotification r
    \<lbrace>\<lambda>_ s. obj_at' (\<lambda>ntfn. ntfnBoundTCB ntfn = None) r s\<rbrace>"
   apply (simp add: unbindMaybeNotification_def)
   apply (rule bind_wp[OF _ get_ntfn_sp'])
@@ -3063,187 +2680,61 @@ lemma unbindMaybeNotification_obj_at'_ntfnBound:
   apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
   done
 
-lemma unbindMaybeNotification_obj_at'_no_change:
-  "\<forall>ntfn tcb. P ntfn = P (ntfn \<lparr>ntfnBoundTCB := tcb\<rparr>)
-   \<Longrightarrow> unbindMaybeNotification r \<lbrace>obj_at' P r'\<rbrace>"
-  apply (simp add: unbindMaybeNotification_def)
-  apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (rule hoare_pre)
-   apply (wp obj_at_setObject2
-        | wpc
-        | simp add: setBoundNotification_def threadSet_def updateObject_default_def in_monad projectKOs)+
-  apply (simp add: setNotification_def obj_at'_real_def cong: valid_cong)
-   apply (wp setObject_ko_wp_at, (simp add: objBits_simps')+)
-  apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
-  done
-
 context
 notes option.case_cong_weak[cong]
 begin
 crunch unbindNotification, unbindMaybeNotification
   for isFinal[wp]: "\<lambda>s. isFinal cap slot (cteCaps_of s)"
-  (wp: threadSet_cteCaps_of crunch_wps ignore: threadSet)
+  (wp: sts_bound_tcb_at' threadSet_cteCaps_of crunch_wps getObject_inv loadObject_default_inv
+   ignore: threadSet)
+end
 
 crunch cancelSignal, cancelAllIPC
   for bound_tcb_at'[wp]: "bound_tcb_at' P t"
-  and bound_sc_tcb_at'[wp]: "bound_sc_tcb_at' P t"
-  (wp: crunch_wps)
-
-lemma setSchedContext_pde_mappings'[wp]:
-  "setSchedContext p sc \<lbrace>valid_pde_mappings'\<rbrace>"
-  by (wp valid_pde_mappings_lift')
-
-lemma schedContextUnbindTCB_invs'_helper:
-  "\<lbrace>\<lambda>s. invs' s \<and> valid_idle' s \<and> cur_tcb' s \<and> scPtr \<noteq> idle_sc_ptr
-                \<and> ko_at' sc scPtr s
-                \<and> scTCB sc = Some tcbPtr
-                \<and> bound_sc_tcb_at' ((=) (Some scPtr)) tcbPtr s
-                \<and> (\<forall>a b. tcbPtr \<notin> set (ksReadyQueues s (a, b)))\<rbrace>
-   do threadSet (tcbSchedContext_update (\<lambda>_. Nothing)) tcbPtr;
-      setSchedContext scPtr $ scTCB_update (\<lambda>_. Nothing) sc
-   od
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding schedContextUnbindTCB_def invs'_def
-  apply (wp threadSet_valid_queues_no_state threadSet_valid_queues'_no_state
-            threadSet_valid_release_queue threadSet_valid_release_queue'
-            threadSet_not_inQ threadSet_idle' threadSet_iflive' threadSet_ifunsafe'T
-            threadSet_valid_pspace'T threadSet_sch_actT_P[where P=False, simplified]
-            threadSet_ctes_ofT threadSet_ct_idle_or_in_cur_domain' threadSet_cur
-            threadSet_global_refsT irqs_masked_lift untyped_ranges_zero_lift
-            valid_irq_node_lift valid_irq_handlers_lift''
-         | (rule hoare_vcg_conj_lift, rule threadSet_wp)
-         | clarsimp simp: tcb_cte_cases_def cteCaps_of_def valid_dom_schedule'_def)+
-  apply (frule ko_at_valid_objs'_pre[where p=scPtr], clarsimp)
-  (* slow 60s *)
-  by (auto elim!: ex_cap_to'_after_update[OF if_live_state_refsE[where p=scPtr]]
-            elim: valid_objs_sizeE'[OF valid_objs'_valid_objs_size'] ps_clear_domE
-           split: option.splits
-            simp: pred_tcb_at'_def ko_wp_at'_def obj_at'_def objBits_def objBitsKO_def
-                  projectKO_eq projectKO_tcb projectKO_ntfn projectKO_reply projectKO_sc
-                  tcb_cte_cases_def valid_sched_context'_def valid_sched_context_size'_def
-                  valid_bound_obj'_def valid_obj'_def valid_obj_size'_def valid_idle'_def
-                  valid_release_queue'_def valid_pspace'_def untyped_ranges_zero_inv_def
-                  idle_tcb'_def state_refs_of'_def comp_def valid_idle'_asrt_def)
-
-crunch tcbReleaseRemove, tcbSchedDequeue
-  for cur_tcb'[wp]: cur_tcb'
-  (wp: cur_tcb_lift)
-
-lemma schedContextUnbindTCB_invs'[wp]:
-  "\<lbrace>\<lambda>s. invs' s \<and> scPtr \<noteq> idle_sc_ptr\<rbrace> schedContextUnbindTCB scPtr \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding schedContextUnbindTCB_def
-  apply (rule schedContextUnbindTCB_invs'_helper[simplified] bind_wp | clarsimp)+
-        apply (wpsimp wp: tcbReleaseRemove_invs' tcbReleaseRemove_not_queued
-                          tcbSchedDequeue_nonq tcbSchedDequeue_invs' hoare_vcg_all_lift)+
-  apply (fastforce dest: sym_refs_obj_atD'
-                   simp: invs_queues invs_valid_objs' invs'_valid_tcbs' valid_idle'_asrt_def
-                         sym_refs_asrt_def if_cancel_eq_True ko_wp_at'_def refs_of_rev'
-                         pred_tcb_at'_def obj_at'_def projectKO_eq projectKO_tcb cur_tcb'_asrt_def)
-  done
-
-(* FIXME RT: bound_tcb_at' is an outdated name? *)
-lemma threadSet_sc_bound_tcb_at'[wp]:
-  "threadSet (tcbSchedContext_update f) t' \<lbrace>bound_tcb_at' P t\<rbrace>"
-  by (wpsimp wp: threadSet_pred_tcb_no_state)
-
-lemma threadSet_fault_bound_tcb_at'[wp]:
-  "threadSet (tcbFault_update f) t' \<lbrace>bound_tcb_at' P t\<rbrace>"
-  by (wpsimp wp: threadSet_pred_tcb_no_state)
-
-crunch replyClear
-  for bound_tcb_at'[wp]: "bound_tcb_at' P t"
-  (wp: crunch_wps simp: crunch_simps ignore: threadSet)
+  (wp: sts_bound_tcb_at' threadSet_cteCaps_of crunch_wps getObject_inv
+       loadObject_default_inv)
 
 lemma finaliseCapTrue_standin_bound_tcb_at':
-  "\<lbrace>\<lambda>s. bound_tcb_at' P t s \<and> (\<exists>tt r. cap = ReplyCap tt r) \<rbrace>
+  "\<lbrace>\<lambda>s. bound_tcb_at' P t s \<and> (\<exists>tt b r. cap = ReplyCap tt b r) \<rbrace>
      finaliseCapTrue_standin cap final
    \<lbrace>\<lambda>_. bound_tcb_at' P t\<rbrace>"
-  apply (case_tac cap; simp add: finaliseCapTrue_standin_def isCap_simps)
-  by wpsimp
+  apply (case_tac cap, simp_all add:finaliseCapTrue_standin_def)
+  apply (clarsimp simp: isNotificationCap_def)
+  apply (wp, clarsimp)
+  done
 
 lemma capDeleteOne_bound_tcb_at':
   "\<lbrace>bound_tcb_at' P tptr and cte_wp_at' (isReplyCap \<circ> cteCap) callerCap\<rbrace>
-   cteDeleteOne callerCap
-   \<lbrace>\<lambda>_. bound_tcb_at' P tptr\<rbrace>"
+      cteDeleteOne callerCap \<lbrace>\<lambda>rv. bound_tcb_at' P tptr\<rbrace>"
   apply (simp add: cteDeleteOne_def unless_def)
   apply (rule hoare_pre)
-    apply (wp finaliseCapTrue_standin_bound_tcb_at' hoare_vcg_all_lift
-              hoare_vcg_if_lift2 getCTE_cteCap_wp
-           | clarsimp simp: isFinalCapability_def Let_def cteCaps_of_def isReplyCap_def
-                            cte_wp_at_ctes_of
-                     split: option.splits
-           | intro conjI impI | wp (once) hoare_drop_imp)+
-   apply (case_tac "cteCap cte", simp_all)
-   done
-
-crunch cleanReply
-  for bound_sc_tcb_at'[wp]: "bound_sc_tcb_at' P t"
-
-lemma replyRemoveTCB_bound_sc_tcb_at'[wp]:
-  "replyRemoveTCB t \<lbrace>bound_sc_tcb_at' P tptr\<rbrace>"
-  unfolding replyRemoveTCB_def
-  by (wpsimp wp: hoare_drop_imp hoare_vcg_all_lift threadSet_pred_tcb_no_state)
-
-lemma schedContextCancelYieldTo_bound_tcb_at[wp]:
-  "schedContextCancelYieldTo t \<lbrace> bound_tcb_at' P tptr \<rbrace>"
-  unfolding schedContextCancelYieldTo_def
-  by (wpsimp wp: threadSet_pred_tcb_no_state hoare_vcg_if_lift2 hoare_drop_imp)
-
-crunch prepareThreadDelete
-  for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
-
-crunch suspend
-  for bound_tcb_at'[wp]: "bound_tcb_at' P t"
-  and bound_sc_tcb_at'[wp]: "bound_sc_tcb_at' P t"
-  (wp: threadSet_pred_tcb_no_state crunch_wps simp: crunch_simps)
-
-lemma schedContextCancelYieldTo_bound_yt_tcb_at'_None:
-  "\<lbrace>\<lambda>_. True\<rbrace> schedContextCancelYieldTo t \<lbrace>\<lambda>rv. bound_yt_tcb_at' ((=) None) t\<rbrace>"
-  apply (simp add: schedContextCancelYieldTo_def)
-  apply (wpsimp wp: threadSet_pred_tcb_at_state threadGet_wp)
-  apply (auto simp: pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma suspend_bound_yt_tcb_at'_None:
-  "\<lbrace>\<lambda>_. True\<rbrace> suspend t \<lbrace>\<lambda>rv. bound_yt_tcb_at' ((=) None) t\<rbrace>"
-  apply (simp add: suspend_def)
-  apply (wpsimp wp: schedContextCancelYieldTo_bound_yt_tcb_at'_None)
-  done
-
-crunch schedContextCompleteYieldTo
-  for bound_sc_tcb_at'[wp]: "bound_sc_tcb_at' P p"
-  and sch_act_simple[wp]: sch_act_simple
-  (simp: crunch_simps wp: crunch_wps)
-
-lemma bound_sc_tcb_at'_sym_refsD:
-  "\<lbrakk>bound_sc_tcb_at' (\<lambda>scPtr'. scPtr' = Some scPtr) tcbPtr s; sym_refs (state_refs_of' s)\<rbrakk>
-   \<Longrightarrow> obj_at' (\<lambda>sc. scTCB sc = Some tcbPtr) scPtr s"
-  apply (clarsimp simp: pred_tcb_at'_def)
-  apply (drule (1) sym_refs_obj_atD')
-  apply (auto simp: state_refs_of'_def ko_wp_at'_def obj_at'_def
-                    refs_of_rev' projectKOs)
-  done
-
-lemma schedContextUnbindTCB_bound_sc_tcb_at'_None:
-  "\<lbrace>bound_sc_tcb_at' (\<lambda>sc_opt. sc_opt = (Some sc)) t\<rbrace>
-   schedContextUnbindTCB sc
-   \<lbrace>\<lambda>rv. bound_sc_tcb_at' ((=) None) t\<rbrace>"
-  apply (simp add: schedContextUnbindTCB_def sym_refs_asrt_def)
-  apply (wpsimp wp: threadSet_pred_tcb_at_state hoare_vcg_imp_lift)
-  apply (drule (1) bound_sc_tcb_at'_sym_refsD)
-  apply (auto simp: obj_at'_def)
+   apply (wp finaliseCapTrue_standin_bound_tcb_at' hoare_vcg_all_lift
+            hoare_vcg_if_lift2 getCTE_cteCap_wp
+        | wpc | simp | wp (once) hoare_drop_imp)+
+  apply (clarsimp simp:  cteCaps_of_def projectKOs isReplyCap_def cte_wp_at_ctes_of
+                 split: option.splits)
+  apply (case_tac "cteCap cte", simp_all)
+  done
+
+lemma cancelIPC_bound_tcb_at'[wp]:
+  "\<lbrace>bound_tcb_at' P tptr\<rbrace> cancelIPC t \<lbrace>\<lambda>rv. bound_tcb_at' P tptr\<rbrace>"
+  apply (simp add: cancelIPC_def Let_def)
+  apply (rule bind_wp[OF _ gts_sp'])
+  apply (case_tac "state", simp_all)
+         defer 2
+         apply (rule hoare_pre)
+          apply ((wp sts_bound_tcb_at' getEndpoint_wp | wpc | simp)+)[8]
+  apply (simp add: getThreadReplySlot_def locateSlot_conv liftM_def)
+  apply (rule hoare_pre)
+   apply (wp capDeleteOne_bound_tcb_at' getCTE_ctes_of)
+   apply (rule_tac Q'="\<lambda>_. bound_tcb_at' P tptr" in hoare_post_imp)
+   apply (clarsimp simp: capHasProperty_def cte_wp_at_ctes_of)
+   apply (wp threadSet_pred_tcb_no_state | simp)+
   done
 
-lemma unbindFromSC_bound_sc_tcb_at'_None:
-  "\<lbrace>\<top>\<rbrace>
-   unbindFromSC t
-   \<lbrace>\<lambda>rv. bound_sc_tcb_at' ((=) None) t\<rbrace>"
-  apply (simp add: unbindFromSC_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (wpsimp wp: schedContextUnbindTCB_bound_sc_tcb_at'_None threadGet_wp get_sc_inv'
-                    hoare_drop_imp)
-  apply (auto simp: pred_tcb_at'_def obj_at'_def)
-  done
+crunch suspend, prepareThreadDelete
+  for bound_tcb_at'[wp]: "bound_tcb_at' P t"
+  (wp: sts_bound_tcb_at' cancelIPC_bound_tcb_at')
 
 lemma unbindNotification_bound_tcb_at':
   "\<lbrace>\<lambda>_. True\<rbrace> unbindNotification t \<lbrace>\<lambda>rv. bound_tcb_at' ((=) None) t\<rbrace>"
@@ -3253,7 +2744,6 @@ lemma unbindNotification_bound_tcb_at':
 
 crunch unbindNotification, unbindMaybeNotification
   for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-  (wp: weak_sch_act_wf_lift)
 
 lemma unbindNotification_tcb_at'[wp]:
   "\<lbrace>tcb_at' t'\<rbrace> unbindNotification t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
@@ -3280,298 +2770,40 @@ crunch prepareThreadDelete
 
 end
 
-lemma ntfnSc_sym_refsD:
-  "\<lbrakk>obj_at' (\<lambda>ntfn. ntfnSc ntfn = Some scPtr) ntfnPtr s; sym_refs (state_refs_of' s)\<rbrakk>
-    \<Longrightarrow> obj_at' (\<lambda>sc. scNtfn sc = Some ntfnPtr) scPtr s"
-  apply (drule (1) sym_refs_obj_atD')
-  apply (auto simp: state_refs_of'_def ko_wp_at'_def obj_at'_def
-                    refs_of_rev' projectKOs)
-  done
-
-lemma scNtfn_sym_refsD:
-  "\<lbrakk>obj_at' (\<lambda>sc. scNtfn sc = Some ntfnPtr) scPtr s;
-    valid_objs' s; sym_refs (state_refs_of' s)\<rbrakk>
-    \<Longrightarrow> obj_at' (\<lambda>ntfn. ntfnSc ntfn = Some scPtr) ntfnPtr s"
-  apply (frule obj_at_valid_objs', assumption)
-  apply (clarsimp simp: valid_obj'_def valid_sched_context'_def projectKOs)
-  apply (frule_tac p=ntfnPtr in obj_at_valid_objs', assumption)
-  apply (clarsimp simp: valid_obj'_def valid_ntfn'_def projectKOs)
-  apply (frule_tac p=scPtr in sym_refs_obj_atD', assumption)
-  apply (frule_tac p=ntfnPtr in sym_refs_obj_atD', assumption)
-  apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKOs get_refs_def2 ntfn_q_refs_of'_def
-                 split: Structures_H.ntfn.splits)
-  done
-
-lemma schedContextUnbindNtfn_obj_at'_ntfnSc:
-  "\<lbrace>obj_at' (\<lambda>ntfn. ntfnSc ntfn = Some scPtr) ntfnPtr\<rbrace>
-   schedContextUnbindNtfn scPtr
-   \<lbrace>\<lambda>_ s. obj_at' (\<lambda>ntfn. ntfnSc ntfn = None) ntfnPtr s\<rbrace>"
-  apply (simp add: schedContextUnbindNtfn_def sym_refs_asrt_def)
-  apply (wpsimp wp: stateAssert_wp set_ntfn'.obj_at'_strongest getNotification_wp
-                    hoare_vcg_all_lift hoare_vcg_imp_lift')
-  apply (drule ntfnSc_sym_refsD; assumption?)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  done
-
-lemma schedContextMaybeUnbindNtfn_obj_at'_ntfnSc:
-  "\<lbrace>\<top>\<rbrace>
-   schedContextMaybeUnbindNtfn ntfnPtr
-   \<lbrace>\<lambda>_ s. obj_at' (\<lambda>ntfn. ntfnSc ntfn = None) ntfnPtr s\<rbrace>"
-  apply (simp add: schedContextMaybeUnbindNtfn_def)
-  apply (wpsimp wp: schedContextUnbindNtfn_obj_at'_ntfnSc getNotification_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma replyUnlink_makes_unlive:
-  "\<lbrace>\<lambda>s. \<not> is_reply_linked rptr' s \<and> replySCs_of s rptr' = None
-        \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> rptr' = rptr\<rbrace>
-   replyUnlink rptr tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') rptr'\<rbrace>"
-  apply (simp add: replyUnlink_def)
-  apply (wpsimp wp: setThreadState_Inactive_unlive updateReply_wp_all gts_wp')
-  by (auto simp: ko_wp_at'_def obj_at'_def projectKOs opt_map_def objBitsKO_def
-                 live'_def live_reply'_def weak_sch_act_wf_def pred_tcb_at'_def
-                 replyNext_None_iff)
-
-lemma cleanReply_obj_at_next_prev_none:
-  "\<lbrace>K (rptr' = rptr)\<rbrace>
-   cleanReply rptr
-   \<lbrace>\<lambda>_ s. \<not> is_reply_linked rptr s \<and> replySCs_of s rptr = None\<rbrace>"
-  apply (simp add: cleanReply_def )
-  apply (wpsimp wp: updateReply_wp_all)
-  apply (auto simp: obj_at'_def projectKOs objBitsKO_def)
-  done
-
-lemma replyPop_makes_unlive:
-  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-   replyPop rptr tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') rptr\<rbrace>"
-  apply (simp add: replyPop_def)
-  by (wpsimp wp: replyUnlink_makes_unlive cleanReply_obj_at_next_prev_none
-                    hoare_vcg_if_lift
-         | wp (once) hoare_drop_imps)+
-
-lemma replyRemove_makes_unlive:
-  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-   replyRemove rptr tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') rptr\<rbrace>"
-  apply (simp add: replyRemove_def)
-  by (wpsimp wp: replyPop_makes_unlive replyUnlink_makes_unlive cleanReply_obj_at_next_prev_none
-                 hoare_vcg_if_lift threadGet_wp gts_wp' hoare_drop_imps)
-
-lemma replyRemoveTCB_makes_unlive:
-  "\<lbrace>\<lambda>s. st_tcb_at' (\<lambda>st. replyObject st = Some rptr) tptr s
-        \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-   replyRemoveTCB tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') rptr\<rbrace>"
-  apply (simp add: replyRemoveTCB_def)
-  apply (wpsimp wp: replyUnlink_makes_unlive cleanReply_obj_at_next_prev_none
-                    hoare_vcg_if_lift threadGet_wp gts_wp' hoare_drop_imps)
-  by (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-
-method cancelIPC_makes_unlive_hammer =
-  (normalise_obj_at',
-   frule (2) sym_ref_replyTCB_Receive_or_Reply,
-   fastforce simp: weak_sch_act_wf_def pred_tcb_at'_def obj_at'_def projectKOs)
-
-lemma obj_at_replyTCBs_of:
-  "obj_at' (\<lambda>reply. replyTCB reply = tptr_opt) rptr s
-   \<Longrightarrow> replyTCBs_of s rptr = tptr_opt"
-  by (clarsimp simp: obj_at'_def projectKOs opt_map_def)
-
-lemma cancelIPC_makes_unlive:
-  "\<lbrace>\<lambda>s. obj_at' (\<lambda>reply. replyTCB reply = Some tptr) rptr s
-        \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> valid_replies' s
-        \<and> valid_replies'_sc_asrt rptr s\<rbrace>
-   cancelIPC tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') rptr\<rbrace>"
-  unfolding cancelIPC_def blockedCancelIPC_def Let_def getBlockingObject_def sym_refs_asrt_def
-  apply simp
-  apply (intro bind_wp[OF _ stateAssert_sp] bind_wp[OF _ gts_sp'])+
-  apply (case_tac state; clarsimp)
-         (* BlockedOnReceive*)
-         apply (rename_tac ep pl rp)
-         apply (case_tac rp; clarsimp)
-          apply (wpsimp wp: hoare_pre_cont, cancelIPC_makes_unlive_hammer)
-         apply (wpsimp wp: setThreadState_unlive_other replyUnlink_makes_unlive
-                           hoare_vcg_all_lift hoare_drop_imps threadSet_weak_sch_act_wf)
-         apply (frule obj_at_replyTCBs_of,
-                frule (1) valid_replies'_other_state;
-                  clarsimp simp: valid_replies'_sc_asrt_replySC_None)
-         apply cancelIPC_makes_unlive_hammer
-        (* BlockedOnReply*)
-        apply (wpsimp wp: replyRemoveTCB_makes_unlive threadSet_pred_tcb_no_state
-                          threadSet_weak_sch_act_wf)
-        apply cancelIPC_makes_unlive_hammer
-       (* All other states are impossible *)
-       apply (wpsimp wp: hoare_pre_cont, cancelIPC_makes_unlive_hammer)+
-  done
-
-lemma replyClear_makes_unlive:
-  "\<lbrace>\<lambda>s. obj_at' (\<lambda>reply. replyTCB reply = Some tptr) rptr s
-        \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> valid_replies' s
-        \<and> valid_replies'_sc_asrt rptr s\<rbrace>
-   replyClear rptr tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') rptr\<rbrace>"
-  apply (simp add: replyClear_def)
-  apply (wpsimp wp: replyRemove_makes_unlive cancelIPC_makes_unlive gts_wp' haskell_fail_wp)
-  done
-
-crunch unbindFromSC
-  for bound_tcb_at'[wp]: "bound_tcb_at' P p"
-  (ignore: threadSet simp: crunch_simps wp: crunch_wps)
-
-lemma schedContextUnbindTCB_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_objs' and sch_act_simple\<rbrace>
-   schedContextUnbindTCB scPtr
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  unfolding schedContextUnbindTCB_def
-  apply (wpsimp wp: threadSet_valid_queues tcbReleaseRemove_valid_queues
-                    hoare_vcg_all_lift tcbSchedDequeue_valid_queues
-                    rescheduleRequired_oa_queued tcbSchedDequeue_nonq
-         | wp (once) hoare_drop_imps)+
-  apply (auto simp: valid_obj'_def valid_sched_context'_def
-              elim: valid_objs'_maxDomain valid_objs'_maxPriority
-             dest!: ko_at_valid_objs'_pre)
-  done
-
-crunch setConsumed
-  for valid_queues[wp]: valid_queues
-  and ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
-  (simp: crunch_simps wp: crunch_wps)
-
-lemma schedContextCompleteYieldTo_valid_queues[wp]:
-  "schedContextCompleteYieldTo tptr \<lbrace>valid_queues\<rbrace>"
-  unfolding schedContextCompleteYieldTo_def
-  apply (wpsimp wp: hoare_vcg_all_lift threadGet_wp simp: inQ_def cong: conj_cong)
-  apply (clarsimp simp: obj_at'_def)
-  done
+lemma tcbQueueRemove_tcbSchedNext_tcbSchedPrev_None_obj_at':
+  "\<lbrace>\<lambda>s. \<exists>ts. list_queue_relation ts q (tcbSchedNexts_of s) (tcbSchedPrevs_of s)\<rbrace>
+   tcbQueueRemove q t
+   \<lbrace>\<lambda>_ s. obj_at' (\<lambda>tcb. tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None) t s\<rbrace>"
+  apply (clarsimp simp: tcbQueueRemove_def)
+  apply (wpsimp wp: threadSet_wp getTCB_wp)
+  by (fastforce dest!: heap_ls_last_None
+                 simp: list_queue_relation_def prev_queue_head_def queue_end_valid_def
+                       obj_at'_def projectKOs opt_map_def ps_clear_def objBits_simps
+                split: if_splits)
+
+lemma tcbSchedDequeue_tcbSchedNext_tcbSchedPrev_None_obj_at':
+  "\<lbrace>valid_sched_pointers\<rbrace>
+   tcbSchedDequeue t
+   \<lbrace>\<lambda>_ s. obj_at' (\<lambda>tcb. tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None) t s\<rbrace>"
+  unfolding tcbSchedDequeue_def
+  by (wpsimp wp: tcbQueueRemove_tcbSchedNext_tcbSchedPrev_None_obj_at' threadGet_wp)
+     (fastforce simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def
+                      valid_sched_pointers_def opt_pred_def opt_map_def projectKOs
+               split: option.splits)
 
-crunch unbindFromSC
-  for valid_queues[wp]: valid_queues
+crunch updateRestartPC, cancelIPC
+  for valid_sched_pointers[wp]: valid_sched_pointers
   (simp: crunch_simps wp: crunch_wps)
 
-crunch schedContextCompleteYieldTo, unbindNotification, unbindMaybeNotification
-  for sch_act_simple[wp]: sch_act_simple
-  (simp: crunch_simps wp: crunch_wps rule: sch_act_simple_lift)
-
-lemma schedContextSetInactive_unlive[wp]:
-  "schedContextSetInactive scPtr \<lbrace>\<lambda>s. P (ko_wp_at' (Not \<circ> live') p s)\<rbrace>"
-  unfolding schedContextSetInactive_def
-  apply (wpsimp wp: set_sc'.set_wp simp: updateSchedContext_def simp_del: fun_upd_apply)
-  apply (clarsimp simp: ko_wp_at'_def obj_at'_def live_sc'_def
-                        ps_clear_upd objBits_simps scBits_simps projectKOs)
-  done
-
-crunch setMessageInfo, setMRs
-  for obj_at'_sc[wp]: "obj_at' (P :: sched_context \<Rightarrow> bool) p"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma schedContextUpdateConsumed_obj_at'_not_consumed:
-  "(\<And>ko f. P (scConsumed_update f ko) = P ko)
-   \<Longrightarrow> schedContextUpdateConsumed scPtr \<lbrace>obj_at' P t\<rbrace>"
-  apply (simp add: schedContextUpdateConsumed_def)
-  apply (wpsimp wp: set_sc'.obj_at'_strongest)
-  by (auto simp: obj_at'_def)
-
-lemma setConsumed_obj_at'_not_consumed:
-  "(\<And>ko f. P (scConsumed_update f ko) = P ko)
-   \<Longrightarrow> setConsumed scPtr buffer \<lbrace>obj_at' P t\<rbrace>"
-  apply (clarsimp simp: setConsumed_def)
-  apply (wpsimp wp: schedContextUpdateConsumed_obj_at'_not_consumed)
-  done
-
-lemma schedContextCancelYieldTo_makes_unlive:
-  "\<lbrace>obj_at' (\<lambda>sc. scTCB sc = None) scPtr and obj_at' (\<lambda>sc. scNtfn sc = None) scPtr and
-    obj_at' (\<lambda>sc. scReply sc = None) scPtr and bound_yt_tcb_at' (\<lambda>yieldTo. yieldTo = Some scPtr) tptr\<rbrace>
-   schedContextCancelYieldTo tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') scPtr\<rbrace>"
-  unfolding schedContextCancelYieldTo_def updateSchedContext_def
-  apply (wpsimp wp: threadSet_unlive_other set_sc'.ko_wp_at threadGet_wp)
-  apply (auto simp: pred_tcb_at'_def obj_at'_def ko_wp_at'_def projectKOs live_sc'_def)
-  done
-
-lemma schedContextCompleteYieldTo_makes_unlive:
-  "\<lbrace>obj_at' (\<lambda>sc. scTCB sc = None) scPtr and obj_at' (\<lambda>sc. scNtfn sc = None) scPtr and
-    obj_at' (\<lambda>sc. scReply sc = None) scPtr and bound_yt_tcb_at' ((=) (Some scPtr)) tptr\<rbrace>
-   schedContextCompleteYieldTo tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') scPtr\<rbrace>"
-  unfolding schedContextCompleteYieldTo_def
-  apply (wpsimp wp: schedContextCancelYieldTo_makes_unlive haskell_fail_wp
-                    setConsumed_obj_at'_not_consumed hoare_drop_imps threadGet_wp)
-  apply (auto simp: pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma sym_ref_scYieldFrom:
-  "\<lbrakk>ko_at' sc scp s; scYieldFrom sc = Some tp; sym_refs (state_refs_of' s)\<rbrakk>
-  \<Longrightarrow> \<exists>tcb. ko_at' tcb tp s \<and> tcbYieldTo tcb = Some scp"
-  apply (drule (1) sym_refs_ko_atD')
-  apply (auto simp: state_refs_of'_def ko_wp_at'_def obj_at'_def
-                    refs_of_rev' projectKOs)
-  done
-
-lemma schedContextUnbindYieldFrom_makes_unlive:
-  "\<lbrace>obj_at' (\<lambda>sc. scTCB sc = None) scPtr and obj_at' (\<lambda>sc. scNtfn sc = None) scPtr and
-    obj_at' (\<lambda>sc. scReply sc = None) scPtr\<rbrace>
-   schedContextUnbindYieldFrom scPtr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') scPtr\<rbrace>"
-  unfolding schedContextUnbindYieldFrom_def sym_refs_asrt_def
-  apply (wpsimp wp: schedContextCompleteYieldTo_makes_unlive)
-  apply (rule conjI; clarsimp)
-   apply (drule (2) sym_ref_scYieldFrom)
-   apply (auto simp: pred_tcb_at'_def obj_at'_def ko_wp_at'_def projectKOs live_sc'_def)
-  done
-
-lemma schedContextUnbindReply_obj_at'_not_reply:
-  "(\<And>ko f. P (scReply_update f ko) = P ko)
-   \<Longrightarrow> schedContextUnbindReply scPtr \<lbrace>obj_at' P p\<rbrace>"
-  apply (clarsimp simp: schedContextUnbindReply_def)
-  apply (wpsimp wp: set_sc'.obj_at'_strongest updateReply_wp_all)
-  by (auto simp: obj_at'_def projectKOs)
-
-lemma schedContextUnbindReply_obj_at'_reply_None:
-  "\<lbrace>\<top>\<rbrace> schedContextUnbindReply scPtr \<lbrace>\<lambda>_. obj_at' (\<lambda>sc. scReply sc = None) scPtr\<rbrace>"
-  apply (clarsimp simp: schedContextUnbindReply_def)
-  apply (wpsimp wp: set_sc'.obj_at'_strongest)
-  by (auto simp: obj_at'_def)
-
-lemma schedContextUnbindNtfn_obj_at'_not_ntfn:
-  "(\<And>ko f. P (scNtfn_update f ko) = P ko)
-   \<Longrightarrow> schedContextUnbindNtfn scPtr \<lbrace>obj_at' P p\<rbrace>"
-  apply (clarsimp simp: schedContextUnbindNtfn_def)
-  apply (wpsimp wp: set_sc'.obj_at'_strongest set_ntfn'.set_wp getNotification_wp)
-  by (auto simp: obj_at'_def projectKOs)
-
-lemma schedContextUnbindNtfn_obj_at'_ntfn_None:
-  "\<lbrace>\<top>\<rbrace> schedContextUnbindNtfn scPtr \<lbrace>\<lambda>_. obj_at' (\<lambda>sc. scNtfn sc = None) scPtr\<rbrace>"
-  apply (clarsimp simp: schedContextUnbindNtfn_def)
-  apply (wpsimp wp: set_sc'.obj_at'_strongest)
-  by (auto simp: obj_at'_def)
-
-lemma schedContextUnbindTCB_obj_at'_tcb_None:
-  "\<lbrace>\<top>\<rbrace> schedContextUnbindTCB scPtr \<lbrace>\<lambda>_. obj_at' (\<lambda>sc. scTCB sc = None) scPtr\<rbrace>"
-  apply (clarsimp simp: schedContextUnbindTCB_def)
-  by (wpsimp wp: set_sc'.obj_at'_strongest)
-
-lemma schedContextUnbindAllTCBs_obj_at'_tcb_None:
-  "\<lbrace>\<top>\<rbrace> schedContextUnbindAllTCBs scPtr \<lbrace>\<lambda>_. obj_at' (\<lambda>sc. scTCB sc = None) scPtr\<rbrace>"
-  apply (clarsimp simp: schedContextUnbindAllTCBs_def)
-  apply (wpsimp wp: schedContextUnbindTCB_obj_at'_tcb_None)
-  by (auto simp: obj_at'_def)
-
-lemmas schedContextSetInactive_removeable'
-  = prepares_delete_helper'' [OF schedContextSetInactive_unlive
-                                   [where p=scPtr and scPtr=scPtr for scPtr]]
-
-crunch schedContextMaybeUnbindNtfn
-  for sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-
-end
+lemma suspend_tcbSchedNext_tcbSchedPrev_None:
+  "\<lbrace>invs'\<rbrace> suspend t \<lbrace>\<lambda>_ s. obj_at' (\<lambda>tcb. tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None) t s\<rbrace>"
+  unfolding suspend_def
+  by (wpsimp wp: hoare_drop_imps tcbSchedDequeue_tcbSchedNext_tcbSchedPrev_None_obj_at')
 
 lemma (in delete_one_conc_pre) finaliseCap_replaceable:
   "\<lbrace>\<lambda>s. invs' s \<and> cte_wp_at' (\<lambda>cte. cteCap cte = cap) slot s
        \<and> (final_matters' cap \<longrightarrow> (final = isFinal cap slot (cteCaps_of s)))
-       \<and> sch_act_simple s\<rbrace>
+       \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
      finaliseCap cap final flag
    \<lbrace>\<lambda>rv s. (isNullCap (fst rv) \<and> removeable' slot s cap
                 \<and> (snd rv \<noteq> NullCap \<longrightarrow> snd rv = cap \<and> cap_has_cleanup' cap
@@ -3587,65 +2819,41 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable:
             \<and> (\<forall>p \<in> threadCapRefs cap. st_tcb_at' ((=) Inactive) p s
                      \<and> obj_at' (Not \<circ> tcbQueued) p s
                      \<and> bound_tcb_at' ((=) None) p s
-                     \<and> (\<forall>pr. p \<notin> set (ksReadyQueues s pr))
-                     \<and> bound_sc_tcb_at' ((=) None) p s
-                     \<and> bound_yt_tcb_at' ((=) None) p s))\<rbrace>"
+                     \<and> obj_at' (\<lambda>tcb. tcbSchedNext tcb = None \<and> tcbSchedPrev tcb = None) p s))\<rbrace>"
   apply (simp add: finaliseCap_def Let_def getThreadCSpaceRoot
              cong: if_cong split del: if_split)
   apply (rule hoare_pre)
-   apply (wpsimp wp: prepares_delete_helper'' [OF cancelAllIPC_unlive]
-                     prepares_delete_helper'' [OF cancelAllSignals_unlive]
-                     unbindMaybeNotification_obj_at'_ntfnBound
-                     unbindMaybeNotification_obj_at'_no_change
-               simp: isZombie_Null)
-    apply (strengthen invs_valid_objs')
-    apply (wpsimp wp: schedContextMaybeUnbindNtfn_obj_at'_ntfnSc
-                      prepares_delete_helper'' [OF replyClear_makes_unlive]
-                      hoare_vcg_if_lift_strong simp: isZombie_Null)+
-        apply (clarsimp simp: obj_at'_def)
-       apply (wpsimp wp: schedContextSetInactive_removeable'
-                         prepareThreadDelete_unqueued prepareThreadDelete_nonq
-                         prepareThreadDelete_inactive
-                         suspend_makes_inactive
-                         suspend_nonq
-                         suspend_bound_yt_tcb_at'_None
-                         unbindNotification_bound_tcb_at'
-                         unbindFromSC_bound_sc_tcb_at'_None
-                         schedContextUnbindYieldFrom_makes_unlive
-                         schedContextUnbindReply_obj_at'_reply_None
-                         schedContextUnbindReply_obj_at'_not_reply
-                         schedContextUnbindNtfn_obj_at'_ntfn_None
-                         schedContextUnbindNtfn_obj_at'_not_ntfn
-                         schedContextUnbindAllTCBs_obj_at'_tcb_None
-                   simp: isZombie_Null isThreadCap_threadCapRefs_tcbptr)+
-    apply (rule hoare_strengthen_post [OF arch_finaliseCap_removeable[where slot=slot]],
-           clarsimp simp: isCap_simps)
-   apply (wpsimp wp: deletingIRQHandler_removeable'
-                     deletingIRQHandler_final[where slot=slot])+
-  apply (frule cte_wp_at_valid_objs_valid_cap'; clarsimp)
+   apply (wp prepares_delete_helper'' [OF cancelAllIPC_unlive]
+             prepares_delete_helper'' [OF cancelAllSignals_unlive]
+             suspend_isFinal prepareThreadDelete_unqueued
+             prepareThreadDelete_inactive prepareThreadDelete_isFinal
+             suspend_makes_inactive
+             deletingIRQHandler_removeable'
+             deletingIRQHandler_final[where slot=slot ]
+             unbindMaybeNotification_obj_at'_bound
+             getNotification_wp
+             suspend_bound_tcb_at'
+             unbindNotification_bound_tcb_at'
+             suspend_tcbSchedNext_tcbSchedPrev_None
+           | simp add: isZombie_Null isThreadCap_threadCapRefs_tcbptr
+                       isArchObjectCap_Cap_capCap
+           | (rule hoare_strengthen_post [OF arch_finaliseCap_removeable[where slot=slot]],
+                  clarsimp simp: isCap_simps)
+           | wpc)+
+
+  apply clarsimp
+  apply (frule cte_wp_at_valid_objs_valid_cap', clarsimp+)
   apply (case_tac "cteCap cte",
          simp_all add: isCap_simps capRange_def cap_has_cleanup'_def
                        final_matters'_def objBits_simps
                        not_Final_removeable finaliseCap_def,
          simp_all add: removeable'_def)
-     (* ThreadCap *)
-      apply (frule capAligned_capUntypedPtr [OF valid_capAligned], simp)
-      apply (clarsimp simp: valid_cap'_def)
-      apply (drule valid_globals_cte_wpD'_idleThread[rotated], clarsimp)
-      apply (fastforce simp: invs'_def valid_pspace'_def)
-     (* NotificationCap *)
-     apply (fastforce simp: obj_at'_def sch_act_wf_asrt_def)
-     (* EndpointCap *)
-    apply (fastforce simp: sch_act_wf_asrt_def)
-   (* ArchObjectCap *)
-   apply (fastforce simp: obj_at'_def sch_act_wf_asrt_def)
-  (* ReplyCap *)
-  apply (rule conjI; clarsimp)
-   apply (fastforce simp: obj_at'_def sch_act_wf_asrt_def)
-  apply (frule (1) obj_at_replyTCBs_of[OF ko_at_obj_at', simplified])
-  apply (frule valid_replies'_no_tcb, clarsimp)
-  apply (clarsimp simp: ko_wp_at'_def obj_at'_def live_reply'_def projectKOs opt_map_def
-                        valid_replies'_sc_asrt_def replyNext_None_iff)
+     (* thread *)
+     apply (frule capAligned_capUntypedPtr [OF valid_capAligned], simp)
+     apply (clarsimp simp: valid_cap'_def)
+     apply (drule valid_globals_cte_wpD'[rotated], clarsimp)
+     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+    apply (clarsimp simp: obj_at'_def | rule conjI)+
   done
 
 lemma cteDeleteOne_cte_wp_at_preserved:
@@ -3658,70 +2866,81 @@ lemma cteDeleteOne_cte_wp_at_preserved:
   apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of x)
   done
 
-lemma cancelIPC_cteCaps_of[wp]:
-  "cancelIPC t \<lbrace>\<lambda>s. P (cteCaps_of s)\<rbrace>"
-  apply (simp add: cancelIPC_def Let_def capHasProperty_def locateSlot_conv)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule bind_wp_fwd_skip, wpsimp)
+crunch cancelSignal
+  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
+  (simp: crunch_simps wp: crunch_wps)
+
+lemma cancelIPC_cteCaps_of:
+  "\<lbrace>\<lambda>s. (\<forall>p. cte_wp_at' (\<lambda>cte. \<exists>final. finaliseCap (cteCap cte) final True \<noteq> fail) p s \<longrightarrow>
+          P ((cteCaps_of s)(p \<mapsto> NullCap))) \<and>
+     P (cteCaps_of s)\<rbrace>
+     cancelIPC t
+   \<lbrace>\<lambda>rv s. P (cteCaps_of s)\<rbrace>"
+  apply (simp add: cancelIPC_def Let_def capHasProperty_def
+                   getThreadReplySlot_def locateSlot_conv)
   apply (rule hoare_pre)
-   apply (wp getCTE_wp' | wpcw
-          | simp add: cte_wp_at_ctes_of
-          | wp (once) hoare_drop_imps ctes_of_cteCaps_of_lift)+
+   apply (wp cteDeleteOne_cteCaps_of getCTE_wp' | wpcw
+        | simp add: cte_wp_at_ctes_of
+        | wp (once) hoare_drop_imps ctes_of_cteCaps_of_lift)+
           apply (wp hoare_convert_imp hoare_vcg_all_lift
                     threadSet_ctes_of threadSet_cteCaps_of
                | clarsimp)+
+    apply (wp cteDeleteOne_cteCaps_of getCTE_wp' | wpcw | simp
+       | wp (once) hoare_drop_imps ctes_of_cteCaps_of_lift)+
+  apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def)
+  apply (drule_tac x="mdbNext (cteMDBNode x)" in spec)
+  apply clarsimp
+  apply (auto simp: o_def map_option_case fun_upd_def[symmetric])
   done
 
-lemma cancelIPC_cte_wp_at'[wp]:
-  "cancelIPC t \<lbrace>\<lambda>s. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p s\<rbrace>"
+lemma cancelIPC_cte_wp_at':
+  assumes x: "\<And>cap final. P cap \<Longrightarrow> finaliseCap cap final True = fail"
+  shows "\<lbrace>\<lambda>s. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p s\<rbrace>
+           cancelIPC t
+         \<lbrace>\<lambda>rv s. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p s\<rbrace>"
   apply (simp add: tree_cte_cteCap_eq[unfolded o_def])
-  apply wpsimp
+  apply (rule hoare_pre, wp cancelIPC_cteCaps_of)
+  apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of x)
   done
 
-crunch schedContextCancelYieldTo, tcbReleaseRemove
+crunch tcbSchedDequeue
   for cte_wp_at'[wp]: "cte_wp_at' P p"
-  (wp: crunch_wps simp: crunch_simps)
+  (wp: crunch_wps)
 
 lemma suspend_cte_wp_at':
-  "suspend t \<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
-  unfolding updateRestartPC_def suspend_def
-  apply (wpsimp wp: hoare_vcg_imp_lift hoare_disjI2[where Q'="\<lambda>_. cte_wp_at' a b" for a b])
+  assumes x: "\<And>cap final. P cap \<Longrightarrow> finaliseCap cap final True = fail"
+  shows "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>
+           suspend t
+         \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
+  apply (simp add: suspend_def)
+  unfolding updateRestartPC_def
+  apply (rule hoare_pre)
+   apply (wp threadSet_cte_wp_at' cancelIPC_cte_wp_at'
+            | simp add: x)+
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 crunch deleteASIDPool
   for cte_wp_at'[wp]: "cte_wp_at' P p"
   (simp: crunch_simps assertE_def
-   wp: crunch_wps getObject_inv)
+   wp: crunch_wps getObject_inv loadObject_default_inv)
 
 lemma deleteASID_cte_wp_at'[wp]:
   "\<lbrace>cte_wp_at' P p\<rbrace> deleteASID param_a param_b \<lbrace>\<lambda>_. cte_wp_at' P p\<rbrace>"
   apply (simp add: deleteASID_def invalidateHWASIDEntry_def invalidateASID_def
               cong: option.case_cong)
-  apply (wp setObject_cte_wp_at'[where Q="\<top>"] getObject_inv setVMRoot_cte_wp_at'
+  apply (wp setObject_cte_wp_at'[where Q="\<top>"] getObject_inv
+            loadObject_default_inv setVMRoot_cte_wp_at'
           | clarsimp simp: updateObject_default_def in_monad
                            projectKOs
           | rule equals0I
           | wpc)+
   done
 
-crunch unmapPageTable, unmapPage, unbindNotification, cancelAllIPC, cancelAllSignals,
-         unbindMaybeNotification, schedContextMaybeUnbindNtfn, replyRemove,
-         unbindFromSC, schedContextSetInactive, schedContextUnbindYieldFrom,
-         schedContextUnbindReply, schedContextUnbindAllTCBs
+crunch unmapPageTable, unmapPage, unbindNotification, finaliseCapTrue_standin
   for cte_wp_at'[wp]: "cte_wp_at' P p"
-  (simp: crunch_simps wp: crunch_wps getObject_inv)
-
-lemma replyClear_standin_cte_preserved[wp]:
-  "replyClear rptr tptr \<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
-  unfolding replyClear_def
-  by (wpsimp wp: gts_wp')
-
-lemma finaliseCapTrue_standin_cte_preserved[wp]:
-  "finaliseCapTrue_standin cap fin \<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
-  unfolding finaliseCapTrue_standin_def Let_def
-  by (wpsimp wp: replyClear_standin_cte_preserved simp:)
+  (simp: crunch_simps wp: crunch_wps getObject_inv loadObject_default_inv)
 
 lemma arch_finaliseCap_cte_wp_at[wp]:
   "\<lbrace>cte_wp_at' P p\<rbrace> Arch.finaliseCap cap fin \<lbrace>\<lambda>rv. cte_wp_at' P p\<rbrace>"
@@ -3729,12 +2948,10 @@ lemma arch_finaliseCap_cte_wp_at[wp]:
   apply (safe ; wpsimp wp: unmapPage_cte_wp_at')
   done
 
-end
-
 lemma deletingIRQHandler_cte_preserved:
   assumes x: "\<And>cap final. P cap \<Longrightarrow> finaliseCap cap final True = fail"
   shows "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>
-         deletingIRQHandler irq
+           deletingIRQHandler irq
          \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
   apply (simp add: deletingIRQHandler_def getSlotCap_def
                    getIRQSlot_def locateSlot_conv getInterruptState_def)
@@ -3744,12 +2961,14 @@ lemma deletingIRQHandler_cte_preserved:
 
 lemma finaliseCap_equal_cap[wp]:
   "\<lbrace>cte_wp_at' (\<lambda>cte. cteCap cte = cap) sl\<rbrace>
-   finaliseCap cap fin flag
+     finaliseCap cap fin flag
    \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. cteCap cte = cap) sl\<rbrace>"
   apply (simp add: finaliseCap_def Let_def
              cong: if_cong split del: if_split)
-  apply (wpsimp wp: suspend_cte_wp_at' deletingIRQHandler_cte_preserved
-              simp: finaliseCap_def)+
+  apply (rule hoare_pre)
+   apply (wp suspend_cte_wp_at' deletingIRQHandler_cte_preserved
+        | clarsimp simp: finaliseCap_def | wpc)+
+  apply (case_tac cap)
   apply auto
   done
 
@@ -3765,16 +2984,9 @@ lemma setThreadState_st_tcb_at_simplish':
 lemmas setThreadState_st_tcb_at_simplish
     = setThreadState_st_tcb_at_simplish'[unfolded pred_disj_def]
 
-lemma replyUnlink_st_tcb_at_simplish:
-  "replyUnlink r t' \<lbrace>st_tcb_at' (\<lambda>st. P st \<or> simple' st) t\<rbrace>"
-  supply if_split [split del]
-  unfolding replyUnlink_def
-  apply (wpsimp wp: sts_st_tcb' hoare_vcg_if_lift2 hoare_vcg_imp_lift' gts_wp')
-  done
-
 crunch cteDeleteOne
- for st_tcb_at_simplish: "st_tcb_at' (\<lambda>st. P st \<or> simple' st) t"
-  (wp: crunch_wps getObject_inv threadSet_pred_tcb_no_state
+  for st_tcb_at_simplish: "st_tcb_at' (\<lambda>st. P st \<or> simple' st) t"
+  (wp: crunch_wps getObject_inv loadObject_default_inv threadSet_pred_tcb_no_state
    simp: crunch_simps unless_def)
 
 lemma cteDeleteOne_st_tcb_at[wp]:
@@ -3784,366 +2996,170 @@ lemma cteDeleteOne_st_tcb_at[wp]:
    apply (clarsimp simp: pred_disj_def)
    apply (rule cteDeleteOne_st_tcb_at_simplish)
   apply (rule_tac x=P in exI)
-  apply (auto)
+  apply (auto intro!: ext)
   done
 
+lemma cteDeleteOne_reply_pred_tcb_at:
+  "\<lbrace>\<lambda>s. pred_tcb_at' proj P t s \<and> (\<exists>t' r. cte_wp_at' (\<lambda>cte. cteCap cte = ReplyCap t' False r) slot s)\<rbrace>
+    cteDeleteOne slot
+   \<lbrace>\<lambda>rv. pred_tcb_at' proj P t\<rbrace>"
+  apply (simp add: cteDeleteOne_def unless_def isFinalCapability_def)
+  apply (rule bind_wp [OF _ getCTE_sp])
+  apply (rule hoare_assume_pre)
+  apply (clarsimp simp: cte_wp_at_ctes_of when_def isCap_simps
+                        Let_def finaliseCapTrue_standin_def)
+  apply (intro impI conjI, (wp | simp)+)
+  done
+
+context
+notes option.case_cong_weak[cong]
+begin
+crunch cteDeleteOne, unbindNotification
+  for sch_act_simple[wp]: sch_act_simple
+  (wp: crunch_wps ssa_sch_act_simple sts_sch_act_simple getObject_inv
+       loadObject_default_inv
+   simp: crunch_simps unless_def
+   rule: sch_act_simple_lift)
+end
+
 lemma rescheduleRequired_sch_act_not[wp]:
   "\<lbrace>\<top>\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. sch_act_not t\<rbrace>"
   apply (simp add: rescheduleRequired_def setSchedulerAction_def)
   apply (wp hoare_TrueI | simp)+
   done
 
-lemma rescheduleRequired_oa_queued':
-  "\<lbrace>obj_at' (\<lambda>tcb. Q (tcbDomain tcb) (tcbPriority tcb)) t'\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. Q (tcbDomain tcb) (tcbPriority tcb)) t'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  by (wpsimp wp: tcbSchedEnqueue_not_st isSchedulable_wp)
-
-crunch cancelAllIPC, cancelAllSignals, unbindMaybeNotification
-  for tcbDomain_obj_at': "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma cancelAllIPC_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_tcbs'\<rbrace>
-   cancelAllIPC ep_ptr
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
-  unfolding cancelAllIPC_loop_body_def restartThreadIfNoFault_def
-  apply (wpsimp wp: mapM_x_wp' getEndpoint_wp
-              simp: valid_tcb_state'_def)
-  done
-
-lemma cancelAllSignals_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_tcbs'\<rbrace>
-   cancelAllSignals ntfn
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (simp add: cancelAllSignals_def)
-  apply (wpsimp wp: mapM_x_wp' getNotification_wp
-              simp: valid_tcb_state'_def)
-  done
-
-lemma setBoundNotification_valid_tcbs'[wp]:
-  "\<lbrace>valid_tcbs' and valid_bound_ntfn' ntfn\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv. valid_tcbs'\<rbrace>"
-  apply (wpsimp simp: setBoundNotification_def wp: threadSet_valid_tcbs')
-  by (simp add: valid_tcb'_def tcb_cte_cases_def)
-
-lemma unbindMaybeNotification_valid_tcbs'[wp]:
-  "unbindMaybeNotification ntfnPtr \<lbrace>valid_tcbs'\<rbrace>"
-  by (wpsimp simp: unbindMaybeNotification_def)
-
-crunch schedContextMaybeUnbindNtfn
-  for valid_queues[wp]: valid_queues
-
-lemma setSchedContext_valid_tcbs'[wp]:
-  "setSchedContext ptr val \<lbrace>valid_tcbs'\<rbrace>"
-  apply (clarsimp simp: setSchedContext_def)
-  apply (wpsimp wp: setObject_valid_tcbs'
-              simp: updateObject_default_def in_monad projectKOs project_inject)
-  done
-
-crunch schedContextUnbindNtfn, schedContextMaybeUnbindNtfn
-  for valid_tcbs'[wp]: valid_tcbs'
-  (wp: setSchedContext_valid_tcbs')
-
-lemma removeFromBitmap_valid_sched_context'[wp]:
-  "removeFromBitmap tdom prio \<lbrace>valid_sched_context' sc\<rbrace>"
-  by (wpsimp simp: bitmap_fun_defs)
-
-lemma setQueue_valid_sched_context'[wp]:
-  "setQueue tdom prio q \<lbrace>valid_sched_context' sc\<rbrace>"
-  apply (wpsimp simp: setQueue_def valid_sched_context'_def valid_bound_obj'_def
-               split: option.splits)
-  done
-
-lemma threadSet_valid_sched_context'[wp]:
-  "threadSet f y \<lbrace>valid_sched_context' sc\<rbrace>"
-  apply (wpsimp wp: threadSet_wp)
-  by (clarsimp simp: valid_sched_context'_def valid_bound_obj'_def
-              split: option.splits
-      ; fastforce simp: obj_at'_def projectKOs objBitsKO_def)
-
-lemma addToBitmap_valid_sched_context[wp]:
-  "addToBitmap tdom prio \<lbrace>valid_sched_context' sc\<rbrace>"
-  apply (clarsimp simp: addToBitmap_def)
-  apply (wpsimp simp: bitmap_fun_defs)
-  apply (clarsimp simp: valid_sched_context'_def valid_bound_obj'_def
-                 split: option.splits)
-  done
-
-crunch tcbSchedDequeue, tcbSchedEnqueue
-  for valid_sched_context'[wp]: "\<lambda>s. valid_sched_context' sc' s"
-
-lemma setQueue_valid_reply'[wp]:
-  "setQueue domain prio q \<lbrace>valid_reply' reply\<rbrace>"
-  apply (clarsimp simp: setQueue_def)
-  apply wpsimp
-  apply (fastforce simp: valid_reply'_def valid_bound_obj'_def split: option.splits)
-  done
-
-crunch replyClear
-  for valid_queues[wp]: valid_queues
-
-lemma finaliseCapTrue_standin_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_objs'\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (simp add: finaliseCapTrue_standin_def Let_def)
-  apply (intro conjI impI; wpsimp)
-  done
-
-crunch isFinalCapability
-  for valid_queues[wp]: "Invariants_H.valid_queues"
-  and sch_act[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  and weak_sch_act[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-  (simp: crunch_simps)
-
-lemma cteDeleteOne_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cteDeleteOne sl
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>" (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (simp add: cteDeleteOne_def unless_def split_def)
-  apply (wp isFinalCapability_inv getCTE_wp | rule hoare_drop_imps | simp)+
-  apply (clarsimp simp: cte_wp_at'_def)
-  done
-
-lemma valid_inQ_queues_lift:
-  assumes tat: "\<And>d p tcb. f \<lbrace>obj_at' (inQ d p) tcb\<rbrace>"
-  and     prq: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace>"
-  shows   "f \<lbrace>valid_inQ_queues\<rbrace>"
-  apply (insert assms)
-  apply (clarsimp simp: valid_inQ_queues_def)
-  apply (fastforce intro: hoare_vcg_all_lift hoare_vcg_ball_lift2)
-  done
-
-lemma emptySlot_valid_inQ_queues [wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace> emptySlot sl opt \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
-  unfolding emptySlot_def
-  by (wp opt_return_pres_lift | wpcw | wp valid_inQ_queues_lift | simp)+
-
-context begin interpretation Arch .
-
-crunch cancelAllIPC, cancelAllSignals, unbindNotification, unbindMaybeNotification,
-         schedContextMaybeUnbindNtfn, isFinalCapability
-  for valid_inQ_queues[wp]: "valid_inQ_queues"
-  (wp: crunch_wps simp: crunch_simps)
+crunch cteDeleteOne
+  for sch_act_not[wp]: "sch_act_not t"
+  (simp: crunch_simps case_Null_If unless_def
+   wp: crunch_wps getObject_inv loadObject_default_inv)
 
-lemma setQueue_after_removeFromBitmap:
-  "(setQueue d p q >>= (\<lambda>rv. (when P (removeFromBitmap d p)) >>= (\<lambda>rv. threadSet f t))) =
-   (when P (removeFromBitmap d p) >>= (\<lambda>rv. (threadSet f t) >>= (\<lambda>rv. setQueue d p q)))"
-  supply bind_assoc[simp add]
-  apply (case_tac P, simp_all)
-   prefer 2
-   apply (simp add: setQueue_after)
-  apply (simp add: setQueue_def when_def)
-  apply (subst oblivious_modify_swap)
-   apply (fastforce simp: threadSet_def getObject_def setObject_def readObject_def
-                          loadObject_default_def bitmap_fun_defs gets_the_def obind_def
-                          split_def projectKO_def alignCheck_assert read_magnitudeCheck_assert
-                          magnitudeCheck_assert updateObject_default_def omonad_defs
-                   intro: oblivious_bind split: option.splits)
-  apply clarsimp
+lemma cancelAllIPC_mapM_x_weak_sch_act:
+  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
+   mapM_x (\<lambda>t. do
+                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
+                 tcbSchedEnqueue t
+               od) q
+   \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (rule mapM_x_wp_inv)
+  apply (wp)
+  apply (clarsimp)
   done
 
-lemma valid_inQ_queues_exceptI[intro]:
-  "valid_inQ_queues s \<Longrightarrow> valid_inQ_queues_except t s"
-  by (simp add: valid_inQ_queues_except_def valid_inQ_queues_def)
-
-lemma threadSet_valid_inQ_queues_dequeue_wp:
- "\<lbrace>valid_inQ_queues_except t and (\<lambda>s. \<forall>d p. t \<notin> set (ksReadyQueues s (d,p)))\<rbrace>
-  threadSet (tcbQueued_update (\<lambda>_. False)) t
-  \<lbrace>\<lambda>_. valid_inQ_queues \<rbrace>"
-  unfolding threadSet_def
-  apply (rule bind_wp[OF _ getObject_tcb_sp])
-  apply (simp add: valid_inQ_queues_def)
-  apply (wpsimp wp: hoare_Ball_helper hoare_vcg_all_lift setObject_tcb_strongest)
-  apply (clarsimp simp: valid_inQ_queues_except_def)
+lemma cancelAllIPC_mapM_x_valid_objs':
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   mapM_x (\<lambda>t. do
+                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
+                 tcbSchedEnqueue t
+               od) q
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (rule hoare_strengthen_post)
+   apply (rule mapM_x_wp')
+  apply (wpsimp wp: sts_valid_objs')
+   apply (clarsimp simp: valid_tcb_state'_def)+
   done
 
-lemma removeFromBitmap_valid_inQ_queues_except[wp]:
-  "removeFromBitmap d p \<lbrace>valid_inQ_queues_except t\<rbrace>"
-  unfolding bitmapQ_defs valid_inQ_queues_except_def
-  by (wpsimp simp: bitmap_fun_defs)+
+lemma cancelAllIPC_mapM_x_tcbDomain_obj_at':
+  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
+   mapM_x (\<lambda>t. do
+                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
+                 tcbSchedEnqueue t
+               od) q
+  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  by (wpsimp wp: mapM_x_wp')
 
-lemma setQueue_valid_inQ_queues_except_dequeue_wp:
-  "\<lbrace>\<lambda>s. valid_inQ_queues_except t s \<and> (\<forall>t' \<in> set ts. obj_at' (inQ d p) t' s)\<rbrace>
-   setQueue d p ts
-   \<lbrace>\<lambda>_. valid_inQ_queues_except t\<rbrace>"
-  unfolding setQueue_def valid_inQ_queues_except_def null_def
+lemma rescheduleRequired_oa_queued':
+  "rescheduleRequired \<lbrace>obj_at' (\<lambda>tcb. Q (tcbDomain tcb) (tcbPriority tcb)) t\<rbrace>"
+  unfolding rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
   by wpsimp
 
-lemma valid_queues_no_bitmap_correct_queueI[intro]:
-  "valid_inQ_queues s \<Longrightarrow> correct_queue t s"
-  by (fastforce simp: correct_queue_def valid_inQ_queues_def obj_at'_def inQ_def)
-
-lemma tcbSchedDequeue_valid_inQ_queues_weak:
-  "\<lbrace>valid_inQ_queues_except t and correct_queue t and tcb_at' t\<rbrace>
-   tcbSchedDequeue t
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  unfolding tcbSchedDequeue_def null_def valid_inQ_queues_def
-  apply wp (* stops on threadSet *)
-          apply (rule hoare_post_eq[OF _ threadSet_valid_inQ_queues_dequeue_wp]
-                 , simp add: valid_inQ_queues_def)
-         apply (wp hoare_vcg_if_lift)+
-        apply (wp hoare_vcg_imp_lift setQueue_valid_inQ_queues_except_dequeue_wp
-                  threadGet_const_tcb_at)+
-  (* wp done *)
-  apply normalise_obj_at'
-  apply (clarsimp simp: correct_queue_def)
-  apply normalise_obj_at'
-  apply (fastforce simp add: valid_inQ_queues_except_def valid_inQ_queues_def elim: obj_at'_weaken)
-  done
-
-lemma tcbSchedDequeue_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues and tcb_at' t\<rbrace>
-   tcbSchedDequeue t
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (rule hoare_pre, rule tcbSchedDequeue_valid_inQ_queues_weak)
-  apply (fastforce simp: valid_inQ_queues_def obj_at'_def inQ_def)
-  done
-
-lemma threadSet_tcbSchedContext_update_valid_inQ_queues[wp]:
-  "threadSet (tcbSchedContext_update sc_opt) tcbPtr \<lbrace>valid_inQ_queues\<rbrace>"
-  apply (wpsimp wp: threadSet_wp)
-  apply (fastforce simp: valid_inQ_queues_def obj_at'_def inQ_def projectKOs objBitsKO_def)
-  done
-
-lemma threadSet_tcbInReleaseQueue_update_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues\<rbrace>
-   threadSet (tcbInReleaseQueue_update sc_opt) tcbPtr
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (wpsimp wp: threadSet_wp)
-  apply (fastforce simp: valid_inQ_queues_def obj_at'_def inQ_def projectKOs objBitsKO_def)
-  done
-
-crunch setReprogramTimer, setReleaseQueue, tcbReleaseRemove
-  for valid_inQ_queues[wp]: valid_inQ_queues
-  (simp: tcbReleaseRemove_def)
-
-lemma schedContextDonate_valid_inQ_queues:
-  "\<lbrace>valid_inQ_queues and valid_objs' and tcb_at' tcbPtr\<rbrace>
-   schedContextDonate scPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (clarsimp simp: schedContextDonate_def)
-  apply (rule bind_wp[OF _ get_sc_sp'], rename_tac sc)
-  apply (rule_tac Q'="\<lambda>_. ?pre" in bind_wp_fwd)
-   apply (rule hoare_when_cases, clarsimp)
-   apply (rule_tac Q'="\<lambda>_. ?pre" in bind_wp_fwd)
-    apply (wpsimp wp: tcbSchedDequeue_valid_inQ_queues)
-    apply (fastforce dest!: sc_ko_at_valid_objs_valid_sc'
-                      simp: valid_sched_context'_def)
-   apply (rule bind_wp_fwd_skip)
-    apply wpsimp
-   apply (rule bind_wp_fwd_skip)
-    apply (wpsimp wp: threadSet_valid_objs')
-    apply (fastforce simp: valid_tcb'_def tcb_cte_cases_def)
-   apply wpsimp+
-  done
-
-lemma replyPop_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues and valid_objs'\<rbrace>
-   replyPop replyPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (clarsimp simp: replyPop_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ get_reply_sp'])
-  apply (repeat_unless \<open>rule bind_wp[OF _ gts_sp']\<close>
-                       \<open>rule bind_wp_fwd_skip, solves wpsimp\<close>)
-  apply (rule_tac P'="?pre and tcb_at' tcbPtr and ko_at' reply replyPtr"
-         in hoare_weaken_pre[rotated])
-   apply fastforce
-  apply (rule bind_wp[OF _ assert_sp])
-  apply (rule bind_wp[OF _ assert_sp])
-  apply (case_tac "replyNext reply"; simp add: bind_assoc)
-   apply wpsimp
-  apply (rule bind_wp[OF _ assert_sp])
-  apply (rule hoare_gen_asm_conj)
-  apply (clarsimp simp: isHead_def split: reply_next.split_asm)
-  apply (rename_tac scp)
-  apply (rule bind_wp[OF _ get_sc_sp'])
-  apply (wpsimp wp: schedContextDonate_valid_inQ_queues replyUnlink_valid_objs')
-      apply (rule_tac Q'="\<lambda>_. valid_inQ_queues and valid_objs' and tcb_at' tcbPtr" in hoare_strengthen_post[rotated])
-       apply clarsimp
-      apply wpsimp
-     apply (wpsimp wp: updateReply_valid_objs')
-    apply (wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def)
-   apply (rule_tac Q'="\<lambda>_. valid_inQ_queues and valid_objs' and tcb_at' tcbPtr and
-                         (\<lambda>s. bound (replyPrev reply) \<longrightarrow>
-                              (\<forall>r. valid_reply' r s \<longrightarrow>
-                                   valid_reply' (replyNext_update (\<lambda>_. Some (Head scp)) r) s))"
-          in hoare_strengthen_post[rotated])
-    apply (clarsimp simp: valid_reply'_def)
-   apply wpsimp
-   apply (wpsimp wp: set_sc'.set_wp)
-  apply clarsimp
-  apply (frule (1) sc_ko_at_valid_objs_valid_sc'[rotated])
-  apply (frule (1) reply_ko_at_valid_objs_valid_reply'[rotated])
-  apply (clarsimp simp: valid_sched_context'_def valid_reply'_def)
-  apply (clarsimp simp: obj_at'_def projectKOs objBits_simps' ps_clear_upd
-                        valid_sched_context_size'_def)
-  done
+lemma cancelAllIPC_tcbDomain_obj_at':
+  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
+     cancelAllIPC epptr
+   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+apply (simp add: cancelAllIPC_def)
+apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
+          rescheduleRequired_oa_queued' cancelAllIPC_mapM_x_tcbDomain_obj_at'
+          getEndpoint_wp
+     | wpc
+     | simp)+
+done
 
-crunch replyRemove, replyClear
-  for valid_inQ_queues[wp]: valid_inQ_queues
-  (wp: crunch_wps simp: crunch_simps)
+lemma cancelAllSignals_tcbDomain_obj_at':
+  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
+     cancelAllSignals epptr
+   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+apply (simp add: cancelAllSignals_def)
+apply (wp hoare_vcg_conj_lift hoare_vcg_const_Ball_lift
+          rescheduleRequired_oa_queued' cancelAllIPC_mapM_x_tcbDomain_obj_at'
+          getNotification_wp
+     | wpc
+     | simp)+
+done
 
-lemma finaliseCapTrue_standin_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues and valid_objs'\<rbrace>
-   finaliseCapTrue_standin cap final
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  unfolding finaliseCapTrue_standin_def Let_def
-  by wpsimp
+lemma unbindMaybeNotification_tcbDomain_obj_at':
+  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>
+     unbindMaybeNotification r
+   \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding unbindMaybeNotification_def
+  by (wpsimp wp: getNotification_wp gbn_wp' simp: setBoundNotification_def)+
 
 crunch isFinalCapability
-  for valid_objs'[wp]: valid_objs'
-  (wp: crunch_wps simp: crunch_simps)
+  for sch_act[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
+  (simp: crunch_simps)
 
-lemma cteDeleteOne_valid_inQ_queues[wp]:
-  "\<lbrace>valid_inQ_queues and valid_objs'\<rbrace>
-   cteDeleteOne sl
-   \<lbrace>\<lambda>_. valid_inQ_queues\<rbrace>"
-  apply (simp add: cteDeleteOne_def unless_def)
-  apply (wpsimp wp: hoare_drop_imp hoare_vcg_all_lift hoare_vcg_if_lift2)
-  done
+crunch
+  isFinalCapability
+  for weak_sch_act[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
+  (simp: crunch_simps)
 
 crunch cteDeleteOne
-  for ksCurDomain[wp]:  "\<lambda>s. P (ksCurDomain s)"
-  and tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'"
+  for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
   (wp: crunch_wps simp: crunch_simps unless_def)
 
+lemma cteDeleteOne_tcbDomain_obj_at':
+  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace> cteDeleteOne slot \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  apply (simp add: cteDeleteOne_def unless_def split_def)
+  apply (wp emptySlot_tcbDomain cancelAllIPC_tcbDomain_obj_at' cancelAllSignals_tcbDomain_obj_at'
+          isFinalCapability_inv getCTE_wp
+          unbindMaybeNotification_tcbDomain_obj_at'
+     | rule hoare_drop_imp
+     | simp add: finaliseCapTrue_standin_def Let_def
+            split del: if_split
+     | wpc)+
+  apply (clarsimp simp: cte_wp_at'_def)
+  done
+
 end
 
 global_interpretation delete_one_conc_pre
-  by (unfold_locales, wp)
-     (wp cteDeleteOne_tcbDomain_obj_at' cteDeleteOne_typ_at' | simp)+
+  by (unfold_locales, wp) (wp cteDeleteOne_tcbDomain_obj_at' cteDeleteOne_typ_at' cteDeleteOne_reply_pred_tcb_at | simp)+
 
 lemma cteDeleteOne_invs[wp]:
-  "\<lbrace>invs' and sch_act_simple\<rbrace> cteDeleteOne ptr \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "\<lbrace>invs'\<rbrace> cteDeleteOne ptr \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cteDeleteOne_def unless_def
                    split_def finaliseCapTrue_standin_simple_def)
   apply wp
-     apply (rule hoare_strengthen_post)
-      apply (rule hoare_vcg_conj_lift)
-       apply (rule finaliseCap_True_invs')
-      apply (rule hoare_vcg_conj_lift)
-       apply (rule finaliseCap_replaceable[where slot=ptr])
-      apply (rule hoare_vcg_conj_lift)
-       apply (rule finaliseCap_cte_refs)
-      apply (rule finaliseCap_equal_cap[where sl=ptr])
-     apply (clarsimp simp: cte_wp_at_ctes_of)
-     apply (erule disjE)
-      apply simp
-     apply (clarsimp dest!: isCapDs simp: capRemovable_def)
-     apply (clarsimp simp: removeable'_def fun_eq_iff[where f="cte_refs' cap" for cap]
-                      del: disjCI)
-     apply (rule disjI2)
-     apply (rule conjI)
-      apply fastforce
-     apply (fastforce dest!: isCapDs simp: pred_tcb_at'_def obj_at'_def projectKOs ko_wp_at'_def)
-    apply (wp isFinalCapability_inv getCTE_wp' hoare_weak_lift_imp
-           | wp (once) isFinal[where x=ptr])+
+    apply (rule hoare_strengthen_post)
+     apply (rule hoare_vcg_conj_lift)
+      apply (rule finaliseCap_True_invs)
+     apply (rule hoare_vcg_conj_lift)
+      apply (rule finaliseCap_replaceable[where slot=ptr])
+     apply (rule hoare_vcg_conj_lift)
+      apply (rule finaliseCap_cte_refs)
+     apply (rule finaliseCap_equal_cap[where sl=ptr])
+    apply (clarsimp simp: cte_wp_at_ctes_of)
+    apply (erule disjE)
+     apply simp
+    apply (clarsimp dest!: isCapDs simp: capRemovable_def)
+    apply (clarsimp simp: removeable'_def fun_eq_iff[where f="cte_refs' cap" for cap]
+                     del: disjCI)
+    apply (rule disjI2)
+    apply (rule conjI)
+     subgoal by auto
+    subgoal by (auto dest!: isCapDs simp: pred_tcb_at'_def obj_at'_def projectKOs
+                                     ko_wp_at'_def)
+   apply (wp isFinalCapability_inv getCTE_wp' hoare_weak_lift_imp
+        | wp (once) isFinal[where x=ptr])+
   apply (fastforce simp: cte_wp_at_ctes_of)
   done
 
@@ -4153,114 +3169,51 @@ global_interpretation delete_one_conc_fr: delete_one_conc
 declare cteDeleteOne_invs[wp]
 
 lemma deletingIRQHandler_invs' [wp]:
-  "\<lbrace>invs' and sch_act_simple\<rbrace> deletingIRQHandler i \<lbrace>\<lambda>_. invs'\<rbrace>"
+  "\<lbrace>invs'\<rbrace> deletingIRQHandler i \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: deletingIRQHandler_def getSlotCap_def
                    getIRQSlot_def locateSlot_conv getInterruptState_def)
   apply (wp getCTE_wp')
   apply simp
   done
 
-crunch
-  unbindFromSC, schedContextUnbindReply, schedContextUnbindNtfn, schedContextUnbindAllTCBs
-  for sch_act_simple[wp]: sch_act_simple
-  (simp: crunch_simps wp: crunch_wps)
-
-lemma unbindFromSC_invs'[wp]:
-  "\<lbrace>invs' and sch_act_simple and tcb_at' t and K (t \<noteq> idle_thread_ptr)\<rbrace>
-   unbindFromSC t
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: unbindFromSC_def sym_refs_asrt_def)
-  apply (wpsimp split_del: if_split)
-     apply (rule_tac Q'="\<lambda>_. sc_at' y and invs' and sch_act_simple" in hoare_post_imp)
-      apply (fastforce simp: projectKOs valid_obj'_def valid_sched_context'_def
-                      dest!: ko_at_valid_objs')
-     apply (wpsimp wp: typ_at_lifts threadGet_wp)+
-  apply (drule obj_at_ko_at', clarsimp)
-  apply (frule ko_at_valid_objs'; clarsimp simp: valid_obj'_def valid_tcb'_def projectKOs)
-  apply (rule_tac x=ko in exI, clarsimp)
-  apply (frule sym_refs_tcbSchedContext; assumption?)
-  apply (subgoal_tac "ex_nonz_cap_to' idle_sc_ptr s")
-   apply (fastforce simp: invs'_def global'_sc_no_ex_cap)
-  apply (fastforce intro!: if_live_then_nonz_capE'
-                     simp: projectKOs obj_at'_def ko_wp_at'_def live_sc'_def)
-  done
-
-lemma schedContextSetInactive_invs'[wp]:
-  "schedContextSetInactive scPtr \<lbrace>invs'\<rbrace>"
-  apply (clarsimp simp: schedContextSetInactive_def updateSchedContext_def)
-  apply (rule bind_wp_fwd_skip)
-  apply (wpsimp wp: setSchedContext_invs' hoare_vcg_all_lift)
-   apply (fastforce dest: invs'_ko_at_valid_sched_context' intro!: if_live_then_nonz_capE'
-                    simp: ko_wp_at'_def obj_at'_def live_sc'_def projectKOs
-                          valid_sched_context'_def valid_sched_context_size'_def objBits_simps')
-  apply (wpsimp wp: setSchedContext_invs' hoare_vcg_all_lift hoare_vcg_imp_lift' )
-  apply (fastforce dest: invs'_ko_at_valid_sched_context' intro!: if_live_then_nonz_capE'
-                     simp: ko_wp_at'_def obj_at'_def live_sc'_def projectKOs
-                           valid_sched_context'_def valid_sched_context_size'_def objBits_simps')
-  done
-
-lemma schedContextUnbindYieldFrom_invs'[wp]:
-  "schedContextUnbindYieldFrom scPtr \<lbrace>invs'\<rbrace>"
-  apply (clarsimp simp: schedContextUnbindYieldFrom_def)
-  apply wpsimp
-  done
-
-lemma schedContextUnbindReply_invs'[wp]:
-  "schedContextUnbindReply scPtr \<lbrace>invs'\<rbrace>"
-  unfolding schedContextUnbindReply_def
-  apply (wpsimp wp: setSchedContext_invs' updateReply_replyNext_None_invs'
-                    hoare_vcg_imp_lift typ_at_lifts)
-  apply (clarsimp simp: invs'_def valid_pspace'_def sym_refs_asrt_def)
-  apply (frule (1) ko_at_valid_objs', clarsimp simp: projectKOs)
-  apply (frule (3) sym_refs_scReplies)
-  apply (intro conjI)
-     apply (fastforce simp: obj_at'_def opt_map_def projectKOs sym_heap_def split: option.splits)
-    apply (fastforce elim: if_live_then_nonz_capE'
-                     simp: ko_wp_at'_def obj_at'_def projectKOs live_sc'_def)
-   apply (auto simp: valid_obj'_def valid_sched_context'_def valid_sched_context_size'_def
-                     objBits_simps')
-  done
-
-lemma schedContextUnbindAllTCBs_invs'[wp]:
-  "\<lbrace>invs' and K (scPtr \<noteq> idle_sc_ptr)\<rbrace>
-   schedContextUnbindAllTCBs scPtr
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (clarsimp simp: schedContextUnbindAllTCBs_def)
-  by wpsimp
+crunch unbindNotification, unbindMaybeNotification
+  for tcb_at'[wp]: "tcb_at' t"
 
 lemma finaliseCap_invs:
   "\<lbrace>invs' and sch_act_simple and valid_cap' cap
-          and cte_wp_at' (\<lambda>cte. cteCap cte = cap) sl\<rbrace>
-   finaliseCap cap fin flag
+         and cte_wp_at' (\<lambda>cte. cteCap cte = cap) sl\<rbrace>
+     finaliseCap cap fin flag
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: finaliseCap_def Let_def
              cong: if_cong split del: if_split)
   apply (rule hoare_pre)
-   apply (wpsimp wp: hoare_vcg_all_lift)
-  apply (case_tac cap; clarsimp simp: isCap_simps)
-   apply (frule invs_valid_global', drule(1) valid_globals_cte_wpD'_idleThread)
-   apply (frule valid_capAligned, drule capAligned_capUntypedPtr)
-    apply clarsimp
-   apply (clarsimp dest!: simp: valid_cap'_def valid_idle'_def valid_idle'_asrt_def)
-  apply (subgoal_tac "ex_nonz_cap_to' (ksIdleThread s) s")
-   apply (fastforce simp: invs'_def global'_no_ex_cap)
-  apply (frule invs_valid_global', drule(1) valid_globals_cte_wpD'_idleSC)
-  apply (frule valid_capAligned, drule capAligned_capUntypedPtr)
-   apply clarsimp
+   apply (wp hoare_drop_imps hoare_vcg_all_lift | simp only: o_def | wpc)+
+
   apply clarsimp
+  apply (intro conjI impI)
+    apply (clarsimp dest!: isCapDs simp: valid_cap'_def)
+   apply (drule invs_valid_global', drule(1) valid_globals_cte_wpD')
+   apply (drule valid_capAligned, drule capAligned_capUntypedPtr)
+    apply (clarsimp dest!: isCapDs)
+   apply (clarsimp dest!: isCapDs)
+  apply (clarsimp dest!: isCapDs)
   done
 
 lemma finaliseCap_zombie_cap[wp]:
-  "finaliseCap cap fin flag \<lbrace>cte_wp_at' (\<lambda>cte. (P and isZombie) (cteCap cte)) sl\<rbrace>"
+  "\<lbrace>cte_wp_at' (\<lambda>cte. (P and isZombie) (cteCap cte)) sl\<rbrace>
+     finaliseCap cap fin flag
+   \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. (P and isZombie) (cteCap cte)) sl\<rbrace>"
   apply (simp add: finaliseCap_def Let_def
              cong: if_cong split del: if_split)
-  apply (wpsimp wp: suspend_cte_wp_at' deletingIRQHandler_cte_preserved
-              simp: finaliseCap_def isCap_simps)
+  apply (rule hoare_pre)
+   apply (wp suspend_cte_wp_at'
+             deletingIRQHandler_cte_preserved
+                 | clarsimp simp: finaliseCap_def isCap_simps | wpc)+
   done
 
 lemma finaliseCap_zombie_cap':
   "\<lbrace>cte_wp_at' (\<lambda>cte. (P and isZombie) (cteCap cte)) sl\<rbrace>
-   finaliseCap cap fin flag
+     finaliseCap cap fin flag
    \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) sl\<rbrace>"
   apply (rule hoare_strengthen_post)
    apply (rule finaliseCap_zombie_cap)
@@ -4268,22 +3221,26 @@ lemma finaliseCap_zombie_cap':
   done
 
 lemma finaliseCap_cte_cap_wp_to[wp]:
-  "finaliseCap cap fin flag \<lbrace>ex_cte_cap_wp_to' P sl\<rbrace>"
+  "\<lbrace>ex_cte_cap_wp_to' P sl\<rbrace> finaliseCap cap fin flag \<lbrace>\<lambda>rv. ex_cte_cap_wp_to' P sl\<rbrace>"
   apply (simp add: ex_cte_cap_to'_def)
   apply (rule hoare_pre, rule hoare_use_eq_irq_node' [OF finaliseCap_irq_node'])
    apply (simp add: finaliseCap_def Let_def
               cong: if_cong split del: if_split)
-   apply (wpsimp wp: suspend_cte_wp_at' deletingIRQHandler_cte_preserved
-                     hoare_vcg_ex_lift
-               simp: finaliseCap_def isCap_simps
-          | rule conjI)+
+   apply (wp suspend_cte_wp_at'
+             deletingIRQHandler_cte_preserved
+             hoare_vcg_ex_lift
+                 | clarsimp simp: finaliseCap_def isCap_simps
+                 | rule conjI
+                 | wpc)+
   apply fastforce
   done
 
-global_interpretation unbindNotification: typ_at_all_props' "unbindNotification tcb"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+context
+notes option.case_cong_weak[cong]
+begin
+crunch unbindNotification
+  for valid_cap'[wp]: "valid_cap' cap"
+end
 
 lemma finaliseCap_valid_cap[wp]:
   "\<lbrace>valid_cap' cap\<rbrace> finaliseCap cap final flag \<lbrace>\<lambda>rv. valid_cap' (fst rv)\<rbrace>"
@@ -4291,15 +3248,30 @@ lemma finaliseCap_valid_cap[wp]:
                    getThreadCSpaceRoot
                    ARM_H.finaliseCap_def
              cong: if_cong split del: if_split)
-  apply wpsimp
-  by (auto simp: valid_cap'_def isCap_simps capAligned_def objBits_simps shiftL_nat)
+  apply (rule hoare_pre)
+   apply (wp | simp only: valid_NullCap o_def fst_conv | wpc)+
+  apply simp
+  apply (intro conjI impI)
+   apply (clarsimp simp: valid_cap'_def isCap_simps capAligned_def
+                         objBits_simps shiftL_nat)+
+  done
+
+
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 crunch "Arch.finaliseCap"
   for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
   (wp: crunch_wps getObject_inv simp: loadObject_default_def updateObject_default_def)
 
+crunch finaliseCap
+  for sch_act_simple[wp]: sch_act_simple
+  (simp: crunch_simps
+   rule: sch_act_simple_lift
+   wp: getObject_inv loadObject_default_inv crunch_wps)
+
 end
 
+
 lemma interrupt_cap_null_or_ntfn:
   "invs s
     \<Longrightarrow> cte_wp_at (\<lambda>cp. is_ntfn_cap cp \<or> cp = cap.NullCap) (interrupt_irq_node s irq, []) s"
@@ -4320,9 +3292,7 @@ lemma interrupt_cap_null_or_ntfn:
   done
 
 lemma (in delete_one) deletingIRQHandler_corres:
-  "corres dc
-          (einvs and simple_sched_action and current_time_bounded)
-          invs'
+  "corres dc (einvs) (invs')
           (deleting_irq_handler irq) (deletingIRQHandler irq)"
   apply (simp add: deleting_irq_handler_def deletingIRQHandler_def)
   apply (rule corres_guard_imp)
@@ -4331,7 +3301,7 @@ lemma (in delete_one) deletingIRQHandler_corres:
       apply (rule_tac P'="cte_at' (cte_map slot)" in corres_symb_exec_r_conj)
          apply (rule_tac F="isNotificationCap rv \<or> rv = capability.NullCap"
              and P="cte_wp_at (\<lambda>cp. is_ntfn_cap cp \<or> cp = cap.NullCap) slot
-                 and einvs and simple_sched_action and current_time_bounded"
+                 and einvs"
              and P'="invs' and cte_wp_at' (\<lambda>cte. cteCap cte = rv)
                  (cte_map slot)" in corres_req)
           apply (clarsimp simp: cte_wp_at_caps_of_state state_relation_def)
@@ -4349,7 +3319,7 @@ lemma (in delete_one) deletingIRQHandler_corres:
   apply (clarsimp simp: cte_wp_at_ctes_of)
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma arch_finaliseCap_corres:
   "\<lbrakk> final_matters' (ArchObjectCap cap') \<Longrightarrow> final = final'; acap_relation cap cap' \<rbrakk>
@@ -4363,7 +3333,6 @@ lemma arch_finaliseCap_corres:
                  (final_matters' (ArchObjectCap cap') \<longrightarrow>
                       final' = isFinal (ArchObjectCap cap') (cte_map sl) (cteCaps_of s)))
            (arch_finalise_cap cap final) (Arch.finaliseCap cap' final')"
-  apply add_cur_tcb'
   apply (cases cap;
         clarsimp simp: arch_finalise_cap_def ARM_H.finaliseCap_def
                        final_matters'_def case_bool_If liftM_def[symmetric]
@@ -4379,296 +3348,129 @@ lemma arch_finaliseCap_corres:
       apply simp
      apply (clarsimp simp: valid_cap_def valid_unmap_def)
      apply (auto simp: vmsz_aligned_def pbfs_atleast_pageBits mask_def
-                 elim: is_aligned_weaken)[2]
+                 elim: is_aligned_weaken invs_valid_asid_map)[2]
    apply (rule corres_guard_imp, rule unmapPageTable_corres)
     apply (auto simp: valid_cap_def valid_cap'_def mask_def
-               elim!: is_aligned_weaken)[2]
+               elim!: is_aligned_weaken invs_valid_asid_map)[2]
   apply (rule corres_guard_imp, rule deleteASID_corres)
-   apply (auto simp: mask_def valid_cap_def)[2]
+   apply (auto elim!: invs_valid_asid_map simp: mask_def valid_cap_def)[2]
   done
 
 lemma unbindNotification_corres:
   "corres dc
-     (invs and tcb_at t)
-     invs'
-     (unbind_notification t)
-     (unbindNotification t)"
-  supply option.case_cong_weak[cong]
+      (invs and tcb_at t)
+      invs'
+      (unbind_notification t)
+      (unbindNotification t)"
   apply (simp add: unbind_notification_def unbindNotification_def)
-  apply (rule corres_cross[where Q' = "tcb_at' t", OF tcb_at'_cross_rel])
-   apply (simp add: invs_psp_aligned invs_distinct)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getBoundNotification_corres])
-      apply (simp add: maybeM_def)
       apply (rule corres_option_split)
         apply simp
        apply (rule corres_return_trivial)
-      apply (simp add: update_sk_obj_ref_def bind_assoc)
       apply (rule corres_split[OF getNotification_corres])
+        apply clarsimp
         apply (rule corres_split[OF setNotification_corres])
-           apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
+           apply (clarsimp simp: ntfn_relation_def split:Structures_A.ntfn.splits)
           apply (rule setBoundNotification_corres)
-         apply (wpsimp wp: gbn_wp' gbn_wp get_ntfn_ko' simp: obj_at_def split: option.split)+
-   apply (frule invs_valid_objs)
-   apply (clarsimp simp: is_tcb)
-   apply (frule_tac thread=t and y=tcb in valid_tcb_objs)
-    apply (simp add: get_tcb_rev)
-   apply (clarsimp simp: valid_tcb_def)
-   apply (metis obj_at_simps(1) valid_bound_obj_Some)
+         apply (wp gbn_wp' gbn_wp)+
+   apply (clarsimp elim!: obj_at_valid_objsE
+                   dest!: bound_tcb_at_state_refs_ofD invs_valid_objs
+                    simp: valid_obj_def is_tcb tcb_ntfn_is_bound_def obj_at_def
+                          valid_tcb_def valid_bound_ntfn_def invs_psp_aligned invs_distinct
+                   split: option.splits)
   apply (clarsimp dest!: obj_at_valid_objs' bound_tcb_at_state_refs_ofD' invs_valid_objs'
-                   simp: projectKOs valid_obj'_def valid_tcb'_def valid_bound_ntfn'_def
+                   simp: valid_obj'_def valid_tcb'_def valid_bound_ntfn'_def tcb_ntfn_is_bound'_def
+                         projectKOs
                   split: option.splits)
   done
 
 lemma unbindMaybeNotification_corres:
   "corres dc
-      (invs and ntfn_at ntfnptr)
-      invs'
+      (invs and ntfn_at ntfnptr) (invs' and ntfn_at' ntfnptr)
       (unbind_maybe_notification ntfnptr)
       (unbindMaybeNotification ntfnptr)"
   apply (simp add: unbind_maybe_notification_def unbindMaybeNotification_def)
-  apply (rule corres_cross[where Q' = "ntfn_at' ntfnptr", OF ntfn_at'_cross_rel])
-   apply (simp add: invs_psp_aligned invs_distinct)
   apply (rule corres_guard_imp)
-    apply (clarsimp simp: maybeM_def get_sk_obj_ref_def)
     apply (rule corres_split[OF getNotification_corres])
-      apply (rename_tac ntfnA ntfnH)
       apply (rule corres_option_split)
-        apply (simp add: ntfn_relation_def)
+        apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
        apply (rule corres_return_trivial)
-      apply (rename_tac tcbPtr)
-      apply (simp add: bind_assoc)
-      apply (rule corres_split)
-         apply (simp add: update_sk_obj_ref_def)
-         apply (rule_tac P="ko_at (Notification ntfnA) ntfnptr" in corres_symb_exec_l)
-            apply (rename_tac ntfnA')
-            apply (rule_tac F="ntfnA = ntfnA'" in corres_gen_asm)
-            apply (rule setNotification_corres)
-            apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
-           apply (wpsimp simp: obj_at_def is_ntfn wp: get_simple_ko_wp getNotification_wp)+
+      apply (rule corres_split[OF setNotification_corres])
+         apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
         apply (rule setBoundNotification_corres)
-       apply (wpsimp simp: obj_at_def is_ntfn wp: get_simple_ko_wp getNotification_wp)+
-   apply (frule invs_valid_objs)
-   apply (erule (1) pspace_valid_objsE)
-   apply (clarsimp simp: valid_obj_def valid_ntfn_def obj_at_def split: option.splits)
-  apply clarsimp
-  apply (frule invs_valid_objs')
-  apply (frule (1) ko_at_valid_objs'_pre)
-  apply (clarsimp simp: valid_obj'_def valid_ntfn'_def split: option.splits)
-  done
-
-lemma schedContextUnbindNtfn_corres:
-  "corres dc
-     (invs and sc_at sc)
-     invs'
-     (sched_context_unbind_ntfn sc)
-     (schedContextUnbindNtfn sc)"
-  apply (simp add: sched_context_unbind_ntfn_def schedContextUnbindNtfn_def)
-  apply (clarsimp simp: maybeM_def get_sk_obj_ref_def liftM_def)
-  apply (rule corres_cross[where Q' = "sc_at' sc", OF sc_at'_cross_rel])
-   apply (simp add: invs_psp_aligned invs_distinct)
-  apply add_sym_refs
-  apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-   apply (simp add: get_sc_obj_ref_def)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF get_sc_corres])
-       apply (rule corres_option_split)
-         apply (simp add: sc_relation_def)
-        apply (rule corres_return_trivial)
-       apply (simp add: update_sk_obj_ref_def bind_assoc)
-       apply (rule corres_split[OF getNotification_corres])
-         apply (rule corres_split[OF setNotification_corres])
-            apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
-           apply (rule_tac f'="scNtfn_update (\<lambda>_. None)"
-                    in update_sc_no_reply_stack_update_ko_at'_corres)
-              apply (clarsimp simp: sc_relation_def objBits_def objBitsKO_def)+
-          apply wpsimp+
-    apply (frule invs_valid_objs)
-    apply (frule (1) valid_objs_ko_at)
-    apply (clarsimp simp: invs_psp_aligned valid_obj_def valid_sched_context_def
+       apply (wp get_simple_ko_wp getNotification_wp)+
+   apply (clarsimp elim!: obj_at_valid_objsE
+                   dest!: bound_tcb_at_state_refs_ofD invs_valid_objs
+                    simp: valid_obj_def is_tcb tcb_ntfn_is_bound_def invs_psp_aligned invs_distinct
+                          valid_tcb_def valid_bound_ntfn_def valid_ntfn_def
                    split: option.splits)
-   apply (clarsimp split: option.splits)
-   apply (frule (1) scNtfn_sym_refsD[OF ko_at_obj_at', simplified])
-     apply clarsimp+
-  apply normalise_obj_at'
-  apply (clarsimp simp: sym_refs_asrt_def)
-  done
-
-lemma sched_context_maybe_unbind_ntfn_corres:
-  "corres dc
-     (invs and ntfn_at ntfn_ptr)
-     invs'
-     (sched_context_maybe_unbind_ntfn ntfn_ptr)
-     (schedContextMaybeUnbindNtfn ntfn_ptr)"
-  apply (clarsimp simp: sched_context_maybe_unbind_ntfn_def schedContextMaybeUnbindNtfn_def)
-  apply (clarsimp simp: maybeM_def get_sk_obj_ref_def liftM_def)
-  apply (rule corres_cross[where Q' = "ntfn_at' ntfn_ptr", OF ntfn_at'_cross_rel])
-   apply (simp add: invs_psp_aligned invs_distinct)
-  apply add_sym_refs
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getNotification_corres])
-      apply (rename_tac ntfnA ntfnH)
-      apply (rule corres_option_split)
-        apply (simp add: ntfn_relation_def)
-       apply (rule corres_return_trivial)
-      apply (rename_tac scAPtr)
-      apply (clarsimp simp: schedContextUnbindNtfn_def update_sk_obj_ref_def bind_assoc)
-      apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-       apply (rule_tac P="invs and ko_at (Notification ntfnA) ntfn_ptr"
-                and P'="invs' and ko_at' ntfnH ntfn_ptr and (\<lambda>s. sym_refs (state_refs_of' s))"
-                and Q'1=\<top>
-                in corres_symb_exec_r'[THEN corres_guard_imp])
-            apply (rule_tac F="scNtfn rv = Some ntfn_ptr" in corres_gen_asm2)
-            apply clarsimp
-            apply (rule corres_split[OF getNotification_corres])
-              apply (rule corres_split[OF setNotification_corres])
-                 apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
-                apply (rule_tac f'="scNtfn_update (\<lambda>_. None)"
-                         in update_sc_no_reply_stack_update_ko_at'_corres)
-                   apply (clarsimp simp: sc_relation_def objBits_def objBitsKO_def)+
-               apply wpsimp+
-        apply (frule invs_valid_objs)
-        apply (frule (1) valid_objs_ko_at)
-        apply (clarsimp simp: invs_psp_aligned valid_obj_def valid_ntfn_def obj_at_def is_ntfn_def)
-       apply (clarsimp simp: valid_ntfn'_def ntfn_relation_def split: option.splits)
-       apply (drule_tac s="Some scAPtr" in sym)
-       apply (clarsimp simp: valid_ntfn'_def ntfn_relation_def sym_refs_asrt_def)
-       apply (frule (1) ntfnSc_sym_refsD[OF ko_at_obj_at', simplified])
-        apply clarsimp+
-       apply normalise_obj_at'
-      apply (clarsimp simp: sym_refs_asrt_def)
-     apply (wpsimp wp: get_simple_ko_wp getNotification_wp split: option.splits)+
-  done
-
-lemma replyClear_corres:
-  "corres dc
-          (invs and valid_ready_qs and st_tcb_at is_reply_state tp
-           and active_scs_valid and weak_valid_sched_action)
-          (invs' and st_tcb_at' (\<lambda>st. replyObject st = Some rptr) tp)
-          (do
-             state \<leftarrow> get_thread_state tp;
-             case state of
-                 Structures_A.thread_state.BlockedOnReply r \<Rightarrow> reply_remove tp r
-               | _ \<Rightarrow> cancel_ipc tp
-           od)
-          (replyClear rptr tp)"
-  apply (clarsimp simp: replyClear_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getThreadState_corres])
-      apply (rename_tac st st')
-      apply (rule_tac R="is_blocked_on_receive st" in corres_cases_lhs;
-             clarsimp simp: thread_state_relation_def is_blocked_thread_state_defs)
-       apply (rule cancel_ipc_corres)
-      apply (rule_tac R="is_blocked_on_reply st" in corres_cases_lhs;
-             clarsimp simp: is_blocked_thread_state_defs)
-       apply (wpfix add: Structures_H.thread_state.sel)
-       apply (rule corres_guard_imp)
-         apply (rule_tac st="Structures_A.BlockedOnReply reply"
-                     and st'="BlockedOnReply (Some reply)"
-               in replyRemove_corres)
-          apply simp
-         apply simp
-        apply simp
-       apply simp
-      apply (rule corres_False'[where P'=\<top>])
-     apply (wpsimp wp: gts_wp gts_wp')+
-   apply (clarsimp simp: pred_tcb_at_def obj_at_def is_obj_defs invs_def valid_pspace_def valid_state_def)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def invs'_def valid_pspace'_def opt_map_Some_eta_fold)
+  apply (clarsimp dest!: obj_at_valid_objs' bound_tcb_at_state_refs_ofD' invs_valid_objs'
+                   simp: valid_obj'_def valid_tcb'_def valid_bound_ntfn'_def
+                         tcb_ntfn_is_bound'_def valid_ntfn'_def
+                  split: option.splits)
   done
 
 lemma fast_finaliseCap_corres:
   "\<lbrakk> final_matters' cap' \<longrightarrow> final = final'; cap_relation cap cap';
      can_fast_finalise cap \<rbrakk>
    \<Longrightarrow> corres dc
-           (\<lambda>s. invs s \<and> valid_sched s \<and> s \<turnstile> cap \<and> current_time_bounded s
+           (\<lambda>s. invs s \<and> valid_sched s \<and> s \<turnstile> cap
                        \<and> cte_wp_at ((=) cap) sl s)
            (\<lambda>s. invs' s \<and> s \<turnstile>' cap')
            (fast_finalise cap final)
-           (finaliseCap cap' final' True)"
-  apply add_sch_act_wf
-  apply (cases cap, simp_all add: finaliseCap_def isCap_simps final_matters'_def
+           (do
+               p \<leftarrow> finaliseCap cap' final' True;
+               assert (capRemovable (fst p) (cte_map ptr) \<and> snd p = NullCap)
+            od)"
+  apply (cases cap, simp_all add: finaliseCap_def isCap_simps
                                   corres_liftM2_simp[unfolded liftM_def]
                                   o_def dc_def[symmetric] when_def
                                   can_fast_finalise_def capRemovable_def
                        split del: if_split cong: if_cong)
-    (* EndpointCap *)
-    apply clarsimp
-    apply (rule corres_stateAssert_assume; (simp add: sch_act_wf_asrt_def)?)
-    apply (rule corres_guard_imp)
-      apply (rule cancelAllIPC_corres)
-     apply (simp add: valid_cap_def)
-    apply (simp add: valid_cap'_def)
-   (* NotificationCap *)
-   apply clarsimp
-   apply (rule corres_stateAssert_assume; (simp add: sch_act_wf_asrt_def)?)
+   apply (clarsimp simp: final_matters'_def)
    apply (rule corres_guard_imp)
-     apply (rule corres_split[OF sched_context_maybe_unbind_ntfn_corres])
-       apply (rule corres_split[OF unbindMaybeNotification_corres])
-         apply (rule cancelAllSignals_corres)
-        apply (wpsimp wp: unbind_maybe_notification_invs abs_typ_at_lifts typ_at_lifts)+
-    apply (clarsimp simp: valid_cap_def)
-   apply (clarsimp simp: valid_cap'_def)
-  (* ReplyCap *)
-  apply clarsimp
-  apply (rename_tac rptr rs)
-  apply (add_sym_refs, add_valid_replies rptr simp: valid_cap_def, add_sch_act_wf)
-  apply (rule corres_stateAssert_assume; (simp add: sym_refs_asrt_def)?)
-  apply (rule corres_stateAssert_assume; simp?)
-  apply (rule corres_stateAssert_assume; (simp add: sch_act_wf_asrt_def)?)
+     apply (rule corres_rel_imp)
+      apply (rule ep_cancel_corres)
+     apply simp
+    apply (simp add: valid_cap_def)
+   apply (simp add: valid_cap'_def)
+  apply (clarsimp simp: final_matters'_def)
   apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getReply_TCB_corres])
-      apply (simp split del: if_split)
-      apply (rule_tac R="tptrOpt = None" in corres_cases';
-             clarsimp simp del: corres_return)
-       apply (rule corres_return_trivial)
-      apply wpfix
-      apply (rule replyClear_corres)
-     apply (wpsimp wp: get_simple_ko_wp)+
-   apply (clarsimp simp: valid_cap_def valid_sched_valid_ready_qs)
-   apply (drule reply_tcb_state_refs;
-          fastforce simp: pred_tcb_at_def obj_at_def is_blocked_thread_state_defs
-                    elim: reply_object.elims)
-  apply (clarsimp simp: valid_cap'_def)
-  apply (rule pred_tcb'_weakenE, erule sym_ref_replyTCB_Receive_or_Reply; fastforce)
-  done
-
-lemma finaliseCap_true_removable[wp]:
-  "\<lbrace>\<top>\<rbrace>
-   finaliseCap cap final True
-   \<lbrace>\<lambda>rv s. capRemovable (fst rv) (cte_map slot) \<and> snd rv = capability.NullCap\<rbrace>"
-  by (cases cap; wpsimp simp: finaliseCap_def isCap_simps capRemovable_def)
+    apply (rule corres_split[OF unbindMaybeNotification_corres])
+         apply (rule cancelAllSignals_corres)
+       apply (wp abs_typ_at_lifts unbind_maybe_notification_invs typ_at_lifts hoare_drop_imps getNotification_wp
+            | wpc)+
+   apply (clarsimp simp: valid_cap_def)
+  apply (clarsimp simp: valid_cap'_def projectKOs valid_obj'_def
+                 dest!: invs_valid_objs' obj_at_valid_objs' )
+  done
 
 lemma cap_delete_one_corres:
-  "corres dc
-        (einvs and simple_sched_action and cte_wp_at can_fast_finalise slot
-         and current_time_bounded)
-        (invs' and cte_at' (cte_map slot))
-        (cap_delete_one slot) (cteDeleteOne (cte_map slot))"
+  "corres dc (einvs and cte_wp_at can_fast_finalise ptr)
+        (invs' and cte_at' (cte_map ptr))
+        (cap_delete_one ptr) (cteDeleteOne (cte_map ptr))"
   apply (simp add: cap_delete_one_def cteDeleteOne_def'
                    unless_def when_def)
-  apply (rule corres_cross[OF sch_act_simple_cross_rel], clarsimp)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF get_cap_corres])
       apply (rule_tac F="can_fast_finalise cap" in corres_gen_asm)
       apply (rule corres_if)
         apply fastforce
-       apply (rule corres_split[OF isFinalCapability_corres[where ptr=slot]])
-         apply (rule corres_split)
-            apply (rule fast_finaliseCap_corres[where sl=slot]; clarsimp)
-           apply clarsimp
-           apply wpfix
-           apply (rule corres_assert_assume_r)
-           apply (rule emptySlot_corres)
-           apply (wpsimp wp: hoare_drop_imps fast_finalise_invs fast_finalise_valid_sched)+
-       apply (wp isFinalCapability_inv)
+       apply (rule corres_split[OF isFinalCapability_corres[where ptr=ptr]])
+         apply (simp add: split_def bind_assoc [THEN sym])
+         apply (rule corres_split[OF fast_finaliseCap_corres[where sl=ptr]])
+              apply simp+
+           apply (rule emptySlot_corres, simp)
+          apply (wp hoare_drop_imps)+
+       apply (wp isFinalCapability_inv | wp (once) isFinal[where x="cte_map ptr"])+
       apply (rule corres_trivial, simp)
      apply (wp get_cap_wp getCTE_wp)+
-   apply (fastforce simp: cte_wp_at_caps_of_state can_fast_finalise_Null
-                simp del: split_paired_Ex
-                   elim!: caps_of_state_valid_cap)
-  apply (fastforce simp: cte_wp_at_ctes_of)
+   apply (clarsimp simp: cte_wp_at_caps_of_state can_fast_finalise_Null
+                  elim!: caps_of_state_valid_cap)
+  apply (clarsimp simp: cte_wp_at_ctes_of)
+  apply fastforce
   done
-
 end
 (* FIXME: strengthen locale instead *)
 
@@ -4679,335 +3481,61 @@ global_interpretation delete_one
    apply auto
   done
 
-lemma schedContextUnbindTCB_corres:
-  "corres dc (invs and valid_sched and sc_tcb_sc_at bound sc_ptr)
-             (invs' and obj_at' (\<lambda>sc. bound (scTCB sc)) sc_ptr)
-          (sched_context_unbind_tcb sc_ptr) (schedContextUnbindTCB sc_ptr)"
-  apply (clarsimp simp: sched_context_unbind_tcb_def schedContextUnbindTCB_def
-                        sym_refs_asrt_def valid_idle'_asrt_def cur_tcb'_asrt_def)
-  apply add_sym_refs
-  apply add_valid_idle'
-  apply add_cur_tcb'
-  apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-   apply (rule corres_stateAssert_add_assertion[rotated], simp)+
-  apply (rule corres_guard_imp)
-     apply (rule corres_split[OF get_sc_corres])
-       apply (rename_tac sc sc')
-       apply (rule corres_assert_opt_assume_l)
-       apply (rule corres_assert_assume_r)
-       apply (prop_tac "scTCB sc' = sc_tcb sc"; clarsimp)
-        apply (clarsimp simp: sc_relation_def)
-       apply (rule corres_split[OF getCurThread_corres])
-         apply (rule corres_split[OF corres_when], clarsimp simp: sc_relation_def)
-            apply (rule rescheduleRequired_corres)
-           apply (rule corres_split[OF tcbSchedDequeue_corres])
-             apply (rule corres_split[OF tcbReleaseRemove_corres])
-             apply (clarsimp simp: sc_relation_def)
-               apply (rule corres_split[OF set_tcb_obj_ref_corres];
-                      clarsimp simp: tcb_relation_def)
-                 apply (rule_tac sc'=sc' in update_sc_no_reply_stack_update_ko_at'_corres)
-                    apply (clarsimp simp: sc_relation_def objBits_def objBitsKO_def)+
-                apply wpsimp+
-       apply (case_tac sc'; clarsimp)
-       apply (wpfix add: sched_context.sel)
-       apply simp
-      apply wpsimp+
-    apply (frule invs_valid_objs)
-    apply (fastforce simp: sc_at_pred_n_def obj_at_def is_obj_defs valid_obj_def
-                           valid_sched_context_def)
-   apply normalise_obj_at'
-   apply (fastforce simp: valid_obj'_def valid_sched_context'_def projectKOs
-                   dest!: ko_at_valid_objs')
-  apply clarsimp
-  done
-
-lemma unbindFromSC_corres:
-  "corres dc (einvs and tcb_at t and K (t \<noteq> idle_thread_ptr)) (invs' and tcb_at' t)
-          (unbind_from_sc t) (unbindFromSC t)"
-  apply (clarsimp simp: unbind_from_sc_def unbindFromSC_def maybeM_when)
-  apply (rule corres_gen_asm)
-  apply add_sym_refs
-  apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF get_tcb_obj_ref_corres[where r="(=)"]])
-        apply (clarsimp simp: tcb_relation_def)
-       apply (rename_tac sc_ptr_opt sc_ptr_opt')
-       apply clarsimp
-       apply (rule_tac R="bound sc_ptr_opt'" in corres_cases'; clarsimp)
-       apply wpfix
-       apply (rule corres_split[OF schedContextUnbindTCB_corres])
-         apply (rule corres_split[OF get_sc_corres])
-           apply (rule corres_when2; clarsimp simp: sc_relation_def)
-           apply (case_tac rv, case_tac rv', simp)
-           apply (wpfix add: Structures_A.sched_context.select_convs sched_context.sel)
-           apply (rule schedContextCompleteYieldTo_corres)
-          apply (wpsimp wp: abs_typ_at_lifts)+
-        apply (rule_tac Q'="\<lambda>_. invs" in hoare_post_imp)
-         apply (auto simp: valid_obj_def valid_sched_context_def
-                    dest!: invs_valid_objs valid_objs_ko_at)[1]
-        apply wpsimp
-       apply (rule_tac Q'="\<lambda>_. sc_at' y and invs'" in hoare_post_imp)
-        apply (fastforce simp: projectKOs valid_obj'_def valid_sched_context'_def
-                        dest!: ko_at_valid_objs')
-       apply (wpsimp wp: typ_at_lifts get_tcb_obj_ref_wp threadGet_wp)+
-    apply (frule invs_valid_objs, frule invs_sym_refs, frule invs_valid_global_refs)
-    apply (frule sym_ref_tcb_sc; (fastforce simp: obj_at_def)?)
-    apply (frule (1) valid_objs_ko_at)
-    apply (subgoal_tac "ex_nonz_cap_to y s")
-     apply (fastforce dest!: idle_sc_no_ex_cap
-                       simp: obj_at_def sc_at_pred_n_def valid_obj_def valid_tcb_def)
-    apply (fastforce elim!: if_live_then_nonz_cap_invs simp: live_def live_sc_def)
-   apply clarsimp
-   apply (drule obj_at_ko_at', clarsimp)
-   apply (rule_tac x=ko in exI, clarsimp)
-   apply (frule sym_refs_tcbSchedContext; assumption?)
-   apply (subgoal_tac "ex_nonz_cap_to' y s")
-    apply (fastforce simp: invs'_def obj_at'_def global'_sc_no_ex_cap)
-   apply (fastforce intro!: if_live_then_nonz_capE'
-                      simp: projectKOs obj_at'_def ko_wp_at'_def live_sc'_def)
-  apply (clarsimp simp: sym_refs_asrt_def)
-  done
-
-lemma schedContextUnbindAllTCBs_corres:
-  "corres dc (einvs and sc_at scPtr and K (scPtr \<noteq> idle_sc_ptr)) (invs' and sc_at' scPtr)
-          (sched_context_unbind_all_tcbs scPtr) (schedContextUnbindAllTCBs scPtr)"
-  apply (clarsimp simp: sched_context_unbind_all_tcbs_def schedContextUnbindAllTCBs_def)
-  apply (rule corres_gen_asm, clarsimp)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_sc_corres])
-      apply (rule corres_when)
-       apply (clarsimp simp: sc_relation_def)
-      apply (rule schedContextUnbindTCB_corres)
-     apply wpsimp+
-   apply (clarsimp simp: sc_at_pred_n_def obj_at_def)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma replyNext_update_corres_empty:
-  "corres dc (reply_at rptr) (reply_at' rptr)
-   (set_reply_obj_ref reply_sc_update rptr None)
-   (updateReply rptr (\<lambda>reply. replyNext_update (\<lambda>_. None) reply))"
-  unfolding update_sk_obj_ref_def updateReply_def
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_reply_corres set_reply_corres])
-      apply (clarsimp simp: reply_relation_def)
-     apply wpsimp+
-  apply (clarsimp simp: obj_at'_def replyPrev_same_def)
-  done
-
-lemma schedContextUnbindReply_corres:
-  "corres dc (einvs and sc_at scPtr and K (scPtr \<noteq> idle_sc_ptr)) (invs' and sc_at' scPtr)
-             (sched_context_unbind_reply scPtr) (schedContextUnbindReply scPtr)"
-  apply (clarsimp simp: sched_context_unbind_reply_def schedContextUnbindReply_def
-                        liftM_def unless_def)
-  apply add_sym_refs
-  apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF get_sc_corres, where R'="\<lambda>sc. ko_at' sc scPtr"])
-       apply (rename_tac sc sc')
-       apply (rule_tac Q'="ko_at' sc' scPtr
-                and K (scReply sc' = hd_opt (sc_replies sc))
-                and (\<lambda>s. scReply sc' \<noteq> None \<longrightarrow> reply_at' (the (scReply sc')) s)
-                and (\<lambda>s. heap_ls (replyPrevs_of s) (scReply sc') (sc_replies sc))"
-              and Q="sc_at scPtr
-                and pspace_aligned and pspace_distinct and valid_objs
-                and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext sc n) scPtr s)"
-              in stronger_corres_guard_imp)
-         apply (rule corres_guard_imp)
-           apply (rule_tac F="(sc_replies sc \<noteq> []) = (\<exists>y. scReply sc' = Some y)" in corres_gen_asm2)
-           apply (rule corres_when)
-            apply clarsimp
-           apply (rule_tac F="scReply sc' = Some (hd (sc_replies sc))" in corres_gen_asm2)
-           apply clarsimp
-           apply (rule corres_split[OF replyNext_update_corres_empty])
-             apply (rule update_sc_reply_stack_update_ko_at'_corres)
-            apply wpsimp+
-          apply (clarsimp simp: obj_at_def)
-          apply (frule (1) valid_sched_context_objsI)
-          apply (clarsimp simp: valid_sched_context_def list_all_def obj_at_def)
-         apply clarsimp
-         apply (case_tac "sc_replies sc"; simp)
-        apply assumption
-       apply (clarsimp simp: obj_at_def)
-       apply (frule state_relation_sc_replies_relation)
-       apply (subgoal_tac "scReply sc' = hd_opt (sc_replies sc)")
-        apply (intro conjI)
-          apply clarsimp
-         apply clarsimp
-         apply (erule (1) reply_at_cross[rotated])
-          apply (frule (1) valid_sched_context_objsI)
-          apply (clarsimp simp: valid_sched_context_def list_all_def obj_at_def)
-         apply fastforce
-        apply (erule (1) sc_replies_relation_prevs_list)
-        apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKO_sc)
-       apply (frule state_relation_sc_replies_relation)
-       apply (frule sc_replies_relation_scReplies_of[symmetric])
-         apply (fastforce simp: obj_at_def is_sc_obj_def obj_at'_def)
-        apply (fastforce simp: obj_at'_def projectKOs opt_map_def)
-       apply (fastforce simp: obj_at'_real_def opt_map_def ko_wp_at'_def sc_replies_of_scs_def
-                              map_project_def scs_of_kh_def)
-      apply wpsimp+
-    apply (fastforce simp: sym_refs_asrt_def)+
-  done
-
-lemma schedContextUnbindYieldFrom_corres:
-  "corres dc (einvs and sc_at scPtr and K (scPtr \<noteq> idle_sc_ptr)) (invs' and sc_at' scPtr)
-          (sched_context_unbind_yield_from scPtr) (schedContextUnbindYieldFrom scPtr)"
-  apply (clarsimp simp: sched_context_unbind_yield_from_def schedContextUnbindYieldFrom_def
-                        maybeM_when)
-  apply add_sym_refs
-  apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF get_sc_corres])
-       apply (rename_tac sc sc')
-       apply (case_tac sc')
-       apply (clarsimp simp: sc_relation_def)
-       apply (wpfix add: sched_context.sel)
-       apply (rule corres_when)
-        apply (clarsimp simp: sc_relation_def)
-       apply (rule schedContextCompleteYieldTo_corres)
-      apply wpsimp+
-    apply (fastforce dest!: invs_valid_objs valid_objs_ko_at
-                      simp: valid_obj_def valid_sched_context_def)
-   apply (fastforce dest!: sc_ko_at_valid_objs_valid_sc'
-                     simp: valid_obj'_def valid_sched_context'_def)
-  apply (clarsimp simp: sym_refs_asrt_def)
-  done
-
-lemma schedContextSetInactive_corres:
-  "corres dc (\<lambda>s. sc_at scPtr s) (sc_at' scPtr)
-     (sched_context_set_inactive scPtr) (schedContextSetInactive scPtr)"
-  apply (clarsimp simp: sched_context_set_inactive_def schedContextSetInactive_def)
-  apply (rule corres_guard_imp)
-
-    \<comment> \<open>collect the update of the sc_refills, sc_refill_max, and the sc_budget fields\<close>
-    apply (subst bind_assoc[symmetric])
-    apply (subst bind_assoc[symmetric])
-    apply (subst bind_dummy_ret_val, subst update_sched_context_decompose[symmetric])
-    apply (subst bind_dummy_ret_val, subst update_sched_context_decompose[symmetric])
-
-    apply (rule corres_split)
-       apply (rule updateSchedContext_corres)
-         apply (clarsimp simp: opt_map_red opt_pred_def obj_at_simps is_sc_obj)
-         apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-         apply (clarsimp simp: sc_relation_def refills_map_def)
-        apply (fastforce dest: state_relation_sc_replies_relation sc_replies_relation_prevs_list
-                         simp: sc_relation_def opt_map_def obj_at_simps is_sc_obj_def
-                        split: Structures_A.kernel_object.splits)
-       apply (clarsimp simp: objBits_simps)
-      apply (rule updateSchedContext_corres)
-        apply (clarsimp simp: opt_map_red opt_pred_def obj_at_simps is_sc_obj)
-        apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-        apply (clarsimp simp: sc_relation_def)
-       apply (fastforce dest: state_relation_sc_replies_relation sc_replies_relation_prevs_list
-                        simp: sc_relation_def opt_map_def obj_at_simps is_sc_obj_def
-                       split: Structures_A.kernel_object.splits)
-      apply (clarsimp simp: objBits_simps)
-     apply (wpsimp wp: get_sched_context_wp getSchedContext_wp)+
-  done
-
-lemma can_fast_finalise_finalise_cap:
-  "can_fast_finalise cap
-   \<Longrightarrow> finalise_cap cap final
-         = do fast_finalise cap final; return (cap.NullCap, cap.NullCap) od"
-  by (cases cap; simp add: can_fast_finalise_def liftM_def)
-
-lemma can_fast_finalise_finaliseCap:
-  "is_ReplyCap cap \<or> is_EndpointCap cap \<or> is_NotificationCap cap \<or> cap = NullCap
-   \<Longrightarrow> finaliseCap cap final flag
-         = do finaliseCap cap final True; return (NullCap, NullCap) od"
-  by (cases cap; simp add: finaliseCap_def isCap_simps)
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 lemma finaliseCap_corres:
   "\<lbrakk> final_matters' cap' \<Longrightarrow> final = final'; cap_relation cap cap';
           flag \<longrightarrow> can_fast_finalise cap \<rbrakk>
      \<Longrightarrow> corres (\<lambda>x y. cap_relation (fst x) (fst y) \<and> cap_relation (snd x) (snd y))
            (\<lambda>s. einvs s \<and> s \<turnstile> cap \<and> (final_matters cap \<longrightarrow> final = is_final_cap' cap s)
-                \<and> cte_wp_at ((=) cap) sl s \<and> simple_sched_action s
-                \<and> current_time_bounded s)
-           (\<lambda>s. invs' s \<and> s \<turnstile>' cap'
-                   \<and> (final_matters' cap' \<longrightarrow>
-                        final' = isFinal cap' (cte_map sl) (cteCaps_of s))
-                   \<and> sch_act_simple s)
+                       \<and> cte_wp_at ((=) cap) sl s)
+           (\<lambda>s. invs' s \<and> s \<turnstile>' cap' \<and>
+                 (final_matters' cap' \<longrightarrow>
+                      final' = isFinal cap' (cte_map sl) (cteCaps_of s)))
            (finalise_cap cap final) (finaliseCap cap' final' flag)"
-  apply (case_tac "can_fast_finalise cap")
-   apply (simp add: can_fast_finalise_finalise_cap)
-   apply (subst can_fast_finalise_finaliseCap,
-          clarsimp simp: can_fast_finalise_def split: cap.splits)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF fast_finaliseCap_corres[where sl=sl]]; assumption?)
-        apply simp
-       apply (simp only: K_bind_def)
-       apply (rule corres_returnTT)
-       apply wpsimp+
   apply (cases cap, simp_all add: finaliseCap_def isCap_simps
                                   corres_liftM2_simp[unfolded liftM_def]
                                   o_def dc_def[symmetric] when_def
                                   can_fast_finalise_def
                        split del: if_split cong: if_cong)
-       (* CNodeCap *)
-       apply (fastforce simp: final_matters'_def shiftL_nat zbits_map_def)
-      (* ThreadCap *)
-      apply add_valid_idle'
-      apply (rename_tac tptr)
-      apply (clarsimp simp: final_matters'_def getThreadCSpaceRoot
-                            liftM_def[symmetric] o_def zbits_map_def)
-      apply (rule corres_stateAssert_add_assertion[rotated])
-       apply (clarsimp simp: valid_idle'_asrt_def)
-      apply (rule_tac P="K (tptr \<noteq> idle_thread_ptr)" and P'="K (tptr \<noteq> idle_thread_ptr)"
-             in corres_add_guard)
-       apply clarsimp
-       apply (frule(1) valid_global_refsD[OF invs_valid_global_refs _ idle_global])
-       apply (clarsimp dest!: invs_valid_idle simp: valid_idle_def cap_range_def)
-      apply (rule corres_guard_imp)
-        apply (rule corres_split[OF unbindNotification_corres])
-          apply (rule corres_split[OF unbindFromSC_corres])
-            apply (rule corres_split[OF suspend_corres])
-              apply (clarsimp simp: liftM_def[symmetric] o_def dc_def[symmetric] zbits_map_def)
-              apply (rule prepareThreadDelete_corres)
-             apply (wp unbind_notification_invs unbind_from_sc_valid_sched)+
-       apply (clarsimp simp: valid_cap_def)
-      apply (clarsimp simp: valid_cap'_def)
-     (* SchedContextCap *)
-     apply (rename_tac scptr n)
-     apply (clarsimp simp: final_matters'_def liftM_def[symmetric]
-                           o_def dc_def[symmetric])
-     apply (rule_tac P="K (scptr \<noteq> idle_sc_ptr)" and P'="K (scptr \<noteq> idle_sc_ptr)"
-            in corres_add_guard)
-      apply clarsimp
-      apply (frule(1) valid_global_refsD[OF invs_valid_global_refs _ idle_sc_global])
-      apply (clarsimp dest!: invs_valid_idle simp: valid_idle_def cap_range_def)
+        apply (clarsimp simp: final_matters'_def)
+        apply (rule corres_guard_imp)
+          apply (rule ep_cancel_corres)
+         apply (simp add: valid_cap_def)
+        apply (simp add: valid_cap'_def)
+       apply (clarsimp simp add: final_matters'_def)
+       apply (rule corres_guard_imp)
+         apply (rule corres_split[OF unbindMaybeNotification_corres])
+           apply (rule cancelAllSignals_corres)
+          apply (wp abs_typ_at_lifts unbind_maybe_notification_invs typ_at_lifts hoare_drop_imps hoare_vcg_all_lift | wpc)+
+        apply (clarsimp simp: valid_cap_def)
+       apply (clarsimp simp: valid_cap'_def)
+      apply (fastforce simp: final_matters'_def shiftL_nat zbits_map_def)
+     apply (clarsimp simp add: final_matters'_def getThreadCSpaceRoot
+                               liftM_def[symmetric] o_def zbits_map_def
+                               dc_def[symmetric])
      apply (rule corres_guard_imp)
-       apply (rule corres_split[OF schedContextUnbindAllTCBs_corres])
-         apply (rule corres_split[OF schedContextUnbindNtfn_corres])
-           apply (rule corres_split[OF schedContextUnbindReply_corres])
-             apply (rule corres_split[OF schedContextUnbindYieldFrom_corres])
-               apply (clarsimp simp: o_def dc_def[symmetric])
-               apply (rule schedContextSetInactive_corres)
-              apply (wpsimp wp: abs_typ_at_lifts typ_at_lifts)+
-      apply (clarsimp simp: valid_cap_def)
-     apply (clarsimp simp: valid_cap'_def sc_at'_n_sc_at')
-    (* IRQHandlerCap *)
-    apply (clarsimp simp: final_matters'_def liftM_def[symmetric]
-                          o_def dc_def[symmetric])
-    apply (rule corres_guard_imp)
+       apply (rule corres_split[OF unbindNotification_corres])
+         apply (rule corres_split[OF suspend_corres])
+            apply (clarsimp simp: liftM_def[symmetric] o_def dc_def[symmetric] zbits_map_def)
+          apply (rule prepareThreadDelete_corres)
+        apply (wp unbind_notification_invs unbind_notification_simple_sched_action)+
+      apply (simp add: valid_cap_def)
+     apply (simp add: valid_cap'_def)
+    apply (simp add: final_matters'_def liftM_def[symmetric]
+                     o_def dc_def[symmetric])
+    apply (intro impI, rule corres_guard_imp)
       apply (rule deletingIRQHandler_corres)
      apply simp
     apply simp
-   (* ZombieCap *)
    apply (clarsimp simp: final_matters'_def)
    apply (rule_tac F="False" in corres_req)
     apply clarsimp
     apply (frule zombies_finalD, (clarsimp simp: is_cap_simps)+)
     apply (clarsimp simp: cte_wp_at_caps_of_state)
    apply simp
-  (* ArchObjectCap *)
   apply (clarsimp split del: if_split simp: o_def)
-  apply (rule corres_guard_imp [OF arch_finaliseCap_corres], (fastforce simp: valid_sched_def)+)[1]
+  apply (rule corres_guard_imp [OF arch_finaliseCap_corres], (fastforce simp: valid_sched_def)+)
   done
-
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma arch_recycleCap_improve_cases:
    "\<lbrakk> \<not> isPageCap cap; \<not> isPageTableCap cap; \<not> isPageDirectoryCap cap;
          \<not> isASIDControlCap cap \<rbrakk> \<Longrightarrow> (if isASIDPoolCap cap then v else undefined) = v"
@@ -5037,78 +3565,76 @@ crunch copyGlobalMappings
   for ct__in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
   (wp: crunch_wps)
 
+crunch copyGlobalMappings
+  for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  (wp: crunch_wps)
+
 lemma threadSet_ct_idle_or_in_cur_domain':
   "\<lbrace>ct_idle_or_in_cur_domain' and (\<lambda>s. \<forall>tcb. tcbDomain tcb = ksCurDomain s \<longrightarrow> tcbDomain (F tcb) = ksCurDomain s)\<rbrace>
     threadSet F t
    \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
-  apply (simp add: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
-  apply (wp hoare_vcg_disj_lift hoare_vcg_imp_lift)
-    apply wps
-    apply wp
-   apply wps
-   apply wp
-  apply (auto simp: obj_at'_def)
-  done
+apply (simp add: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
+apply (wp hoare_vcg_disj_lift hoare_vcg_imp_lift)
+  apply wps
+  apply wp
+ apply wps
+ apply wp
+apply (auto simp: obj_at'_def)
+done
 
 crunch invalidateTLBByASID
- for valid_arch_state'[wp]: "valid_arch_state'"
-
-end
-
-sublocale Arch < invalidateTLBByASID: typ_at_all_props' "invalidateTLBByASID asid"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+crunch invalidateTLBByASID
+  for valid_arch_state'[wp]: "valid_arch_state'"
+lemmas invalidateTLBByASID_typ_ats[wp] = typ_at_lifts [OF invalidateTLBByASID_typ_at']
 
 crunch invalidateTLBByASID
   for cteCaps_of: "\<lambda>s. P (cteCaps_of s)"
 
+crunch invalidate_tlb_by_asid
+  for valid_etcbs[wp]: valid_etcbs
+
+lemma cteCaps_of_ctes_of_lift:
+  "(\<And>P. \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ctes_of s)\<rbrace>) \<Longrightarrow> \<lbrace>\<lambda>s. P (cteCaps_of s) \<rbrace> f \<lbrace>\<lambda>_ s. P (cteCaps_of s)\<rbrace>"
+  unfolding cteCaps_of_def .
+
 lemmas final_matters'_simps = final_matters'_def [split_simps capability.split arch_capability.split]
 
-lemma cancelAll_ct_not_ksQ_helper:
-  "\<lbrace>(\<lambda>s. ksCurThread s \<notin> set (ksReadyQueues s p)) and (\<lambda>s. ksCurThread s \<notin> set q) \<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 tcbSchedEnqueue t
-               od) q
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (rule mapM_x_inv_wp2, simp)
-  apply (wp)
-    apply (wps tcbSchedEnqueue_ct')
-    apply (wp tcbSchedEnqueue_ksQ)
-   apply (wps setThreadState_ct')
-   apply (wp sts_ksQ')
-  apply (clarsimp)
-  done
+crunch deleteCallerCap
+  for idle_thread[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (wp: crunch_wps)
+crunch deleteCallerCap
+  for sch_act_simple: sch_act_simple
+  (wp: crunch_wps)
+crunch deleteCallerCap
+  for sch_act_not[wp]: "sch_act_not t"
+  (wp: crunch_wps)
+crunch deleteCallerCap
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps)
+lemmas deleteCallerCap_typ_ats[wp] = typ_at_lifts [OF deleteCallerCap_typ_at']
 
-lemma unbindMaybeNotification_ct_not_ksQ:
- "\<lbrace>invs' and ct_in_state' simple' and sch_act_sane
-          and (\<lambda>s. ksCurThread s \<notin> set (ksReadyQueues s p))\<rbrace>
-   unbindMaybeNotification t
-   \<lbrace>\<lambda>rv s. ksCurThread s \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: unbindMaybeNotification_def)
-  apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnBoundTCB ntfn", simp, wp, simp+)
-  apply (rule hoare_pre)
-    apply wp
-    apply (wps setBoundNotification.ct)
-    apply (wp sbn_ksQ)
-   apply (wps set_ntfn'.ct, wp)
-  apply clarsimp
-  done
+crunch emptySlot
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
+
+lemma setEndpoint_sch_act_not_ct[wp]:
+  "\<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s\<rbrace>
+   setEndpoint ptr val \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
+  by (rule hoare_weaken_pre, wps setEndpoint_ct', wp, simp)
 
 lemma sbn_ct_in_state'[wp]:
   "\<lbrace>ct_in_state' P\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>_. ct_in_state' P\<rbrace>"
   apply (simp add: ct_in_state'_def)
   apply (rule hoare_pre)
-   apply (wps setBoundNotification.ct)
-  apply wpsimp+
+   apply (wps setBoundNotification_ct')
+  apply (wp sbn_st_tcb', clarsimp)
   done
 
 lemma set_ntfn_ct_in_state'[wp]:
   "\<lbrace>ct_in_state' P\<rbrace> setNotification a ntfn \<lbrace>\<lambda>_. ct_in_state' P\<rbrace>"
   apply (simp add: ct_in_state'_def)
-  apply (wp_pre, wps, wp, clarsimp)
+  apply (rule hoare_pre)
+   apply (wps setNotification_ksCurThread, wp, clarsimp)
   done
 
 lemma unbindMaybeNotification_ct_in_state'[wp]:
diff --git a/proof/refine/ARM/InitLemmas.thy b/proof/refine/ARM/InitLemmas.thy
index ae88c1fd5f..cf63858484 100644
--- a/proof/refine/ARM/InitLemmas.thy
+++ b/proof/refine/ARM/InitLemmas.thy
@@ -23,8 +23,8 @@ declare unless_True[simp]
 declare maybe_fail_bind_fail[simp]
 
 crunch setPriority
-  for cte_wp_at'[wp]: "cte_wp_at' P p"
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  (simp: crunch_simps wp: crunch_wps)
+  for cte_wp_at'[wp]: "cte_wp_at' P p" (simp: crunch_simps)
+crunch setPriority
+  for irq_node'[wp]: "\<lambda>s. P (irq_node' s)" (simp: crunch_simps)
 
 end
diff --git a/proof/refine/ARM/Init_R.thy b/proof/refine/ARM/Init_R.thy
index b1e31d437d..ba7f14c7cf 100644
--- a/proof/refine/ARM/Init_R.thy
+++ b/proof/refine/ARM/Init_R.thy
@@ -10,7 +10,7 @@ imports
 
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 (*
   This provides a very simple witness that the state relation used in the first refinement proof is
@@ -50,17 +50,6 @@ definition zeroed_main_abstract_state ::
     is_original_cap = (K True),
     cur_thread = 0,
     idle_thread = 0,
-    consumed_time = 0,
-    cur_time = 0,
-    cur_sc = 0,
-    reprogram_timer = False,
-    scheduler_action = resume_cur_thread,
-    domain_list = [],
-    domain_index = 0,
-    cur_domain = 0,
-    domain_time = 0,
-    ready_queues = (\<lambda>d p. []),
-    release_queue = [],
     machine_state = init_machine_state,
     interrupt_irq_node = (\<lambda>irq. ucast irq << cte_level_bits),
     interrupt_states = (K irq_state.IRQInactive),
@@ -72,6 +61,13 @@ definition zeroed_extended_state ::
   where
   "zeroed_extended_state \<equiv> \<lparr>
     work_units_completed_internal = 0,
+    scheduler_action_internal = resume_cur_thread,
+    ekheap_internal = K None,
+    domain_list_internal = [],
+    domain_index_internal = 0,
+    cur_domain_internal = 0,
+    domain_time_internal = 0,
+    ready_queues_internal = (\<lambda>_ _. []),
     cdt_list_internal = K []
   \<rparr>"
 
@@ -100,16 +96,10 @@ definition zeroed_intermediate_state ::
     ksCurDomain = 0,
     ksDomainTime = 0,
     ksReadyQueues = K (TcbQueue None None),
-    ksReleaseQueue = TcbQueue None None,
     ksReadyQueuesL1Bitmap = K 0,
     ksReadyQueuesL2Bitmap = K 0,
     ksCurThread = 0,
     ksIdleThread = 0,
-    ksIdleSC = idle_sc_ptr,
-    ksConsumedTime = 0,
-    ksCurTime = 0,
-    ksCurSc = 0,
-    ksReprogramTimer = False,
     ksSchedulerAction = ResumeCurrentThread,
     ksInterruptState = (InterruptState 0 (K IRQInactive)),
     ksWorkUnitsCompleted = 0,
@@ -126,10 +116,11 @@ 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: sc_replies_relation_def sc_replies_of_scs_def scs_of_kh_def map_project_def)
-         apply (clarsimp simp: ready_queues_relation_def)
-        apply (clarsimp simp: release_queue_relation_def)
+          apply (clarsimp simp: pspace_relation_def pspace_dom_def)
+         apply (clarsimp simp: ekheap_relation_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)
        apply (clarsimp simp: ghost_relation_def)
       apply (fastforce simp: cdt_relation_def swp_def dest: cte_wp_at_domI)
      apply (clarsimp simp: cdt_list_relation_def map_to_ctes_def)
diff --git a/proof/refine/ARM/InterruptAcc_R.thy b/proof/refine/ARM/InterruptAcc_R.thy
index 00f0cc8d94..3ab201d6fe 100644
--- a/proof/refine/ARM/InterruptAcc_R.thy
+++ b/proof/refine/ARM/InterruptAcc_R.thy
@@ -18,8 +18,12 @@ lemma getIRQSlot_corres:
                    ucast_nat_def shiftl_t2n)
   done
 
+crunch get_irq_slot
+  for inv[wp]: "P"
+crunch getIRQSlot
+  for inv[wp]: "P"
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma setIRQState_corres:
   "irq_state_relation state state' \<Longrightarrow>
@@ -49,25 +53,27 @@ lemma setIRQState_invs[wp]:
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def)
   apply (wp dmo_maskInterrupt)
-  apply (clarsimp simp: invs'_def cur_tcb'_def
-                        Invariants_H.valid_queues_def valid_queues'_def valid_release_queue_def
-                        valid_release_queue'_def valid_dom_schedule'_def
-                        valid_irq_node'_def
+  apply (clarsimp simp: invs'_def valid_state'_def cur_tcb'_def
+                        valid_idle'_def valid_irq_node'_def
                         valid_arch_state'_def valid_global_refs'_def
                         global_refs'_def valid_machine_state'_def
                         if_unsafe_then_cap'_def ex_cte_cap_to'_def
                         valid_irq_handlers'_def irq_issued'_def
                         cteCaps_of_def valid_irq_masks'_def
-                        bitmapQ_defs valid_queues_no_bitmap_def irqs_masked'_def)
-  apply fastforce
+                        bitmapQ_defs valid_bitmaps_def)
+  apply (rule conjI, clarsimp)
+  apply (clarsimp simp: irqs_masked'_def ct_not_inQ_def)
+  apply (rule conjI)
+   apply fastforce
+  apply (simp add: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
   done
 
 lemma getIRQSlot_real_cte[wp]:
   "\<lbrace>invs'\<rbrace> getIRQSlot irq \<lbrace>real_cte_at'\<rbrace>"
   apply (simp add: getIRQSlot_def getInterruptState_def locateSlot_conv)
   apply wp
-  apply (clarsimp simp: invs'_def valid_irq_node'_def cteSizeBits_def shiftl_t2n
-                        cte_level_bits_def ucast_nat_def)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_irq_node'_def
+                        cte_level_bits_def ucast_nat_def cteSizeBits_def shiftl_t2n)
   done
 
 lemma getIRQSlot_cte_at[wp]:
@@ -89,295 +95,38 @@ lemma work_units_and_irq_state_state_relationI [intro!]:
    \<in> state_relation"
   by (simp add: state_relation_def swp_def)
 
-lemma update_work_units_corres[corres]:
-  "corres (dc \<oplus> dc) \<top> \<top> (liftE update_work_units) (liftE (modifyWorkUnits (\<lambda>op. op + 1)))"
-  apply (clarsimp simp: update_work_units_def modifyWorkUnits_def)
-  apply (rule corres_modify)
-  apply (clarsimp simp: state_relation_def)
-  done
-
-lemma getCurTime_corres[corres]:
-  "corres (=) \<top> \<top> (gets cur_time) getCurTime"
-  apply (simp add: getCurTime_def state_relation_def)
-  done
-
-lemma getDomainTime_corres[corres]:
-  "corres (=) \<top> \<top> (gets domain_time) getDomainTime"
-  apply (simp add: getDomainTime_def state_relation_def)
-  done
-
-lemma getCurTime_sp:
-  "\<lbrace>P\<rbrace> getCurTime \<lbrace>\<lambda>rv s. rv = ksCurTime s \<and> P s\<rbrace>"
-  apply wpsimp
-  done
-
-lemma updateTimeStamp_corres[corres]:
-  "corres dc \<top> \<top> update_time_stamp updateTimeStamp"
-  apply (clarsimp simp: update_time_stamp_def updateTimeStamp_def setConsumedTime_def)
-  apply (prop_tac "minBudget = MIN_BUDGET")
-   apply (clarsimp simp: minBudget_def MIN_BUDGET_def kernelWCETTicks_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurTime_sp])
-   apply corresKsimp
-  apply (rule corres_underlying_split[where r'="(=)"])
-     apply (rule corres_guard_imp)
-       apply (rule corres_machine_op)
-       apply corresKsimp
-        apply (wpsimp simp: getCurrentTime_def)
-       apply simp
-      apply simp
-     apply simp
-    apply (rule_tac P=\<top> and P'=\<top> in corres_inst)
-    apply (clarsimp simp: setCurTime_def)
-    apply (rule corres_guard_imp)
-      apply (rule corres_split[OF corres_modify])
-         apply (clarsimp simp: state_relation_def cdt_relation_def)
-        apply (clarsimp simp: setConsumedTime_def)
-        apply (rule_tac Q'="\<lambda>rv s. rv = ksConsumedTime s" in corres_symb_exec_r)
-           apply (rule corres_guard_imp)
-             apply (rule corres_split[OF corres_modify])
-                apply (simp add: state_relation_def cdt_relation_def)
-               apply (rule corres_guard_imp)
-                 apply (rule corres_rel_imp)
-                  apply (rule corres_split[OF getDomainTime_corres])
-                    apply (rule corres_when, rule refl)
-                    apply (fastforce intro: setDomainTime_corres)
-                   apply (wpsimp simp: getConsumedTime_def)+
-  done
-
-lemma refillSufficient_corres:
-  "sc_ptr = scPtr
-   \<Longrightarrow> corres (=) (valid_objs and pspace_aligned and pspace_distinct
-                   and sc_refills_sc_at (\<lambda>refills. refills \<noteq> []) sc_ptr)
-                  valid_objs'
-              (get_sc_refill_sufficient sc_ptr consumed)
-              (refillSufficient scPtr consumed)"
-  apply (rule corres_cross[where Q' = "sc_at' scPtr", OF sc_at'_cross_rel])
-   apply (fastforce simp: obj_at_def is_sc_obj_def valid_obj_def valid_pspace_def sc_at_pred_n_def)
-  apply (clarsimp simp: get_sc_refill_sufficient_def refillSufficient_def getCurTime_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_symb_exec_r)
-       apply (rule_tac R="\<lambda>sc s. sc_refills sc \<noteq> []"
-                   and R'= "\<lambda>sc' s. valid_objs' s \<and> ko_at' sc' scPtr s \<and> refills = scRefills sc'"
-                    in corres_split[OF get_sc_corres])
-         apply (rename_tac sc sc')
-         apply clarsimp
-         apply (prop_tac "r_amount (refill_hd sc) = rAmount (refillHd sc')")
-          apply (fastforce dest: sc_ko_at_valid_objs_valid_sc'
-                                 refill_hd_relation2)
-         apply (clarsimp simp: refill_sufficient_def sufficientRefills_def refillHd_def
-                               refill_capacity_def refillsCapacity_def MIN_BUDGET_def
-                               minBudget_def kernelWCETTicks_def)
-        apply (wpsimp wp: get_sc_inv'
-                    simp: getRefills_def)+
-   apply (fastforce dest: valid_objs_valid_sched_context_size
-                    simp: sc_at_pred_n_def obj_at_def is_sc_obj_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  done
-
-lemma modifyWorkUnits_valid_objs'[wp]:
-  "modifyWorkUnits f \<lbrace>valid_objs'\<rbrace>"
-  apply (clarsimp simp: modifyWorkUnits_def)
-  apply wpsimp
-  done
-
-lemma setWorkUnits_corres[corres]:
-  "corres dc \<top> \<top> reset_work_units (setWorkUnits 0)"
-  apply (clarsimp simp: reset_work_units_def setWorkUnits_def)
-  apply (rule corres_modify)
-  apply (clarsimp simp: state_relation_def)
-  done
-
-crunch updateTimeStamp
-  for valid_objs'[wp]: valid_objs'
-
-lemma getCurSc_sp:
-  "\<lbrace>P\<rbrace> getCurSc \<lbrace>\<lambda>rv s. rv = ksCurSc s \<and> P s\<rbrace>"
-  apply (wpsimp wp: getCurSc_def)
-  done
-
-lemma getConsumedTime_sp:
-  "\<lbrace>P\<rbrace> getConsumedTime \<lbrace>\<lambda>rv s. rv = ksConsumedTime s \<and> P s\<rbrace>"
-  apply wpsimp
-  done
-
-lemma scActive_corres:
-  "corres (=) (sc_at scPtr and pspace_aligned and pspace_distinct)
-              \<top>
-          (get_sc_active scPtr)
-          (scActive scPtr)"
-  apply (rule corres_cross[where Q' = "sc_at' scPtr", OF sc_at'_cross_rel])
-   apply (fastforce simp: obj_at_def is_sc_obj_def valid_obj_def valid_pspace_def sc_at_pred_n_def)
-  apply (corresKsimp corres: get_sc_corres
-                      simp: sc_relation_def get_sc_active_def scActive_def active_sc_def)
-  done
-
-lemma getConsumedTime_corres[corres]:
-  "corres (=) \<top> \<top> (gets consumed_time) getConsumedTime"
-  apply (simp add: getConsumedTime_def state_relation_def)
-  done
-
-lemma isCurDomainExpired_corres[corres]:
-  "corres (=) \<top> \<top> (gets is_cur_domain_expired) isCurDomainExpired"
-  apply (simp add: is_cur_domain_expired_def isCurDomainExpired_def getDomainTime_def
-                   getConsumedTime_def)
-  apply (clarsimp simp: corres_underlying_def gets_def bind_def get_def return_def
-                        state_relation_def)
-  done
-
-lemma get_sc_active_sp:
-  "\<lbrace>P\<rbrace>
-   get_sc_active sc_ptr
-   \<lbrace>\<lambda>rv s. P s
-           \<and> (\<exists>sc n. ko_at (kernel_object.SchedContext sc n) sc_ptr s \<and> rv = (0 < sc_refill_max sc))\<rbrace>"
-  apply (simp add: get_sc_active_def)
-  apply wpsimp
-  apply (clarsimp simp: obj_at_def active_sc_def)
-  done
-
-lemma scActive_sp:
-  "\<lbrace>P\<rbrace>
-   scActive scPtr
-   \<lbrace>\<lambda>rv s. P s \<and> (\<exists>sc. ko_at' sc scPtr s \<and> rv = (0 < scRefillMax sc))\<rbrace>"
-  apply (simp add: scActive_def)
-  apply (rule bind_wp_fwd)
-   apply (rule get_sc_sp')
-  apply (wp hoare_return_sp)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  done
-
 lemma preemptionPoint_corres:
-  "corres (dc \<oplus> dc)
-          (\<lambda>s. valid_objs s \<and> cur_sc_tcb s \<and> pspace_aligned s \<and> pspace_distinct s
-               \<and> active_scs_valid s \<and> valid_machine_time s)
-          valid_objs'
-          preemption_point
-          preemptionPoint"
-  (is "corres _ ?abs ?conc _ _")
-  supply if_split[split del]
+  "corres (dc \<oplus> dc) \<top> \<top> preemption_point preemptionPoint"
   apply (simp add: preemption_point_def preemptionPoint_def)
-  apply (rule corres_splitEE_skip
-         ; corresKsimp corres: update_work_units_corres
-                        simp: update_work_units_def)
-  apply (clarsimp simp: bindE_def liftE_def)
-  apply (rule_tac Q'="\<lambda>rv s. rv = ksWorkUnitsCompleted s \<and> ?conc s" in corres_symb_exec_r[rotated])
-     apply (wpsimp simp: getWorkUnits_def)+
-  apply (rename_tac work_units)
-  apply (clarsimp simp: OR_choiceE_def whenE_def work_units_limit_reached_def bindE_def liftE_def)
-  apply (rule_tac Q="\<lambda>rv s. rv = s \<and> ?abs s" in corres_symb_exec_l[rotated])
-     apply wpsimp+
-  apply (rename_tac ex)
-  apply (rule_tac Q="\<lambda>s. ex = s \<and> work_units = work_units_completed s \<and> ?abs s"
-              and Q'="\<lambda>s. work_units = ksWorkUnitsCompleted s \<and> valid_objs' s"
-              in stronger_corres_guard_imp[rotated])
-    apply (clarsimp simp: state_relation_def)
-   apply simp
-  apply (rule_tac Q="\<lambda>rv s. \<exists>rv'' t. rv = (rv'', s) \<and> rv'' = (workUnitsLimit \<le> work_units) \<and> ?abs s"
-               in corres_symb_exec_l[rotated])
-     apply (clarsimp simp: select_f_def mk_ef_def bind_def gets_def exs_valid_def get_def return_def
-                           wrap_ext_bool_det_ext_ext_def)
-    apply wpsimp
-    apply (clarsimp simp: select_f_def mk_ef_def bind_def gets_def get_def return_def
-                          work_units_limit_def wrap_ext_bool_det_ext_ext_def Kernel_Config.workUnitsLimit_def)
-   apply wpsimp
-  apply (clarsimp simp: select_f_def mk_ef_def bind_def gets_def exs_valid_def get_def return_def
-                        work_units_limit_def wrap_ext_bool_det_ext_ext_def Kernel_Config.workUnitsLimit_def)
-  apply (case_tac rv; clarsimp)
-  apply (rename_tac bool state)
-  apply (rule_tac F="bool = (workUnitsLimit \<le> work_units) \<and> ?abs state" in corres_req)
-   apply simp
-  apply (rule corres_guard_imp)
-    apply (rule corres_if3)
-      apply clarsimp
-     apply (rule_tac P="?abs" and P'="?conc" in corres_inst)
-     apply (rule corres_split_skip)
-        apply (wpsimp simp: reset_work_units_def)
-       apply (wpsimp simp: setWorkUnits_def)
-      apply (corresKsimp corres: setWorkUnits_corres)
-     apply (rule corres_split_skip)
-        apply wpsimp
-       apply wpsimp
-      apply (corresKsimp corres: updateTimeStamp_corres)
-     apply (rule corres_split_skip)
-        apply (wpsimp simp: cur_sc_tcb_def)
-       apply wpsimp
-      apply (corresKsimp corres: corres_machine_op)
-     apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurSc_sp])
-      apply (corresKsimp corres: getCurSc_corres)
-     apply (rule corres_underlying_split[rotated 2, OF gets_sp getConsumedTime_sp])
-      apply (corresKsimp corres: getConsumedTime_corres)
-     apply (clarsimp simp: andM_def ifM_def bind_assoc)
-     apply (rule corres_underlying_split[rotated 2, OF get_sc_active_sp scActive_sp])
-      apply (corresKsimp corres: scActive_corres)
-      apply (fastforce dest: valid_objs_valid_sched_context_size
-                       simp: cur_sc_tcb_def obj_at_def is_sc_obj_def sc_at_pred_n_def)
-     apply (clarsimp split: if_split)
-     apply (intro conjI impI)
-      apply (rule corres_guard_imp)
-      apply (rule corres_split[OF refillSufficient_corres]; simp)
-          apply (rule corres_split[OF isCurDomainExpired_corres])
-            apply (clarsimp simp: returnOk_def
-                           split: if_split)
-           apply wpsimp
-          apply (wpsimp simp: isCurDomainExpired_def)+
-       apply (prop_tac "is_active_sc (cur_sc s) s")
-        apply (clarsimp simp: obj_at_def vs_all_heap_simps active_sc_def)
-       apply (frule (1) active_scs_validE)
-       apply (clarsimp simp: obj_at_def is_sc_obj_def sc_at_pred_n_def vs_all_heap_simps
-                             active_sc_def sc_valid_refills_def rr_valid_refills_def
-                      split: if_splits)
-      apply simp
-     apply corresKsimp
-    apply (fastforce intro: corres_returnOkTT)
-   apply (clarsimp split: if_split)
-  apply (clarsimp split: if_split)
-  done
+  by (auto simp: preemption_point_def preemptionPoint_def o_def gets_def liftE_def whenE_def getActiveIRQ_def
+                 corres_underlying_def select_def bind_def get_def bindE_def select_f_def modify_def
+                 alternative_def throwError_def returnOk_def return_def lift_def doMachineOp_def split_def
+                 put_def getWorkUnits_def setWorkUnits_def modifyWorkUnits_def do_machine_op_def
 
-lemma updateTimeStamp_inv:
-   "\<lbrakk>updateTimeStamp_independent P; time_state_independent_H P; getCurrentTime_independent_H P;
-     domain_time_independent_H P\<rbrakk>
-    \<Longrightarrow> updateTimeStamp \<lbrace>P\<rbrace>"
-  apply (simp add: updateTimeStamp_def doMachineOp_def getCurrentTime_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-   apply (fastforce simp: time_state_independent_H_def getCurrentTime_independent_H_def in_monad)
-  apply (rule bind_wp_fwd_skip, wpsimp simp: setCurTime_def)
-   apply (clarsimp simp: updateTimeStamp_independent_def)
-   apply (drule_tac x="\<lambda>_. curTime'" in spec)
-   apply (drule_tac x=id in spec)
-   apply fastforce
-  apply (wpsimp simp: setConsumedTime_def setDomainTime_def getDomainTime_def)
-  apply (clarsimp simp: updateTimeStamp_independent_def)
-  apply (drule_tac x=id in spec)
-  apply (fastforce simp: update_time_stamp_independent_A_def domain_time_independent_H_def)
-  done
+                 update_work_units_def wrap_ext_bool_det_ext_ext_def work_units_limit_def workUnitsLimit_def
+                 work_units_limit_reached_def OR_choiceE_def reset_work_units_def mk_ef_def
+           elim: state_relationE)
+  (* what? *)
+  (* who says our proofs are not automatic.. *)
 
 lemma preemptionPoint_inv:
   assumes "(\<And>f s. P (ksWorkUnitsCompleted_update f s) = P s)"
           "irq_state_independent_H P"
-          "updateTimeStamp_independent P"
-          "getCurrentTime_independent_H P"
-          "time_state_independent_H P"
-          "domain_time_independent_H P"
-  shows "preemptionPoint \<lbrace>P\<rbrace>"
-  using assms
-  apply (simp add: preemptionPoint_def setWorkUnits_def getWorkUnits_def modifyWorkUnits_def
-                   setConsumedTime_def setCurTime_def)
-  apply (rule validE_valid)
-  apply (rule bindE_wp_fwd_skip, solves wpsimp)+
-  apply (clarsimp simp: whenE_def)
-  apply (intro conjI impI; (solves wpsimp)?)
-  apply (rule bindE_wp_fwd_skip, solves wpsimp)+
-  apply (rename_tac preempt)
-  apply (case_tac preempt; clarsimp)
-   apply (rule bindE_wp_fwd_skip)
-    apply (wpsimp wp: updateTimeStamp_inv)
-  apply (rule bindE_wp_fwd_skip, solves wpsimp)+
-  apply (wpsimp wp: getRefills_wp hoare_drop_imps
-              simp: isCurDomainExpired_def getDomainTime_def refillSufficient_def)
+  shows "\<lbrace>P\<rbrace> preemptionPoint \<lbrace>\<lambda>_. P\<rbrace>" using assms
+  apply (simp add: preemptionPoint_def setWorkUnits_def getWorkUnits_def modifyWorkUnits_def)
+  apply (wpc
+          | wp whenE_wp bind_wp [OF _ select_inv] hoare_drop_imps
+          | simp)+
   done
 
-lemma ct_in_state_machine_state_independent[intro!, simp]:
-  "ct_in_state P (machine_state_update f s) = ct_in_state P s"
+lemma ct_running_irq_state_independent[intro!, simp]:
+  "ct_running (s \<lparr>machine_state := machine_state s \<lparr>irq_state := f (irq_state (machine_state s)) \<rparr> \<rparr>)
+   = ct_running s"
+  by (simp add: ct_in_state_def)
+
+lemma ct_idle_irq_state_independent[intro!, simp]:
+  "ct_idle (s \<lparr>machine_state := machine_state s \<lparr>irq_state := f (irq_state (machine_state s)) \<rparr> \<rparr>)
+   = ct_idle s"
   by (simp add: ct_in_state_def)
 
 lemma typ_at'_irq_state_independent[simp, intro!]:
@@ -390,39 +139,28 @@ lemma sch_act_simple_irq_state_independent[intro!, simp]:
    sch_act_simple s"
   by (simp add: sch_act_simple_def)
 
-method invs'_independent_method
-  = (clarsimp simp: irq_state_independent_H_def invs'_def
-                    valid_pspace'_def valid_replies'_def sch_act_wf_def
-                    valid_queues_def sym_refs_def state_refs_of'_def
-                    if_live_then_nonz_cap'_def if_unsafe_then_cap'_def
-                    valid_global_refs'_def
-                    valid_arch_state'_def valid_irq_node'_def
-                    valid_irq_handlers'_def valid_irq_states'_def
-                    irqs_masked'_def bitmapQ_defs valid_queues_no_bitmap_def
-                    valid_queues'_def valid_pde_mappings'_def
-                    pspace_domain_valid_def cur_tcb'_def
-                    valid_machine_state'_def tcb_in_cur_domain'_def ex_cte_cap_wp_to'_def
-                    valid_mdb'_def ct_in_state'_def
-                    valid_release_queue_def valid_release_queue'_def valid_dom_schedule'_def
-              cong: if_cong option.case_cong)
-
-lemma
-  shows invs'_irq_state_independent [simp, intro!]:
+lemma invs'_irq_state_independent [simp, intro!]:
   "invs' (s\<lparr>ksMachineState := ksMachineState s
-                 \<lparr>irq_state := f (irq_state (ksMachineState s))\<rparr>\<rparr>)
-   = invs' s"
-  and invs'_updateTimeStamp_independent [simp, intro!]:
-  "invs' (s\<lparr>ksCurTime := f' (ksCurTime s), ksConsumedTime := g (ksConsumedTime s)\<rparr>)
-   = invs' s"
-  and invs'_getCurrentTime_independent [simp, intro!]:
-  "invs' (s\<lparr>ksMachineState
-            := ksMachineState s \<lparr>last_machine_time
-                                 := f'' (last_machine_time (ksMachineState s)) (time_state (ksMachineState s))\<rparr>\<rparr>)
-   = invs' s"
-  and invs'_time_state_independent [simp, intro!]:
-  "invs' (s\<lparr>ksMachineState := ksMachineState s \<lparr>time_state := f''' (time_state (ksMachineState s))\<rparr>\<rparr>)
-   = invs' s"
-  by invs'_independent_method+
+                 \<lparr>irq_state := f (irq_state (ksMachineState s))\<rparr>\<rparr>) =
+   invs' s"
+  apply (clarsimp simp: irq_state_independent_H_def invs'_def valid_state'_def
+          valid_pspace'_def sch_act_wf_def
+          valid_queues_def sym_refs_def state_refs_of'_def
+          if_live_then_nonz_cap'_def if_unsafe_then_cap'_def
+          valid_idle'_def valid_global_refs'_def
+          valid_arch_state'_def valid_irq_node'_def
+          valid_irq_handlers'_def valid_irq_states'_def
+          irqs_masked'_def bitmapQ_defs valid_pde_mappings'_def
+          pspace_domain_valid_def cur_tcb'_def
+          valid_machine_state'_def tcb_in_cur_domain'_def
+          ct_not_inQ_def ct_idle_or_in_cur_domain'_def
+          cong: if_cong option.case_cong)
+  apply (rule iffI[rotated])
+   apply (clarsimp)
+   apply (case_tac "ksSchedulerAction s", simp_all)
+  apply clarsimp
+  apply (case_tac "ksSchedulerAction s", simp_all)
+  done
 
 lemma preemptionPoint_invs [wp]:
   "\<lbrace>invs'\<rbrace> preemptionPoint \<lbrace>\<lambda>_. invs'\<rbrace>"
diff --git a/proof/refine/ARM/Interrupt_R.thy b/proof/refine/ARM/Interrupt_R.thy
index 2b763c0d48..62d38ae486 100644
--- a/proof/refine/ARM/Interrupt_R.thy
+++ b/proof/refine/ARM/Interrupt_R.thy
@@ -14,7 +14,7 @@ begin
 
 context Arch begin
 
-(*FIXME: arch_split: move up *)
+(*FIXME: arch-split: move up *)
 requalify_types
   irqcontrol_invocation
 
@@ -22,11 +22,11 @@ lemmas [crunch_def] = decodeIRQControlInvocation_def performIRQControl_def
 
 context begin global_naming global
 
-(*FIXME: arch_split: move up *)
+(*FIXME: arch-split: move up *)
 requalify_types
   Invocations_H.irqcontrol_invocation
 
-(*FIXME: arch_split*)
+(*FIXME: arch-split*)
 requalify_facts
   Interrupt_H.decodeIRQControlInvocation_def
   Interrupt_H.performIRQControl_def
@@ -90,7 +90,7 @@ where
         ex_cte_cap_to' ptr and real_cte_at' ptr and
         (Not o irq_issued' irq) and K (irq \<le> maxIRQ))"
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma decodeIRQHandlerInvocation_corres:
   "\<lbrakk> list_all2 cap_relation (map fst caps) (map fst caps');
@@ -129,7 +129,7 @@ lemma decode_irq_handler_valid'[wp]:
   apply (rule conjI)
    apply (clarsimp simp: cte_wp_at_ctes_of)
    apply (drule (1) valid_irq_handlers_ctes_ofD)
-    apply (simp add: invs'_def)
+    apply (simp add: invs'_def valid_state'_def)
    apply (simp add: irq_issued'_def)
   apply clarsimp
   done
@@ -144,7 +144,8 @@ lemma is_irq_active_corres:
             split: irqstate.split_asm irq_state.split_asm)
   done
 
-crunch isIRQActive for inv: "P"
+crunch isIRQActive
+  for inv: "P"
 
 lemma isIRQActive_wp:
   "\<lbrace>\<lambda>s. \<forall>rv. (irq_issued' irq s \<longrightarrow> rv) \<longrightarrow> Q rv s\<rbrace> isIRQActive irq \<lbrace>Q\<rbrace>"
@@ -295,8 +296,24 @@ crunch "InterruptDecls_H.decodeIRQControlInvocation"
   for inv[wp]: "P"
   (simp: crunch_simps)
 
+
+(* Levity: added (20090201 10:50:27) *)
 declare ensureEmptySlot_stronger [wp]
 
+lemma lsfco_real_cte_at'[wp]:
+  "\<lbrace>valid_objs' and valid_cap' croot\<rbrace>
+     lookupSlotForCNodeOp is_src croot ptr depth
+   \<lbrace>\<lambda>rv s. real_cte_at' rv s\<rbrace>,-"
+  apply (simp add: lookupSlotForCNodeOp_def split_def unlessE_def
+                   whenE_def
+               split del: if_split
+             cong: if_cong list.case_cong capability.case_cong)
+  apply (rule hoare_pre)
+   apply (wp resolveAddressBits_real_cte_at'
+            | simp
+            | wpc | wp (once) hoare_drop_imps)+
+  done
+
 lemma arch_decode_irq_control_valid'[wp]:
   "\<lbrace>\<lambda>s. invs' s \<and> (\<forall>cap \<in> set caps. s \<turnstile>' cap)
         \<and> (\<forall>cap \<in> set caps. \<forall>r \<in> cte_refs' cap (irq_node' s). ex_cte_cap_to' r s)
@@ -360,8 +377,8 @@ lemma arch_invokeIRQHandler_corres:
 
 lemma invokeIRQHandler_corres:
   "irq_handler_inv_relation i i' \<Longrightarrow>
-   corres dc (einvs and irq_handler_inv_valid i and simple_sched_action and current_time_bounded)
-             (invs' and irq_handler_inv_valid' i' and sch_act_simple)
+   corres dc (einvs and irq_handler_inv_valid i)
+             (invs' and irq_handler_inv_valid' i')
      (invoke_irq_handler i)
      (InterruptDecls_H.invokeIRQHandler i')"
   supply arch_invoke_irq_handler.simps[simp del]
@@ -375,11 +392,11 @@ lemma invokeIRQHandler_corres:
        apply (rule corres_split_nor[OF cap_delete_one_corres])
          apply (rule cteInsert_corres, simp+)
         apply (rule_tac Q'="\<lambda>rv s. einvs s \<and> cte_wp_at (\<lambda>c. c = cap.NullCap) irq_slot s
-                                  \<and> (a, b) \<noteq> irq_slot \<and> current_time_bounded s
+                                  \<and> (a, b) \<noteq> irq_slot
                                   \<and> cte_wp_at (is_derived (cdt s) (a, b) cap) (a, b) s"
                       in hoare_post_imp)
          apply fastforce
-        apply (wp cap_delete_one_still_derived cap_delete_one_valid_sched)+
+        apply (wp cap_delete_one_still_derived)+
        apply (strengthen invs_mdb_strengthen')
        apply wp+
       apply (simp add: conj_comms eq_commute)
@@ -427,15 +444,13 @@ lemma isnt_irq_handler_strg:
 lemma invoke_arch_irq_handler_invs'[wp]:
   "\<lbrace>invs' and irq_handler_inv_valid' i\<rbrace> ARM_H.invokeIRQHandler i \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (cases i; wpsimp wp: dmo_maskInterrupt simp: ARM_H.invokeIRQHandler_def)
-  apply (clarsimp simp: invs'_def valid_dom_schedule'_def valid_irq_masks'_def
-                        valid_machine_state'_def ct_not_inQ_def
-                        ct_in_current_domain_ksMachineState)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_irq_masks'_def
+                        valid_machine_state'_def ct_not_inQ_def)
   done
 
 lemma invoke_irq_handler_invs'[wp]:
-  "\<lbrace>invs' and sch_act_simple and irq_handler_inv_valid' i\<rbrace>
-   InterruptDecls_H.invokeIRQHandler i
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "\<lbrace>invs' and irq_handler_inv_valid' i\<rbrace>
+    InterruptDecls_H.invokeIRQHandler i \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (cases i; simp add: Interrupt_H.invokeIRQHandler_def)
     apply wpsimp
    apply (wp cteInsert_invs)+
@@ -492,7 +507,7 @@ lemma arch_performIRQControl_corres:
    apply (clarsimp simp: invs_def valid_state_def valid_pspace_def cte_wp_at_caps_of_state
                          is_simple_cap_def is_cap_simps arch_irq_control_inv_valid_def
                          safe_parent_for_def)
-  apply (clarsimp simp: invs'_def valid_pspace'_def IRQHandler_valid
+  apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def IRQHandler_valid
                         IRQHandler_valid' is_simple_cap'_def isCap_simps IRQ_def)
   apply (clarsimp simp: safe_parent_for'_def cte_wp_at_ctes_of)
   apply (case_tac ctea)
@@ -515,7 +530,7 @@ lemma performIRQControl_corres:
     apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
                           cte_wp_at_caps_of_state is_simple_cap_def
                           is_cap_simps safe_parent_for_def)
-   apply (clarsimp simp: invs'_def valid_pspace'_def
+   apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
                          IRQHandler_valid  IRQHandler_valid' is_simple_cap'_def
                          isCap_simps)
    apply (clarsimp simp: safe_parent_for'_def cte_wp_at_ctes_of)
@@ -553,10 +568,6 @@ lemma dmo_setIRQTrigger_invs'[wp]:
                      machine_rest_lift_def split_def | wp)+
   done
 
-crunch doMachineOp
-  for ex_cte_cap_wp_to'[wp]: "ex_cte_cap_wp_to' P ptr"
-  (wp: ex_cte_cap_to'_pres)
-
 lemma arch_invoke_irq_control_invs'[wp]:
   "\<lbrace>invs' and arch_irq_control_inv_valid' i\<rbrace> ARM_H.performIRQControl i \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: ARM_H.performIRQControl_def)
@@ -569,7 +580,7 @@ lemma arch_invoke_irq_control_invs'[wp]:
   apply (rule conjI, clarsimp simp: cte_wp_at_ctes_of)
   apply (case_tac ctea)
   apply (auto dest: valid_irq_handlers_ctes_ofD
-              simp: invs'_def IRQ_def)
+              simp: invs'_def valid_state'_def IRQ_def)
   done
 
 lemma invoke_irq_control_invs'[wp]:
@@ -582,7 +593,7 @@ lemma invoke_irq_control_invs'[wp]:
                         safe_parent_for'_def sameRegionAs_def3)
   apply (case_tac ctea)
   apply (auto dest: valid_irq_handlers_ctes_ofD
-              simp: invs'_def)
+              simp: invs'_def valid_state'_def)
   done
 
 lemma getIRQState_corres:
@@ -603,8 +614,9 @@ 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 cdt_relation_def)
+  apply (simp add:dec_domain_time_def corres_underlying_def
+    decDomainTime_def simpler_modify_def)
+  apply (clarsimp simp:state_relation_def)
   done
 
 lemma thread_state_case_if:
@@ -617,27 +629,98 @@ lemma threadState_case_if:
   (if state = Structures_H.thread_state.Running then f else g)"
   by (case_tac state,auto)
 
-lemmas corres_eq_trivial = corres_Id[where f = h and g = h for h, simplified]
+lemma ready_qs_distinct_domain_time_update[simp]:
+  "ready_qs_distinct (domain_time_update f s) = ready_qs_distinct s"
+  by (clarsimp simp: ready_qs_distinct_def)
 
-lemma doMachineOp_ackDeadlineIRQ_invs'[wp]:
-  "doMachineOp ackDeadlineIRQ \<lbrace>invs'\<rbrace>"
-  apply (wpsimp simp: ackDeadlineIRQ_def wp: dmo_invs' ackInterrupt_irq_masks)
-  apply (drule_tac P4="\<lambda>m'. underlying_memory m' p = underlying_memory m p"
-         in use_valid[where P=P and Q="\<lambda>_. P" for P])
-    apply wpsimp+
+lemma timerTick_corres:
+  "corres dc
+     (cur_tcb and valid_sched and pspace_aligned and pspace_distinct) invs'
+     timer_tick timerTick"
+  apply (simp add: timerTick_def timer_tick_def)
+  apply (simp add: thread_state_case_if threadState_case_if)
+  apply (rule_tac Q="cur_tcb and valid_sched and pspace_aligned and pspace_distinct"
+              and Q'=invs'
+               in corres_guard_imp)
+    apply (rule corres_guard_imp)
+      apply (rule corres_split[OF getCurThread_corres])
+        apply simp
+        apply (rule corres_split[OF getThreadState_corres])
+          apply (rename_tac state state')
+          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 (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 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 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
+                         | strengthen valid_queues_in_correct_ready_q
+                                      valid_queues_ready_qs_distinct)+)[1]
+                apply ((wpsimp wp: threadSet_sched_pointers threadSet_valid_sched_pointers
+                                   threadSet_valid_objs'
+                        | strengthen valid_objs'_valid_tcbs')+)[1]
+               apply wpsimp+
+            apply (rule corres_when, simp)
+            apply (rule corres_split[OF decDomainTime_corres])
+              apply (rule corres_split[OF getDomainTime_corres])
+                apply (rule corres_when,simp)
+                apply (rule rescheduleRequired_corres)
+               apply (wp hoare_drop_imp)+
+             apply (wpsimp simp: dec_domain_time_def)
+            apply (wpsimp simp: decDomainTime_def)
+           apply (wpsimp wp: hoare_weak_lift_imp threadSet_timeslice_invs
+                             tcbSchedAppend_valid_objs'
+                             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
+                     | strengthen valid_queues_in_correct_ready_q valid_queues_ready_qs_distinct)+)[1]
+            apply wpsimp
+           apply wpsimp
+          apply ((wpsimp wp: threadSet_sched_pointers threadSet_valid_sched_pointers
+                             threadSet_valid_objs'
+                  | strengthen valid_objs'_valid_tcbs'
+                  | 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
   done
 
+lemmas corres_eq_trivial = corres_Id[where f = h and g = h for h, simplified]
+
 lemma handleInterrupt_corres:
   "corres dc
-     (einvs and current_time_bounded) (invs' and (\<lambda>s. intStateIRQTable (ksInterruptState s) irq \<noteq> IRQInactive))
+     (einvs) (invs' and (\<lambda>s. intStateIRQTable (ksInterruptState s) irq \<noteq> IRQInactive))
      (handle_interrupt irq) (handleInterrupt irq)"
-  (is "corres dc ?Q ?P' ?f ?g")
+  (is "corres dc (einvs) ?P' ?f ?g")
   apply (simp add: handle_interrupt_def handleInterrupt_def )
   apply (rule conjI[rotated]; rule impI)
 
    apply (rule corres_guard_imp)
      apply (rule corres_split[OF getIRQState_corres,
-                               where R="\<lambda>rv. ?Q"
+                               where R="\<lambda>rv. einvs"
                                  and R'="\<lambda>rv. invs' and (\<lambda>s. rv \<noteq> IRQInactive)"])
        defer
        apply (wp getIRQState_prop getIRQState_inv do_machine_op_bind doMachineOp_bind | simp add: do_machine_op_bind doMachineOp_bind )+
@@ -652,7 +735,7 @@ lemma handleInterrupt_corres:
      apply (rule corres_split[OF getIRQSlot_corres])
        apply simp
        apply (rule corres_split[OF get_cap_corres,
-                                 where R="\<lambda>rv. ?Q and valid_cap rv"
+                                 where R="\<lambda>rv. einvs and valid_cap rv"
                                   and R'="\<lambda>rv. invs' and valid_cap' (cteCap rv)"])
          apply (rule corres_underlying_split[where r'=dc])
             apply (case_tac xb, simp_all add: doMachineOp_return)[1]
@@ -666,24 +749,82 @@ lemma handleInterrupt_corres:
             apply ((wp | simp)+)
     apply clarsimp
    apply fastforce
-  apply (corresKsimp corres: corres_machine_op reprogram_timer_corres
-                      simp: ackDeadlineIRQ_def)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split)
+       apply (rule corres_split[OF timerTick_corres corres_machine_op])
+         apply (rule corres_eq_trivial, simp+)
+         apply wp+
+      apply (rule corres_machine_op)
+      apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+)
+     apply wp+
+   apply fastforce
+  apply clarsimp
   done
 
-crunch rescheduleRequired, tcbSchedAppend
+lemma threadSet_ksDomainTime[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomainTime s)\<rbrace> threadSet f ptr \<lbrace>\<lambda>rv s. P (ksDomainTime s)\<rbrace>"
+  apply (simp add: threadSet_def setObject_def split_def)
+  apply (wp crunch_wps | simp add:updateObject_default_def)+
+  done
+
+crunch rescheduleRequired
+  for ksDomainTime[wp]: "\<lambda>s. P (ksDomainTime s)"
+(simp:tcbSchedEnqueue_def wp:unless_wp)
+
+crunch tcbSchedAppend
   for ksDomainTime[wp]: "\<lambda>s. P (ksDomainTime s)"
-  (simp: tcbSchedEnqueue_def wp: crunch_wps)
+(simp:tcbSchedEnqueue_def wp:unless_wp)
+
+lemma updateTimeSlice_valid_pspace[wp]:
+  "\<lbrace>valid_pspace'\<rbrace> threadSet (tcbTimeSlice_update (\<lambda>_. ts')) thread
+  \<lbrace>\<lambda>r. valid_pspace'\<rbrace>"
+  apply (wp threadSet_valid_pspace'T)
+  apply (auto simp:tcb_cte_cases_def)
+  done
+
+lemma updateTimeSlice_sch_act_wf[wp]:
+  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<rbrace>
+   threadSet (tcbTimeSlice_update (\<lambda>_. ts')) thread
+   \<lbrace>\<lambda>r s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  by (wp threadSet_sch_act,simp)
 
 (* catch up tcbSchedAppend to tcbSchedEnqueue, which has these from crunches on possibleSwitchTo *)
 crunch tcbSchedAppend
   for irq_handlers'[wp]: valid_irq_handlers'
-  and irqs_masked'[wp]: irqs_masked'
   (simp: unless_def tcb_cte_cases_def wp: crunch_wps)
-
+crunch tcbSchedAppend
+  for irqs_masked'[wp]: irqs_masked'
+  (simp: unless_def wp: crunch_wps)
 crunch tcbSchedAppend
   for ct[wp]: cur_tcb'
   (wp: cur_tcb_lift crunch_wps)
 
+lemma timerTick_invs'[wp]:
+  "timerTick \<lbrace>invs'\<rbrace>"
+  apply (simp add: timerTick_def)
+  apply (wpsimp wp: threadSet_invs_trivial threadSet_pred_tcb_no_state
+                    rescheduleRequired_all_invs_but_ct_not_inQ
+              simp: tcb_cte_cases_def)
+      apply (rule_tac Q'="\<lambda>rv. invs'" in hoare_post_imp)
+       apply (clarsimp simp: invs'_def valid_state'_def)
+      apply (simp add: decDomainTime_def)
+      apply wp
+     apply simp
+     apply wpc
+            apply (wp add: threadGet_wp threadSet_cur threadSet_timeslice_invs
+                           rescheduleRequired_all_invs_but_ct_not_inQ
+                           hoare_vcg_imp_lift threadSet_ct_idle_or_in_cur_domain')+
+            apply (rule hoare_strengthen_post[OF tcbSchedAppend_all_invs_but_ct_not_inQ'])
+            apply (wpsimp simp: invs'_def valid_state'_def valid_pspace'_def sch_act_wf_weak)+
+           apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post)
+            apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_tcbDomain_triv
+                              threadSet_valid_objs' threadSet_timeslice_invs)+
+           apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+          apply (wpsimp simp: invs'_def valid_state'_def valid_pspace'_def sch_act_wf_weak)+
+      apply (wp gts_wp')+
+  apply (auto simp: invs'_def st_tcb_at'_def obj_at'_def valid_state'_def cong: conj_cong)
+  done
+
 lemma resetTimer_invs'[wp]:
   "\<lbrace>invs'\<rbrace> doMachineOp resetTimer \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (wp dmo_invs' no_irq no_irq_resetTimer)
@@ -697,7 +838,7 @@ lemma resetTimer_invs'[wp]:
   done
 
 lemma dmo_ackInterrupt[wp]:
-  "\<lbrace>invs'\<rbrace> doMachineOp (ackInterrupt irq) \<lbrace>\<lambda>y. invs'\<rbrace>"
+"\<lbrace>invs'\<rbrace> doMachineOp (ackInterrupt irq) \<lbrace>\<lambda>y. invs'\<rbrace>"
   apply (wp dmo_invs' no_irq no_irq_ackInterrupt)
   apply safe
    apply (drule_tac Q="\<lambda>_ m'. underlying_memory m' p = underlying_memory m p"
@@ -707,8 +848,9 @@ lemma dmo_ackInterrupt[wp]:
   done
 
 lemma hint_invs[wp]:
-  "handleInterrupt irq \<lbrace>invs'\<rbrace>"
-  apply (simp add: handleInterrupt_def getSlotCap_def cong: irqstate.case_cong)
+  "\<lbrace>invs'\<rbrace> InterruptDecls_H.handleInterrupt irq \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: Interrupt_H.handleInterrupt_def getSlotCap_def
+             cong: irqstate.case_cong)
   apply (rule conjI; rule impI)
    apply (wp dmo_maskInterrupt_True getCTE_wp'
           | wpc | simp add: doMachineOp_bind maskIrqSignal_def )+
@@ -720,6 +862,11 @@ lemma hint_invs[wp]:
   apply (assumption)+
   done
 
+
+crunch timerTick
+  for st_tcb_at'[wp]: "st_tcb_at' P t"
+  (wp: threadSet_pred_tcb_no_state)
+
 end
 
 end
diff --git a/proof/refine/ARM/InvariantUpdates_H.thy b/proof/refine/ARM/InvariantUpdates_H.thy
index d1fec7fe1a..1e6db0685c 100644
--- a/proof/refine/ARM/InvariantUpdates_H.thy
+++ b/proof/refine/ARM/InvariantUpdates_H.thy
@@ -38,10 +38,29 @@ lemma invs'_machine:
 proof -
   show ?thesis
     apply (cases "ksSchedulerAction s")
-    apply (simp_all add: invs'_def cur_tcb'_def ct_in_state'_def
-                         ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def
-                         valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs
-                         vms ct_not_inQ_def valid_dom_schedule'_def
+    apply (simp_all add: invs'_def valid_state'_def cur_tcb'_def ct_in_state'_def
+                    ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def
+                    valid_bitmaps_def bitmapQ_defs
+                    vms ct_not_inQ_def
+                    state_refs_of'_def ps_clear_def
+                    valid_irq_node'_def mask
+              cong: option.case_cong)
+    done
+qed
+
+lemma invs_no_cicd'_machine:
+  assumes mask: "irq_masks (f (ksMachineState s)) =
+                 irq_masks (ksMachineState s)"
+  assumes vms: "valid_machine_state' (ksMachineState_update f s) =
+                valid_machine_state' s"
+  shows "invs_no_cicd' (ksMachineState_update f s) = invs_no_cicd' s"
+proof -
+  show ?thesis
+    apply (cases "ksSchedulerAction s")
+    apply (simp_all add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def
+                         cur_tcb'_def ct_in_state'_def ct_idle_or_in_cur_domain'_def
+                         tcb_in_cur_domain'_def valid_bitmaps_def bitmapQ_defs
+                         vms ct_not_inQ_def
                          state_refs_of'_def ps_clear_def
                          valid_irq_node'_def mask
                    cong: option.case_cong)
@@ -77,6 +96,14 @@ lemma valid_tcb'_tcbFault_update[simp]:
   "valid_tcb' tcb s \<Longrightarrow> valid_tcb' (tcbFault_update f tcb) s"
   by (clarsimp simp: valid_tcb'_def  tcb_cte_cases_def cteSizeBits_def)
 
+lemma valid_tcb'_tcbTimeSlice_update[simp]:
+  "valid_tcb' (tcbTimeSlice_update f tcb) s = valid_tcb' tcb s"
+  by (simp add:valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+
+lemma valid_bitmaps_ksSchedulerAction_update[simp]:
+   "valid_bitmaps (ksSchedulerAction_update f s) = valid_bitmaps s"
+   by (simp add: valid_bitmaps_def bitmapQ_defs)
+
 lemma ex_cte_cap_wp_to'_gsCNodes_update[simp]:
   "ex_cte_cap_wp_to' P p (gsCNodes_update f s') = ex_cte_cap_wp_to' P p s'"
   by (simp add: ex_cte_cap_wp_to'_def)
@@ -130,10 +157,6 @@ lemma valid_bitmaps_ksWorkUnitsCompleted[simp]:
   "valid_bitmaps (ksWorkUnitsCompleted_update f s) = valid_bitmaps s"
   by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_queues_ksReprogramTimer[simp]:
-  "valid_queues (ksReprogramTimer_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs)
-
 lemma valid_irq_node'_ksCurDomain[simp]:
   "valid_irq_node' w (ksCurDomain_update f s) = valid_irq_node' w s"
   by (simp add: valid_irq_node'_def)
@@ -154,58 +177,6 @@ lemma valid_irq_node'_ksWorkUnitsCompleted[simp]:
   "valid_irq_node' w (ksWorkUnitsCompleted_update f s) = valid_irq_node' w s"
   by (simp add: valid_irq_node'_def)
 
-lemma valid_irq_node'_ksReprogramTimer[simp]:
-  "valid_irq_node' w (ksReprogramTimer_update f s) = valid_irq_node' w s"
-  by (simp add: valid_irq_node'_def)
-
-lemma valid_release_queue_ksWorkUnitsCompleted[simp]:
-  "valid_release_queue (ksWorkUnitsCompleted_update f s) = valid_release_queue s"
-  by (simp add: valid_release_queue_def)
-
-lemma valid_release_queue_ksReprogramTimer[simp]:
-  "valid_release_queue (ksReprogramTimer_update f s) = valid_release_queue s"
-  by (simp add: valid_release_queue_def)
-
-lemma valid_release_queue_ksDomainTime[simp]:
-  "valid_release_queue (ksDomainTime_update f s) = valid_release_queue s"
-  by (simp add: valid_release_queue_def)
-
-lemma valid_release_queue_ksCurDomain[simp]:
-  "valid_release_queue (ksCurDomain_update f s) = valid_release_queue s"
-  by (simp add: valid_release_queue_def)
-
-lemma valid_release_queue_ksDomScheduleIdx[simp]:
-  "valid_release_queue (ksDomScheduleIdx_update f s) = valid_release_queue s"
-  by (simp add: valid_release_queue_def)
-
-lemma valid_release_queue_ksSchedulerAction[simp]:
-  "valid_release_queue (ksSchedulerAction_update f s) = valid_release_queue s"
-  by (simp add: valid_release_queue_def)
-
-lemma valid_release_queue'_ksSchedulerAction[simp]:
-  "valid_release_queue' (ksSchedulerAction_update f s) = valid_release_queue' s"
-  by (simp add: valid_release_queue'_def)
-
-lemma valid_release_queue'_ksWorkUnitsCompleted[simp]:
-  "valid_release_queue' (ksWorkUnitsCompleted_update f s) = valid_release_queue' s"
-  by (simp add: valid_release_queue'_def)
-
-lemma valid_release_queue'_ksReprogramTimer[simp]:
-  "valid_release_queue' (ksReprogramTimer_update f s) = valid_release_queue' s"
-  by (simp add: valid_release_queue'_def)
-
-lemma valid_release_queue'_ksDomainTime[simp]:
-  "valid_release_queue' (ksDomainTime_update f s) = valid_release_queue' s"
-  by (simp add: valid_release_queue'_def)
-
-lemma valid_release_queue'_ksCurDomain[simp]:
-  "valid_release_queue' (ksCurDomain_update f s) = valid_release_queue' s"
-  by (simp add: valid_release_queue'_def)
-
-lemma valid_release_queue'_ksDomScheduleIdx[simp]:
-  "valid_release_queue' (ksDomScheduleIdx_update f s) = valid_release_queue' s"
-  by (simp add: valid_release_queue'_def)
-
 lemma ex_cte_cap_wp_to_work_units[simp]:
   "ex_cte_cap_wp_to' P slot (ksWorkUnitsCompleted_update f s)
     = ex_cte_cap_wp_to' P slot s"
@@ -287,23 +258,18 @@ lemma ct_in_state_ksSched[simp]:
   apply auto
   done
 
-lemma invs'_wu[simp]:
+lemma invs'_wu [simp]:
   "invs' (ksWorkUnitsCompleted_update f s) = invs' s"
-  apply (simp add: invs'_def cur_tcb'_def valid_queues_def
-                   valid_queues'_def valid_release_queue_def valid_release_queue'_def
-                   valid_irq_node'_def valid_machine_state'_def ct_not_inQ_def
-                   ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def bitmapQ_defs
-                   valid_queues_no_bitmap_def valid_dom_schedule'_def)
+  apply (simp add: invs'_def cur_tcb'_def valid_state'_def valid_bitmaps_def
+                   valid_irq_node'_def valid_machine_state'_def
+                   ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def
+                   bitmapQ_defs)
   done
 
 lemma valid_arch_state'_interrupt[simp]:
   "valid_arch_state' (ksInterruptState_update f s) = valid_arch_state' s"
   by (simp add: valid_arch_state'_def cong: option.case_cong)
 
-lemma valid_inQ_queues_ksSchedulerAction_update[simp]:
-  "valid_inQ_queues (ksSchedulerAction_update f s) = valid_inQ_queues s"
-  by (simp add: valid_inQ_queues_def)
-
 lemma valid_bitmapQ_ksSchedulerAction_upd[simp]:
   "valid_bitmapQ (ksSchedulerAction_update f s) = valid_bitmapQ s"
   unfolding bitmapQ_defs by simp
@@ -349,15 +315,8 @@ lemma sch_act_simple_ksReadyQueuesL2Bitmap[simp]:
 
 lemma ksDomainTime_invs[simp]:
   "invs' (ksDomainTime_update f s) = invs' s"
-  by (simp add: invs'_def cur_tcb'_def
-                valid_release_queue_def valid_release_queue'_def
-                valid_machine_state'_def ct_not_inQ_def
-                ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def valid_dom_schedule'_def)
-
-lemma ksSchedulerAction_invs'[simp]:
-  "invs' (ksSchedulerAction_update f s) = invs' s"
-  by (auto simp: invs'_def valid_release_queue_def valid_release_queue'_def
-                 valid_machine_state'_def  valid_irq_node'_def valid_dom_schedule'_def)
+  by (simp add: invs'_def valid_state'_def cur_tcb'_def ct_not_inQ_def ct_idle_or_in_cur_domain'_def
+                tcb_in_cur_domain'_def valid_machine_state'_def bitmapQ_defs)
 
 lemma valid_machine_state'_ksDomainTime[simp]:
   "valid_machine_state' (ksDomainTime_update f s) = valid_machine_state' s"
@@ -385,98 +344,7 @@ lemma ct_not_inQ_update_stt[simp]:
 
 lemma invs'_update_cnt[elim!]:
   "invs' s \<Longrightarrow> invs' (s\<lparr>ksSchedulerAction := ChooseNewThread\<rparr>)"
-  by (clarsimp simp: invs'_def cur_tcb'_def valid_dom_schedule'_def
-                     valid_release_queue_def valid_release_queue'_def
-                     valid_irq_node'_def valid_machine_state'_def ct_not_inQ_def
-                     ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
-
-lemma ksReprogramTimer_update_misc[simp]:
-  "\<And>f. valid_machine_state' (ksReprogramTimer_update f s) = valid_machine_state' s"
-  "\<And>f. ct_not_inQ (ksReprogramTimer_update f s) = ct_not_inQ s"
-  "\<And>f. ct_idle_or_in_cur_domain' (ksReprogramTimer_update f s) = ct_idle_or_in_cur_domain' s"
-  "\<And>f. cur_tcb' (ksReprogramTimer_update f s) = cur_tcb' s"
-  apply (clarsimp simp: valid_machine_state'_def ct_not_inQ_def ct_idle_or_in_cur_domain'_def
-                        tcb_in_cur_domain'_def cur_tcb'_def)+
-  done
-
-lemma valid_machine_state'_ksReleaseQueue[simp]:
-  "valid_machine_state' (ksReleaseQueue_update f s) = valid_machine_state' s"
-  unfolding valid_machine_state'_def
-  by simp
-
-lemma ct_idle_or_in_cur_domain'_ksReleaseQueue[simp]:
-  "ct_idle_or_in_cur_domain' (ksReleaseQueue_update f s) = ct_idle_or_in_cur_domain' s"
-  unfolding ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def
-  by simp
-
-lemma valid_inQ_queues_updates[simp]:
-  "\<And>f. valid_inQ_queues (ksReprogramTimer_update f s) = valid_inQ_queues s"
-  "\<And>f. valid_inQ_queues (ksReleaseQueue_update f s) = valid_inQ_queues s"
-  by (auto simp: valid_inQ_queues_def)
-
-lemma valid_tcb_state'_update[simp]:
-  "\<And>f. valid_tcb_state' ts (ksReadyQueues_update f s) = valid_tcb_state' ts s"
-  "\<And>f. valid_tcb_state' ts (ksReadyQueuesL1Bitmap_update f s) = valid_tcb_state' ts s"
-  "\<And>f. valid_tcb_state' ts (ksReadyQueuesL2Bitmap_update f s) = valid_tcb_state' ts s"
-  by (auto simp: valid_tcb_state'_def valid_bound_obj'_def split: thread_state.splits option.splits)
-
-lemma ct_not_inQ_ksReleaseQueue_upd[simp]:
-  "ct_not_inQ (ksReleaseQueue_update f s) = ct_not_inQ s"
-  by (simp add: ct_not_inQ_def)
-
-lemma valid_irq_node'_ksReleaseQueue_upd[simp]:
-  "valid_irq_node' (irq_node' s) (ksReleaseQueue_update f s) = valid_irq_node' (irq_node' s) s"
-  by (simp add: valid_irq_node'_def)
-
-lemma cur_tcb'_ksReleaseQueue_upd[simp]:
-  "cur_tcb' (ksReleaseQueue_update f s) = cur_tcb' s"
-  by (simp add: cur_tcb'_def)
-
-lemma valid_queues_ksReleaseQueue_upd[simp]:
-  "valid_queues (ksReleaseQueue_update f s) = valid_queues s"
-  by (simp add: valid_queues_def valid_queues_no_bitmap_def valid_bitmapQ_def
-                bitmapQ_def bitmapQ_no_L1_orphans_def bitmapQ_no_L2_orphans_def)
-
-lemma valid_queues'_ksReleaseQueue_upd[simp]:
-  "valid_queues' (ksReleaseQueue_update f s) = valid_queues' s"
-  by (simp add: valid_queues'_def)
-
-lemma sch_act_sane_ksReprogramTimer[simp]:
-  "sch_act_sane (ksReprogramTimer_update f s) = sch_act_sane s"
-  by (simp add: sch_act_sane_def)
-
-lemma valid_obj'_scPeriod_update[simp]:
-  "valid_obj' (KOSchedContext (scPeriod_update (\<lambda>_. period) sc')) = valid_obj' (KOSchedContext sc')"
-  by (fastforce simp: valid_obj'_def valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
-
-lemma valid_sched_context_size'_scReply_update[simp]:
-  "valid_sched_context_size' (scReply_update f sc) = valid_sched_context_size' sc"
-  by (clarsimp simp: valid_sched_context_size'_def objBits_simps)
-
-lemma valid_sched_context'_scBadge_update[simp]:
-  "valid_sched_context' (scBadge_update f ko) s = valid_sched_context' ko s"
-  by (clarsimp simp: valid_sched_context'_def)
-
-lemma valid_sched_context_size'_scBadge_update[simp]:
-  "valid_sched_context_size' (scBadge_update f sc) = valid_sched_context_size' sc"
-  by (clarsimp simp: valid_sched_context_size'_def objBits_simps)
-
-lemma valid_sched_context'_scSporadic_update[simp]:
-  "valid_sched_context' (scSporadic_update f ko) s = valid_sched_context' ko s"
-  by (clarsimp simp: valid_sched_context'_def)
-
-lemma valid_sched_context_size'_scSporadic_update[simp]:
-  "valid_sched_context_size' (scSporadic_update f sc) = valid_sched_context_size' sc"
-  by (clarsimp simp: valid_sched_context_size'_def objBits_simps)
-
-lemma valid_tcb_yield_to_update[elim!]:
-  "valid_tcb tp tcb s \<Longrightarrow> sc_at scp s \<Longrightarrow> valid_tcb tp (tcb_yield_to_update (\<lambda>_. Some scp) tcb) s"
-  by (auto simp: valid_tcb_def tcb_cap_cases_def)
-
-lemma valid_ipc_buffer_ptr'_ks_updates[simp]:
-  "valid_ipc_buffer_ptr' buf (ksSchedulerAction_update f s) = valid_ipc_buffer_ptr' buf s"
-  "valid_ipc_buffer_ptr' buf (ksReprogramTimer_update g s) = valid_ipc_buffer_ptr' buf s"
-  "valid_ipc_buffer_ptr' buf (ksReleaseQueue_update h s) = valid_ipc_buffer_ptr' buf s"
-  by (simp add: valid_ipc_buffer_ptr'_def)+
+   by (clarsimp simp: invs'_def valid_state'_def valid_irq_node'_def cur_tcb'_def
+                      ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def bitmapQ_defs)
 
-end
+end
\ No newline at end of file
diff --git a/proof/refine/ARM/Invariants_H.thy b/proof/refine/ARM/Invariants_H.thy
index 52ea6db418..6998f10290 100644
--- a/proof/refine/ARM/Invariants_H.thy
+++ b/proof/refine/ARM/Invariants_H.thy
@@ -7,16 +7,12 @@
 theory Invariants_H
 imports
   LevityCatch
+  "AInvs.Deterministic_AI"
   "AInvs.AInvs"
   "Lib.AddUpdSimps"
-  ArchMove_R
-  "Lib.Heap_List"
+  Lib.Heap_List
 begin
 
-(* FIXME: this should go somewhere in spec *)
-translations
-  (type) "'a kernel" <=(type) "kernel_state \<Rightarrow> ('a \<times> kernel_state) set \<times> bool"
-
 context Arch begin
 lemmas [crunch_def] =
   deriveCap_def finaliseCap_def
@@ -51,7 +47,7 @@ lemma le_maxDomain_eq_less_numDomains:
   by (auto simp: Kernel_Config.numDomains_def maxDomain_def word_le_nat_alt)
 
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 \<comment> \<open>---------------------------------------------------------------------------\<close>
 section "Invariants on Executable Spec"
 
@@ -66,18 +62,9 @@ definition
 definition
   "ko_wp_at' P p s \<equiv>
    \<exists>ko. ksPSpace s p = Some ko \<and> is_aligned p (objBitsKO ko) \<and> P ko \<and>
-        ps_clear p (objBitsKO ko) s \<and> objBitsKO ko < word_bits"
-
-lemma valid_sz_simps:
-  "objBitsKO ko < word_bits =
-    (case ko of
-      KOSchedContext sc \<Rightarrow> minSchedContextBits + scSize sc < word_bits
-    | _ \<Rightarrow>    True)"
-  by (cases ko;
-      clarsimp simp: objBits_def objBitsKO_def word_size_def archObjSize_def pageBits_def word_bits_def
-                     tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def cteSizeBits_def word_size
-                     pdeBits_def pteBits_def wordSizeCase_def wordBits_def replySizeBits_def
-              split: arch_kernel_object.splits)
+        ps_clear p (objBitsKO ko) s"
+
+
 
 definition
   obj_at' :: "('a::pspace_storable \<Rightarrow> bool) \<Rightarrow> word32 \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -91,17 +78,13 @@ where
   "typ_at' T \<equiv> ko_wp_at' (\<lambda>ko. koTypeOf ko = T)"
 
 abbreviation
-  "ep_at' \<equiv> obj_at' (\<lambda>_ :: endpoint. True)"
-abbreviation
-  "ntfn_at' \<equiv> obj_at' (\<lambda>_:: notification. True)"
+  "ep_at' \<equiv> obj_at' ((\<lambda>x. True) :: endpoint \<Rightarrow> bool)"
 abbreviation
-  "tcb_at' \<equiv> obj_at' (\<lambda>_:: tcb. True)"
+  "ntfn_at' \<equiv> obj_at' ((\<lambda>x. True) :: Structures_H.notification \<Rightarrow> bool)"
 abbreviation
-  "real_cte_at' \<equiv> obj_at' (\<lambda>_ :: cte. True)"
+  "tcb_at' \<equiv> obj_at' ((\<lambda>x. True) :: tcb \<Rightarrow> bool)"
 abbreviation
-  "sc_at' \<equiv> obj_at' (\<lambda>_ :: sched_context. True)"
-abbreviation
-  "reply_at' \<equiv> obj_at' (\<lambda>_ :: reply. True)"
+  "real_cte_at' \<equiv> obj_at' ((\<lambda>x. True) :: cte \<Rightarrow> bool)"
 
 abbreviation
   "ko_at' v \<equiv> obj_at' (\<lambda>k. k = v)"
@@ -112,60 +95,49 @@ abbreviation
   "pte_at' \<equiv> typ_at' (ArchT PTET)"
 end
 
-
 record itcb' =
-  itcbState             :: thread_state
-  itcbIPCBuffer         :: vptr
-  itcbBoundNotification :: "word32 option"
-  itcbPriority          :: priority
-  itcbFault             :: "fault option"
-  itcbMCP               :: priority
-  itcbSchedContext      :: "obj_ref option"
-  itcbYieldTo           :: "obj_ref option"
-
-definition tcb_to_itcb' :: "tcb \<Rightarrow> itcb'" where
-  "tcb_to_itcb' tcb \<equiv> \<lparr> itcbState             = tcbState tcb,
-                        itcbIPCBuffer         = tcbIPCBuffer tcb,
-                        itcbBoundNotification = tcbBoundNotification tcb,
-                        itcbPriority          = tcbPriority tcb,
-                        itcbFault             = tcbFault tcb,
-                        itcbMCP               = tcbMCP tcb,
-                        itcbSchedContext      = tcbSchedContext tcb,
-                        itcbYieldTo           = tcbYieldTo tcb\<rparr>"
-
-lemma itcbState[simp]:
-  "itcbState (tcb_to_itcb' tcb) = tcbState tcb"
+  itcbState          :: thread_state
+  itcbFaultHandler   :: cptr
+  itcbIPCBuffer      :: vptr
+  itcbBoundNotification       :: "word32 option"
+  itcbPriority       :: priority
+  itcbFault          :: "fault option"
+  itcbTimeSlice      :: nat
+  itcbMCP            :: priority
+
+definition "tcb_to_itcb' tcb \<equiv> \<lparr> itcbState        = tcbState tcb,
+                                 itcbFaultHandler = tcbFaultHandler tcb,
+                                 itcbIPCBuffer    = tcbIPCBuffer tcb,
+                                 itcbBoundNotification     = tcbBoundNotification tcb,
+                                 itcbPriority     = tcbPriority tcb,
+                                 itcbFault        = tcbFault tcb,
+                                 itcbTimeSlice    = tcbTimeSlice tcb,
+                                 itcbMCP          = tcbMCP tcb\<rparr>"
+
+lemma [simp]: "itcbState (tcb_to_itcb' tcb) = tcbState tcb"
   by (auto simp: tcb_to_itcb'_def)
 
-lemma itcbIPCBuffer[simp]:
-  "itcbIPCBuffer (tcb_to_itcb' tcb) = tcbIPCBuffer tcb"
+lemma [simp]: "itcbFaultHandler (tcb_to_itcb' tcb) = tcbFaultHandler tcb"
   by (auto simp: tcb_to_itcb'_def)
 
-lemma itcbBoundNotification[simp]:
-  "itcbBoundNotification (tcb_to_itcb' tcb) = tcbBoundNotification tcb"
+lemma [simp]: "itcbIPCBuffer (tcb_to_itcb' tcb) = tcbIPCBuffer tcb"
   by (auto simp: tcb_to_itcb'_def)
 
-lemma itcbPriority[simp]:
-  "itcbPriority (tcb_to_itcb' tcb) = tcbPriority tcb"
+lemma [simp]: "itcbBoundNotification (tcb_to_itcb' tcb) = tcbBoundNotification tcb"
   by (auto simp: tcb_to_itcb'_def)
 
-lemma itcbFault[simp]:
-  "itcbFault (tcb_to_itcb' tcb) = tcbFault tcb"
+lemma [simp]: "itcbPriority (tcb_to_itcb' tcb) = tcbPriority tcb"
   by (auto simp: tcb_to_itcb'_def)
 
-lemma itcbMCP[simp]:
-  "itcbMCP (tcb_to_itcb' tcb) = tcbMCP tcb"
+lemma [simp]: "itcbFault (tcb_to_itcb' tcb) = tcbFault tcb"
   by (auto simp: tcb_to_itcb'_def)
 
-lemma itcbSchedContext[simp]:
-  "itcbSchedContext (tcb_to_itcb' tcb) = tcbSchedContext tcb"
+lemma [simp]: "itcbTimeSlice (tcb_to_itcb' tcb) = tcbTimeSlice tcb"
   by (auto simp: tcb_to_itcb'_def)
 
-lemma itcbYieldTo[simp]:
-  "itcbYieldTo (tcb_to_itcb' tcb) = tcbYieldTo tcb"
+lemma [simp]: "itcbMCP (tcb_to_itcb' tcb) = tcbMCP tcb"
   by (auto simp: tcb_to_itcb'_def)
 
-
 definition
   pred_tcb_at' :: "(itcb' \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> word32 \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
@@ -173,18 +145,12 @@ where
 
 abbreviation "st_tcb_at' \<equiv> pred_tcb_at' itcbState"
 abbreviation "bound_tcb_at' \<equiv> pred_tcb_at' itcbBoundNotification"
-abbreviation "bound_sc_tcb_at' \<equiv> pred_tcb_at' itcbSchedContext"
-abbreviation "bound_yt_tcb_at' \<equiv> pred_tcb_at' itcbYieldTo"
 abbreviation "mcpriority_tcb_at' \<equiv> pred_tcb_at' itcbMCP"
 
 lemma st_tcb_at'_def:
   "st_tcb_at' test \<equiv> obj_at' (test \<circ> tcbState)"
   by (simp add: pred_tcb_at'_def o_def)
 
-definition
-  active_sc_at' :: "word32 \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
-  "active_sc_at' \<equiv> obj_at' (\<lambda>ko :: sched_context. 0 < scRefillMax ko)"
 
 text \<open>cte with property at\<close>
 definition
@@ -193,105 +159,6 @@ definition
 abbreviation
   "cte_at' \<equiv> cte_wp_at' \<top>"
 
-text \<open>replyNext aliases\<close>
-
-abbreviation
-  "replySC \<equiv> \<lambda>r. getHeadScPtr (replyNext r)"
-
-abbreviation
-  "replyNext_of \<equiv> \<lambda>r. getReplyNextPtr (replyNext r)"
-
-lemma getReplyNextPtr_None[simp]:
-  "getReplyNextPtr None = None" by (simp add: getReplyNextPtr_def)
-
-lemma getHeadScPtr_None[simp]:
-  "getHeadScPtr None = None" by (simp add: getHeadScPtr_def)
-
-lemma getReplyNextPtr_Some_Next[simp]:
-  "getReplyNextPtr (Some (Next rn)) = Some rn" by (simp add: getReplyNextPtr_def)
-
-lemma getHeadScPtr_Some_Head[simp]:
-  "getHeadScPtr (Some (Head sc)) = Some sc" by (simp add: getHeadScPtr_def)
-
-lemma theReplyNextPtr_Some_Next[simp]:
-  "theReplyNextPtr (Some (Next rn)) = rn" by (simp add: theReplyNextPtr_def)
-
-lemma theHeadScPtr_Some_Head[simp]:
-  "theHeadScPtr (Some (Head sc)) = sc" by (simp add: theHeadScPtr_def)
-
-lemma getReplyNextPtr_Some_iff[iff]:
-  "(getReplyNextPtr x) = (Some rn) \<longleftrightarrow> x = Some (Next rn)"
-  by (cases x; clarsimp simp: getReplyNextPtr_def split: reply_next.split)
-
-lemma getHeadScPtr_Some_iff[iff]:
-  "(getHeadScPtr x) = (Some rn) \<longleftrightarrow> x = Some (Head rn)"
-  by (cases x; clarsimp simp: getHeadScPtr_def split: reply_next.split)
-
-lemma getReplyNextPtr_None_iff:
-  "(getReplyNextPtr x) = None \<longleftrightarrow> (\<forall>rn. x \<noteq> Some (Next rn))"
-  by (cases x; clarsimp simp: getReplyNextPtr_def split: reply_next.split)
-
-lemma getHeadScPtr_None_iff:
-  "(getHeadScPtr x) = None \<longleftrightarrow> (\<forall>rn. x \<noteq> Some (Head rn))"
-  by (cases x; clarsimp simp: getHeadScPtr_def split: reply_next.split)
-
-lemma replyNext_None_iff:
-  "replyNext r = None \<longleftrightarrow> replyNext_of r = None \<and> replySC r = None"
-  apply (cases "replyNext r"; clarsimp)
-  apply (case_tac a; clarsimp)
-  done
-
-lemma getReplyNextPtr_Head_None[simp]:
-  "getReplyNextPtr (Some (Head rn)) = None" by (simp add: getReplyNextPtr_def)
-
-lemma getHeadScPtr_Next_None[simp]:
-  "getHeadScPtr (Some (Next sc)) = None" by (simp add: getHeadScPtr_def)
-
-text \<open>Heap projections:\<close>
-abbreviation reply_of' :: "kernel_object \<Rightarrow> reply option" where
-  "reply_of' \<equiv> projectKO_opt"
-
-abbreviation replies_of' :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> reply option" where
-  "replies_of' s \<equiv> ksPSpace s |> reply_of'"
-
-abbreviation replyNexts_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
-  "replyNexts_of s \<equiv> replies_of' s |> replyNext_of"
-
-abbreviation replyPrevs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
-  "replyPrevs_of s \<equiv> replies_of' s |> replyPrev"
-
-abbreviation replyTCBs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
-  "replyTCBs_of s \<equiv> replies_of' s |> replyTCB"
-
-abbreviation replySCs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
-  "replySCs_of s \<equiv> replies_of' s |> replySC"
-
-abbreviation sc_of' :: "kernel_object \<Rightarrow> sched_context option" where
-  "sc_of' \<equiv> projectKO_opt"
-
-abbreviation scs_of' :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> sched_context option" where
-  "scs_of' s \<equiv> ksPSpace s |> sc_of'"
-
-abbreviation scReplies_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
-  "scReplies_of s \<equiv> scs_of' s |> scReply"
-
-abbreviation tcb_of' :: "kernel_object \<Rightarrow> tcb option" where
-  "tcb_of' \<equiv> projectKO_opt"
-
-abbreviation tcbs_of' :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> tcb option" where
-  "tcbs_of' s \<equiv> ksPSpace s |> tcb_of'"
-
-abbreviation tcbSCs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
-  "tcbSCs_of s \<equiv> tcbs_of' s |> tcbSchedContext"
-
-abbreviation scTCBs_of :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> obj_ref option" where
-  "scTCBs_of s \<equiv> scs_of' s |> scTCB"
-
-abbreviation sym_heap_tcbSCs where
-  "sym_heap_tcbSCs s \<equiv> sym_heap (tcbSCs_of s) (scTCBs_of s)"
-
-abbreviation sym_heap_scReplies where
-  "sym_heap_scReplies s \<equiv> sym_heap (scReplies_of s) (replySCs_of s)"
 abbreviation tcb_of' :: "kernel_object \<Rightarrow> tcb option" where
   "tcb_of' \<equiv> projectKO_opt"
 
@@ -317,169 +184,137 @@ where
                    64 \<mapsto> (tcbIPCBufferFrame, tcbIPCBufferFrame_update) ]"
 
 definition
-  tcb_cte_cases :: "word32 \<rightharpoonup> ((tcb \<Rightarrow> cte) \<times> ((cte \<Rightarrow> cte) \<Rightarrow> tcb \<Rightarrow> tcb))" where
- "tcb_cte_cases \<equiv> [    0 \<mapsto> (tcbCTable, tcbCTable_update),
-                    0x10 \<mapsto> (tcbVTable, tcbVTable_update),
-                    0x20 \<mapsto> (tcbIPCBufferFrame, tcbIPCBufferFrame_update),
-                    0x30 \<mapsto> (tcbFaultHandler, tcbFaultHandler_update),
-                    0x40 \<mapsto> (tcbTimeoutHandler, tcbTimeoutHandler_update)
-                   ]"
-
-definition
-  max_ipc_words :: word32 where
+  max_ipc_words :: word32
+where
   "max_ipc_words \<equiv> capTransferDataSize + msgMaxLength + msgMaxExtraCaps + 2"
 
-type_synonym ref_set = "(obj_ref \<times> reftype) set"
-
-definition tcb_st_refs_of' :: "thread_state \<Rightarrow> ref_set" where
-  "tcb_st_refs_of' z \<equiv> case z of
-    Running                    => {}
-  | Inactive                   => {}
-  | Restart                    => {}
-  | (BlockedOnReply r)         => if bound r then {(the r, TCBReply)} else {}
-  | IdleThreadState            => {}
-  | (BlockedOnReceive x _ r)   => if bound r then {(x, TCBBlockedRecv), (the r, TCBReply)}
-                                  else {(x, TCBBlockedRecv)}
-  | (BlockedOnSend x _ _ _ _)  => {(x, TCBBlockedSend)}
-  | (BlockedOnNotification x)  => {(x, TCBSignal)}"
+definition
+  tcb_st_refs_of' :: "Structures_H.thread_state \<Rightarrow> (word32 \<times> reftype) set"
+where
+  "tcb_st_refs_of' z \<equiv> case z of (Running)                  => {}
+  | (Inactive)                 => {}
+  | (Restart)                  => {}
+  | (BlockedOnReceive x a)     => {(x, TCBBlockedRecv)}
+  | (BlockedOnSend x a b c d)  => {(x, TCBBlockedSend)}
+  | (BlockedOnNotification x)  => {(x, TCBSignal)}
+  | (BlockedOnReply)           => {}
+  | (IdleThreadState)          => {}"
 
 definition
-  tcb_bound_refs' ::
-  "word32 option \<Rightarrow> word32 option \<Rightarrow> word32 option \<Rightarrow> ref_set" where
-  "tcb_bound_refs' ntfn sc yt \<equiv> get_refs TCBBound ntfn
-                                  \<union> get_refs TCBSchedContext sc
-                                  \<union> get_refs TCBYieldTo yt"
-
-definition refs_of_tcb' :: "tcb \<Rightarrow> ref_set" where
-  "refs_of_tcb' tcb \<equiv>
-     tcb_st_refs_of' (tcbState tcb)
-       \<union> tcb_bound_refs' (tcbBoundNotification tcb) (tcbSchedContext tcb) (tcbYieldTo tcb)"
-
-definition ep_q_refs_of' :: "endpoint \<Rightarrow> ref_set" where
+  ep_q_refs_of'   :: "Structures_H.endpoint       \<Rightarrow> (word32 \<times> reftype) set"
+where
   "ep_q_refs_of' x \<equiv> case x of
-     IdleEP    => {}
-   | (RecvEP q) => set q \<times> {EPRecv}
-   | (SendEP q) => set q \<times> {EPSend}"
+  IdleEP    => {}
+  | (RecvEP q) => set q \<times> {EPRecv}
+  | (SendEP q) => set q \<times> {EPSend}"
 
-definition ntfn_q_refs_of' :: "ntfn \<Rightarrow> ref_set" where
-  "ntfn_q_refs_of' x \<equiv> case x of
-     IdleNtfn        => {}
-   | (WaitingNtfn q) => set q \<times> {NTFNSignal}
-   | (ActiveNtfn b)  => {}"
+definition
+  ntfn_q_refs_of'  :: "Structures_H.ntfn \<Rightarrow> (word32 \<times> reftype) set"
+where
+  "ntfn_q_refs_of' x \<equiv> case x of  IdleNtfn         => {}
+  | (WaitingNtfn q)      => set q \<times> {NTFNSignal}
+  | (ActiveNtfn b)  => {}"
 
-definition ntfn_bound_refs' :: "word32 option \<Rightarrow> ref_set" where
+definition
+  ntfn_bound_refs' :: "word32 option \<Rightarrow> (word32 \<times> reftype) set"
+where
   "ntfn_bound_refs' t \<equiv> set_option t \<times> {NTFNBound}"
 
-definition refs_of_ntfn' :: "notification \<Rightarrow> ref_set" where
-  "refs_of_ntfn' ntfn \<equiv> ntfn_q_refs_of' (ntfnObj ntfn)
-                          \<union> get_refs NTFNBound (ntfnBoundTCB ntfn)
-                          \<union> get_refs NTFNSchedContext (ntfnSc ntfn)"
-
-definition refs_of_sc' :: "sched_context \<Rightarrow> ref_set" where
-  "refs_of_sc' sc \<equiv> get_refs SCNtfn (scNtfn sc)
-                          \<union> get_refs SCTcb (scTCB sc)
-                          \<union> get_refs SCYieldFrom (scYieldFrom sc)
-                          \<union> get_refs SCReply (scReply sc)"
-
-definition refs_of_reply' :: "reply \<Rightarrow> ref_set" where
-  "refs_of_reply' r \<equiv> get_refs ReplySchedContext (replySC r)
-                          \<union> get_refs ReplyTCB (replyTCB r)"
-
-definition list_refs_of_reply' :: "reply \<Rightarrow> ref_set" where
-  "list_refs_of_reply' r = get_refs ReplyNext (replyNext_of r) \<union> get_refs ReplyPrev (replyPrev r)"
-
-abbreviation list_refs_of_replies_opt' :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> ref_set option" where
-  "list_refs_of_replies_opt' s \<equiv> replies_of' s ||> list_refs_of_reply'"
-
-abbreviation list_refs_of_replies' :: "kernel_state \<Rightarrow> obj_ref \<Rightarrow> ref_set" where
-  "list_refs_of_replies' s \<equiv> map_set (list_refs_of_replies_opt' s)"
-
-lemmas list_refs_of_replies'_def = map_set_def
-
-lemmas refs_of'_defs[simp] = refs_of_tcb'_def refs_of_ntfn'_def refs_of_sc'_def refs_of_reply'_def
+definition
+  tcb_bound_refs' :: "word32 option \<Rightarrow> (word32 \<times> reftype) set"
+where
+  "tcb_bound_refs' a \<equiv> set_option a \<times> {TCBBound}"
 
-definition refs_of' :: "kernel_object \<Rightarrow> ref_set" where
+definition
+  refs_of'        :: "Structures_H.kernel_object  \<Rightarrow> (word32 \<times> reftype) set"
+where
   "refs_of' x \<equiv> case x of
-    (KOTCB tcb)           => refs_of_tcb' tcb
+    (KOTCB tcb) => tcb_st_refs_of' (tcbState tcb) \<union> tcb_bound_refs' (tcbBoundNotification tcb)
   | (KOCTE cte)           => {}
   | (KOEndpoint ep)       => ep_q_refs_of' ep
-  | (KONotification ntfn) => refs_of_ntfn' ntfn
-  | (KOSchedContext sc)   => refs_of_sc' sc
-  | (KOReply r)           => refs_of_reply' r
-  | _                     => {}"
-
-definition state_refs_of' :: "kernel_state \<Rightarrow> word32 \<Rightarrow> ref_set" where
- "state_refs_of' s \<equiv> \<lambda>x. case ksPSpace s x of
-                            None \<Rightarrow> {}
-                          | Some ko \<Rightarrow>
-                              if is_aligned x (objBitsKO ko) \<and> ps_clear x (objBitsKO ko) s
-                                 \<and> objBitsKO ko < word_bits
-                              then refs_of' ko
-                              else {}"
-
-defs sym_refs_asrt_def:
-  "sym_refs_asrt \<equiv> \<lambda>s. sym_refs (state_refs_of' s)"
-
-definition live_sc' :: "sched_context \<Rightarrow> bool" where
-  "live_sc' sc \<equiv> bound (scTCB sc) \<and> scTCB sc \<noteq> Some idle_thread_ptr
-                  \<or> bound (scYieldFrom sc) \<or> bound (scNtfn sc) \<or> scReply sc \<noteq> None"
-
-definition live_ntfn' :: "notification \<Rightarrow> bool" where
-  "live_ntfn' ntfn \<equiv> bound (ntfnBoundTCB ntfn) \<or> bound (ntfnSc ntfn)
-                      \<or> (\<exists>ts. ntfnObj ntfn = WaitingNtfn ts)"
-
-definition live_reply' :: "reply \<Rightarrow> bool" where
-  "live_reply' reply \<equiv> bound (replyTCB reply) \<or> bound (replyNext reply) \<or> bound (replyPrev reply)"
-
-primrec live' :: "Structures_H.kernel_object \<Rightarrow> bool" where
+  | (KONotification ntfn)     => ntfn_q_refs_of' (ntfnObj ntfn) \<union> ntfn_bound_refs' (ntfnBoundTCB ntfn)
+  | (KOUserData)          => {}
+  | (KOUserDataDevice)    => {}
+  | (KOKernelData)        => {}
+  | (KOArch ako)          => {}"
+
+definition
+  state_refs_of' :: "kernel_state \<Rightarrow> word32 \<Rightarrow> (word32 \<times> reftype) set"
+where
+ "state_refs_of' s \<equiv> (\<lambda>x. case (ksPSpace s x)
+                           of None \<Rightarrow> {}
+                            | Some ko \<Rightarrow>
+                              (if is_aligned x (objBitsKO ko) \<and> ps_clear x (objBitsKO ko) s
+                               then refs_of' ko
+                               else {}))"
+
+primrec
+  live' :: "Structures_H.kernel_object \<Rightarrow> bool"
+where
   "live' (KOTCB tcb) =
-     (bound (tcbBoundNotification tcb) \<or>
-      bound (tcbSchedContext tcb) \<and> tcbSchedContext tcb \<noteq> Some idle_sc_ptr \<or>
-      bound (tcbYieldTo tcb) \<or>
-      tcbState tcb \<noteq> Inactive \<and> tcbState tcb \<noteq> IdleThreadState \<or>
-      tcbQueued tcb)"
+     (bound (tcbBoundNotification tcb)
+      \<or> tcbSchedPrev tcb \<noteq> None \<or> tcbSchedNext tcb \<noteq> None
+      \<or> tcbQueued tcb
+      \<or> (tcbState tcb \<noteq> Inactive \<and> tcbState tcb \<noteq> IdleThreadState))"
 | "live' (KOCTE cte)           = False"
 | "live' (KOEndpoint ep)       = (ep \<noteq> IdleEP)"
-| "live' (KONotification ntfn) = live_ntfn' ntfn"
-| "live' (KOSchedContext sc)   = live_sc' sc"
-| "live' (KOReply r)           = live_reply' r"
+| "live' (KONotification ntfn)     = (bound (ntfnBoundTCB ntfn) \<or> (\<exists>ts. ntfnObj ntfn = WaitingNtfn ts))"
 | "live' (KOUserData)          = False"
 | "live' (KOUserDataDevice)    = False"
 | "live' (KOKernelData)        = False"
 | "live' (KOArch ako)          = False"
 
-fun zobj_refs' :: "capability \<Rightarrow> word32 set" where
-  "zobj_refs' (EndpointCap r _ _ _ _ _)  = {r}"
-| "zobj_refs' (NotificationCap r _ _ _)  = {r}"
-| "zobj_refs' (ThreadCap r)              = {r}"
-| "zobj_refs' (SchedContextCap r _)      = {r}"
-| "zobj_refs' (ReplyCap r _)             = {r}"
-| "zobj_refs'                 _          = {}"
-
-definition ex_nonz_cap_to' :: "word32 \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "ex_nonz_cap_to' ref \<equiv> \<lambda>s. \<exists>cref. cte_wp_at' (\<lambda>c. ref \<in> zobj_refs' (cteCap c)) cref s"
-
-definition if_live_then_nonz_cap' :: "kernel_state \<Rightarrow> bool" where
-  "if_live_then_nonz_cap' s \<equiv> \<forall>ptr. ko_wp_at' live' ptr s \<longrightarrow> ex_nonz_cap_to' ptr s"
-
-primrec cte_refs' :: "capability \<Rightarrow> word32 \<Rightarrow> word32 set" where
-  "cte_refs' (UntypedCap _ _ _ _) _      = {}"
-| "cte_refs' NullCap _                   = {}"
-| "cte_refs' DomainCap _                 = {}"
-| "cte_refs' (EndpointCap _ _ _ _ _ _) _ = {}"
-| "cte_refs' (NotificationCap _ _ _ _) _ = {}"
-| "cte_refs' (CNodeCap ref bits _ _) x   = (\<lambda>x. ref + (x * 2^cteSizeBits)) ` {0 .. 2 ^ bits - 1}"
-| "cte_refs' (ThreadCap ref) x           = (\<lambda>x. ref + x) ` (dom tcb_cte_cases)"
-| "cte_refs' (Zombie r _ n) x            = (\<lambda>x. r + (x * 2 ^ cteSizeBits)) ` {0 ..< of_nat n}"
-| "cte_refs' (ArchObjectCap _) _         = {}"
-| "cte_refs' (IRQControlCap) _           = {}"
-| "cte_refs' (IRQHandlerCap irq) x       = {x + (ucast irq) * 16}"
-| "cte_refs' (ReplyCap _ _) _            = {}"
-| "cte_refs' (SchedContextCap _ _) _     = {}"
-| "cte_refs' SchedControlCap _           = {}"
+primrec
+  zobj_refs' :: "capability \<Rightarrow> word32 set"
+where
+  "zobj_refs' NullCap                        = {}"
+| "zobj_refs' DomainCap                      = {}"
+| "zobj_refs' (UntypedCap d r n f)           = {}"
+| "zobj_refs' (EndpointCap r badge x y z t)  = {r}"
+| "zobj_refs' (NotificationCap r badge x y)  = {r}"
+| "zobj_refs' (CNodeCap r b g gsz)           = {}"
+| "zobj_refs' (ThreadCap r)                  = {r}"
+| "zobj_refs' (Zombie r b n)                 = {}"
+| "zobj_refs' (ArchObjectCap ac)             = {}"
+| "zobj_refs' (IRQControlCap)                = {}"
+| "zobj_refs' (IRQHandlerCap irq)            = {}"
+| "zobj_refs' (ReplyCap tcb m x)             = {}"
+
+definition
+  ex_nonz_cap_to' :: "word32 \<Rightarrow> kernel_state \<Rightarrow> bool"
+where
+  "ex_nonz_cap_to' ref \<equiv>
+   (\<lambda>s. \<exists>cref. cte_wp_at' (\<lambda>c. ref \<in> zobj_refs' (cteCap c)) cref s)"
+
+definition
+  if_live_then_nonz_cap' :: "kernel_state \<Rightarrow> bool"
+where
+ "if_live_then_nonz_cap' s \<equiv>
+    \<forall>ptr. ko_wp_at' live' ptr s \<longrightarrow> ex_nonz_cap_to' ptr s"
+
+
+primrec
+  cte_refs' :: "capability \<Rightarrow> word32 \<Rightarrow> word32 set"
+where
+  "cte_refs' (UntypedCap d p n f) x               = {}"
+| "cte_refs' (NullCap) x                          = {}"
+| "cte_refs' (DomainCap) x                        = {}"
+| "cte_refs' (EndpointCap ref badge s r g gr) x   = {}"
+| "cte_refs' (NotificationCap ref badge s r) x    = {}"
+| "cte_refs' (CNodeCap ref bits g gs) x           =
+     (\<lambda>x. ref + (x * 2 ^ cteSizeBits)) ` {0 .. 2 ^ bits - 1}"
+| "cte_refs' (ThreadCap ref) x                    =
+     (\<lambda>x. ref + x) ` (dom tcb_cte_cases)"
+| "cte_refs' (Zombie r b n) x                     =
+     (\<lambda>x. r + (x * 2 ^ cteSizeBits)) ` {0 ..< of_nat n}"
+| "cte_refs' (ArchObjectCap cap) x                = {}"
+| "cte_refs' (IRQControlCap) x                    = {}"
+| "cte_refs' (IRQHandlerCap irq) x                = {x + (ucast irq) * 16}"
+| "cte_refs' (ReplyCap tcb m g) x                 = {}"
+
 
 abbreviation
-  "irq_node' s \<equiv> intStateIRQNode (ksInterruptState s)"
+ "irq_node' s \<equiv> intStateIRQNode (ksInterruptState s)"
 
 definition
   ex_cte_cap_wp_to' :: "(capability \<Rightarrow> bool) \<Rightarrow> word32 \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -499,7 +334,7 @@ where
 section "Valid caps and objects (Haskell)"
 
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 primrec
   acapBits :: "arch_capability \<Rightarrow> nat"
 where
@@ -517,27 +352,28 @@ where
   "zBits (ZombieCNode n) = objBits (undefined::cte) + n"
 | "zBits (ZombieTCB) = tcbBlockSizeBits"
 
-primrec capBits :: "capability \<Rightarrow> nat" where
+primrec
+ capBits :: "capability \<Rightarrow> nat"
+where
   "capBits NullCap = 0"
 | "capBits DomainCap = 0"
 | "capBits (UntypedCap d r b f) = b"
 | "capBits (EndpointCap r b x y z t) = objBits (undefined::endpoint)"
-| "capBits (NotificationCap r b x y) = objBits (undefined::notification)"
+| "capBits (NotificationCap r b x y) = objBits (undefined::Structures_H.notification)"
 | "capBits (CNodeCap r b g gs) = objBits (undefined::cte) + b"
 | "capBits (ThreadCap r) = objBits (undefined::tcb)"
 | "capBits (Zombie r z n) = zBits z"
 | "capBits (IRQControlCap) = 0"
 | "capBits (IRQHandlerCap irq) = 0"
-| "capBits (ReplyCap tcb m) = objBits (undefined :: reply)"
-| "capBits (SchedContextCap sc n) = n"
-| "capBits SchedControlCap = 0"
+| "capBits (ReplyCap tcb m x) = objBits (undefined :: tcb)"
 | "capBits (ArchObjectCap x) = acapBits x"
 
 lemmas objBits_defs =
-  tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def cteSizeBits_def replySizeBits_def
+  tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def cteSizeBits_def
 
-definition capAligned :: "capability \<Rightarrow> bool" where
-  "capAligned c \<equiv> is_aligned (capUntypedPtr c) (capBits c) \<and> capBits c < word_bits"
+definition
+  "capAligned c \<equiv>
+   is_aligned (capUntypedPtr c) (capBits c) \<and> capBits c < word_bits"
 
 definition
  "obj_range' (p::word32) ko \<equiv> {p .. p + 2 ^ objBitsKO ko - 1}"
@@ -555,7 +391,7 @@ definition
 
 
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 definition
   page_table_at' :: "word32 \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -572,15 +408,16 @@ where
 abbreviation
   "asid_pool_at' \<equiv> typ_at' (ArchT ASIDPoolT)"
 
+(* FIXME: duplicated with vmsz_aligned *)
+definition
+  "vmsz_aligned' ref sz \<equiv> is_aligned ref (pageBitsForSize sz)"
+
 primrec
   zombieCTEs :: "zombie_type \<Rightarrow> nat"
 where
   "zombieCTEs ZombieTCB = 5"
 | "zombieCTEs (ZombieCNode n) = (2 ^ n)"
 
-abbreviation
-  "sc_at'_n n \<equiv> ko_wp_at' (\<lambda>ko. koTypeOf ko = SchedContextT \<and> objBitsKO ko = n)"
-
 definition
   valid_cap' :: "capability \<Rightarrow> kernel_state \<Rightarrow> bool"
 where valid_cap'_def:
@@ -598,12 +435,9 @@ where valid_cap'_def:
     guard && mask guard_sz = guard \<and>
     (\<forall>addr. real_cte_at' (r + 2^cteSizeBits * (addr && mask bits)) s)
   | Structures_H.ThreadCap r \<Rightarrow> tcb_at' r s
-  | Structures_H.ReplyCap r m \<Rightarrow> reply_at' r s
+  | Structures_H.ReplyCap r m x \<Rightarrow> tcb_at' r s
   | Structures_H.IRQControlCap \<Rightarrow> True
   | Structures_H.IRQHandlerCap irq \<Rightarrow> irq \<le> maxIRQ
-  | Structures_H.SchedControlCap \<Rightarrow> True
-  | Structures_H.SchedContextCap sc n \<Rightarrow> sc_at'_n n sc s
-             \<and> minSchedContextBits \<le> n \<and> n \<le> maxUntypedSizeBits
   | Structures_H.Zombie r b n \<Rightarrow> n \<le> zombieCTEs b \<and> zBits b < word_bits
             \<and> (case b of ZombieTCB \<Rightarrow> tcb_at' r s | ZombieCNode n \<Rightarrow> n \<noteq> 0
                     \<and> (\<forall>addr. real_cte_at' (r + 2^cteSizeBits * (addr && mask n)) s))
@@ -615,7 +449,7 @@ where valid_cap'_def:
     (\<forall>p < 2 ^ (pageBitsForSize sz - pageBits). typ_at' (if d then UserDataDeviceT else UserDataT)
     (ref + p * 2 ^ pageBits) s) \<and>
     (case mapdata of None \<Rightarrow> True | Some (asid, ref) \<Rightarrow>
-            0 < asid \<and> asid \<le> 2 ^ asid_bits - 1 \<and> vmsz_aligned ref sz \<and> ref < pptrBase)
+            0 < asid \<and> asid \<le> 2 ^ asid_bits - 1 \<and> vmsz_aligned' ref sz \<and> ref < pptrBase)
   | PageTableCap ref mapdata \<Rightarrow>
     page_table_at' ref s \<and>
     (case mapdata of None \<Rightarrow> True | Some (asid, ref) \<Rightarrow>
@@ -634,36 +468,27 @@ definition
 where
   "valid_cte' cte s \<equiv> s \<turnstile>' (cteCap cte)"
 
-definition valid_bound_obj' ::
-  "(machine_word \<Rightarrow> kernel_state \<Rightarrow> bool) \<Rightarrow> machine_word option \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "valid_bound_obj' f p_opt s \<equiv> case p_opt of None \<Rightarrow> True | Some p \<Rightarrow> f p s"
-
-abbreviation
-  "valid_bound_ntfn' \<equiv> valid_bound_obj' ntfn_at'"
-
-abbreviation
-  "valid_bound_tcb' \<equiv> valid_bound_obj' tcb_at'"
-
-abbreviation
-  "valid_bound_sc' \<equiv> valid_bound_obj' sc_at'"
-
-abbreviation
-  "valid_bound_reply' \<equiv> valid_bound_obj' reply_at'"
-
-definition valid_tcb_state' :: "thread_state \<Rightarrow> kernel_state \<Rightarrow> bool" where
+definition
+  valid_tcb_state' :: "Structures_H.thread_state \<Rightarrow> kernel_state \<Rightarrow> bool"
+where
   "valid_tcb_state' ts s \<equiv> case ts of
-    BlockedOnReceive ref _ rep \<Rightarrow> ep_at' ref s \<and> valid_bound_reply' rep s
-  | BlockedOnSend ref _ _ _ _  \<Rightarrow> ep_at' ref s
-  | BlockedOnNotification ref  \<Rightarrow> ntfn_at' ref s
-  | BlockedOnReply r \<Rightarrow>  valid_bound_reply' r s
+    Structures_H.BlockedOnReceive ref a \<Rightarrow> ep_at' ref s
+  | Structures_H.BlockedOnSend ref a b d c \<Rightarrow> ep_at' ref s
+  | Structures_H.BlockedOnNotification ref \<Rightarrow> ntfn_at' ref s
   | _ \<Rightarrow> True"
 
-
 definition
   valid_ipc_buffer_ptr' :: "word32 \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
   "valid_ipc_buffer_ptr' a s \<equiv> is_aligned a msg_align_bits \<and> typ_at' UserDataT (a && ~~ mask pageBits) s"
 
+definition
+  valid_bound_ntfn' :: "word32 option \<Rightarrow> kernel_state \<Rightarrow> bool"
+where
+  "valid_bound_ntfn' ntfn_opt s \<equiv> case ntfn_opt of
+                                 None \<Rightarrow> True
+                               | Some a \<Rightarrow> ntfn_at' a s"
+
 definition
   is_device_page_cap' :: "capability \<Rightarrow> bool"
 where
@@ -671,21 +496,24 @@ where
     capability.ArchObjectCap (arch_capability.PageCap dev _ _ _ _) \<Rightarrow> dev
    | _ \<Rightarrow> False"
 
+abbreviation opt_tcb_at' :: "machine_word option \<Rightarrow> kernel_state \<Rightarrow> bool" where
+  "opt_tcb_at' \<equiv> none_top tcb_at'"
+
+lemmas opt_tcb_at'_def = none_top_def
 
-definition valid_tcb' :: "tcb \<Rightarrow> kernel_state \<Rightarrow> bool" where
+definition
+  valid_tcb' :: "Structures_H.tcb \<Rightarrow> kernel_state \<Rightarrow> bool"
+where
   "valid_tcb' t s \<equiv> (\<forall>(getF, setF) \<in> ran tcb_cte_cases. s \<turnstile>' cteCap (getF t))
                   \<and> valid_tcb_state' (tcbState t) s
                   \<and> is_aligned (tcbIPCBuffer t) msg_align_bits
                   \<and> valid_bound_ntfn' (tcbBoundNotification t) s
-                  \<and> valid_bound_sc' (tcbSchedContext t) s
-                  \<and> valid_bound_sc' (tcbYieldTo t) s
                   \<and> tcbDomain t \<le> maxDomain
                   \<and> tcbPriority t \<le> maxPriority
                   \<and> tcbMCP t \<le> maxPriority
                   \<and> opt_tcb_at' (tcbSchedPrev t) s
                   \<and> opt_tcb_at' (tcbSchedNext t) s"
 
-
 definition
   valid_ep' :: "Structures_H.endpoint \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
@@ -695,37 +523,23 @@ where
   | Structures_H.RecvEP ts \<Rightarrow> (ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts)"
 
 
+definition
+  valid_bound_tcb' :: "word32 option \<Rightarrow> kernel_state \<Rightarrow> bool"
+where
+  "valid_bound_tcb' tcb_opt s \<equiv> case tcb_opt of
+                                 None \<Rightarrow> True
+                               | Some t \<Rightarrow> tcb_at' t s"
+
 definition
   valid_ntfn' :: "Structures_H.notification \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
   "valid_ntfn' ntfn s \<equiv> (case ntfnObj ntfn of
     Structures_H.IdleNtfn \<Rightarrow> True
   | Structures_H.WaitingNtfn ts \<Rightarrow>
-      ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts
-      \<and> (case ntfnBoundTCB ntfn of Some tcb \<Rightarrow> ts = [tcb] | _ \<Rightarrow> True)
+      (ts \<noteq> [] \<and> (\<forall>t \<in> set ts. tcb_at' t s) \<and> distinct ts
+     \<and> (case ntfnBoundTCB ntfn of Some tcb \<Rightarrow> ts = [tcb] | _ \<Rightarrow> True))
   | Structures_H.ActiveNtfn b \<Rightarrow> True)
-      \<and> valid_bound_tcb' (ntfnBoundTCB ntfn) s
-      \<and> valid_bound_sc' (ntfnSc ntfn) s"
-
-definition valid_sched_context' :: "sched_context \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "valid_sched_context' sc s \<equiv>
-     valid_bound_ntfn' (scNtfn sc) s
-     \<and> valid_bound_tcb' (scTCB sc) s
-     \<and> valid_bound_tcb' (scYieldFrom sc) s
-     \<and> valid_bound_reply' (scReply sc) s
-     \<and> MIN_REFILLS \<le> length (scRefills sc)
-     \<and> length (scRefills sc) = refillAbsoluteMax' (minSchedContextBits + scSize sc)
-     \<and> scRefillMax sc \<le> length (scRefills sc)
-     \<and> (0 < scRefillMax sc \<longrightarrow> scRefillHead sc < scRefillMax sc
-                               \<and> scRefillCount sc \<le> scRefillMax sc
-                               \<and> 0 < scRefillCount sc)"
-
-definition valid_reply' :: "reply \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "valid_reply' reply s \<equiv>
-     valid_bound_tcb' (replyTCB reply) s
-     \<and> valid_bound_sc' (replySC reply) s
-     \<and> valid_bound_reply' (replyPrev reply) s
-     \<and> valid_bound_reply' (replyNext_of reply) s"
+  \<and> valid_bound_tcb' (ntfnBoundTCB ntfn) s"
 
 definition
   valid_mapping' :: "word32 \<Rightarrow> vmpage_size \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -762,20 +576,12 @@ where
 | "valid_arch_obj' (KOPDE pde) = valid_pde' pde"
 | "valid_arch_obj' (KOPTE pte) = valid_pte' pte"
 
-definition sc_size_bounds :: "nat \<Rightarrow> bool" where
-  "sc_size_bounds us \<equiv>
-        minSchedContextBits \<le> us \<and> us \<le> maxUntypedSizeBits"
-
-definition valid_sched_context_size' :: "sched_context \<Rightarrow> bool" where
-  "valid_sched_context_size' sc \<equiv> sc_size_bounds (objBits sc)"
-
-
-definition valid_obj' :: "kernel_object \<Rightarrow> kernel_state \<Rightarrow> bool" where
+definition
+  valid_obj' :: "Structures_H.kernel_object \<Rightarrow> kernel_state \<Rightarrow> bool"
+where
   "valid_obj' ko s \<equiv> case ko of
     KOEndpoint endpoint \<Rightarrow> valid_ep' endpoint s
   | KONotification notification \<Rightarrow> valid_ntfn' notification s
-  | KOSchedContext sc \<Rightarrow> valid_sched_context' sc s \<and> valid_sched_context_size' sc
-  | KOReply reply \<Rightarrow> valid_reply' reply s
   | KOKernelData \<Rightarrow> False
   | KOUserData \<Rightarrow> True
   | KOUserDataDevice \<Rightarrow> True
@@ -795,30 +601,11 @@ where
   "pspace_distinct' s \<equiv>
    \<forall>x \<in> dom (ksPSpace s). ps_clear x (objBitsKO (the (ksPSpace s x))) s"
 
-definition pspace_bounded' :: "kernel_state \<Rightarrow> bool" where
- "pspace_bounded' s \<equiv>
-  \<forall>x \<in> dom (ksPSpace s). objBitsKO (the (ksPSpace s x)) < word_bits"
-
 definition
   valid_objs' :: "kernel_state \<Rightarrow> bool"
 where
   "valid_objs' s \<equiv> \<forall>obj \<in> ran (ksPSpace s). valid_obj' obj s"
 
-definition valid_obj_size' :: "kernel_object \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "valid_obj_size' ko s \<equiv> case ko of
-    KOSchedContext sc \<Rightarrow> valid_sched_context_size' sc
-  | _ \<Rightarrow> True"
-
-definition
-  valid_objs_size' :: "kernel_state \<Rightarrow> bool"
-where
-  "valid_objs_size' s \<equiv> \<forall>obj \<in> ran (ksPSpace s). valid_obj_size' obj s"
-
-lemma valid_objs'_valid_objs_size':
-  "valid_objs' s \<Longrightarrow> valid_objs_size' s"
-  by (clarsimp simp: valid_objs'_def valid_objs_size'_def valid_obj'_def valid_obj_size'_def)
-     (fastforce split: kernel_object.splits)
-
 type_synonym cte_heap = "word32 \<Rightarrow> cte option"
 
 definition
@@ -906,14 +693,12 @@ where
 | "capClass (UntypedCap d p n f)               = PhysicalClass"
 | "capClass (EndpointCap ref badge s r g gr)   = PhysicalClass"
 | "capClass (NotificationCap ref badge s r)    = PhysicalClass"
-| "capClass (SchedContextCap _ _)              = PhysicalClass"
 | "capClass (CNodeCap ref bits g gs)           = PhysicalClass"
 | "capClass (ThreadCap ref)                    = PhysicalClass"
 | "capClass (Zombie r b n)                     = PhysicalClass"
 | "capClass (IRQControlCap)                    = IRQClass"
-| "capClass (SchedControlCap)                  = SchedControlClass"
 | "capClass (IRQHandlerCap irq)                = IRQClass"
-| "capClass (ReplyCap tcb m)                   = PhysicalClass"
+| "capClass (ReplyCap tcb m g)                 = ReplyClass tcb"
 | "capClass (ArchObjectCap cap)                = acapClass cap"
 
 definition
@@ -1046,6 +831,13 @@ definition
 where
  "distinct_zombies m \<equiv> distinct_zombie_caps (option_map cteCap \<circ> m)"
 
+definition
+  reply_masters_rvk_fb :: "cte_heap \<Rightarrow> bool"
+where
+ "reply_masters_rvk_fb ctes \<equiv> \<forall>cte \<in> ran ctes.
+        isReplyCap (cteCap cte) \<and> capReplyMaster (cteCap cte)
+    \<longrightarrow> mdbRevocable (cteMDBNode cte) \<and> mdbFirstBadged (cteMDBNode cte)"
+
 definition
   valid_mdb_ctes :: "cte_heap \<Rightarrow> bool"
 where
@@ -1054,7 +846,7 @@ where
                         mdb_chunked m \<and> untyped_mdb' m \<and>
                         untyped_inc' m \<and> valid_nullcaps m \<and>
                         ut_revocable' m \<and> class_links m \<and> distinct_zombies m
-                        \<and> irq_control m"
+                        \<and> irq_control m \<and> reply_masters_rvk_fb m"
 
 definition
   valid_mdb' :: "kernel_state \<Rightarrow> bool"
@@ -1077,31 +869,12 @@ definition "vs_valid_duplicates' \<equiv> \<lambda>h.
               x && ~~ mask (vs_ptr_align ko) = y && ~~ mask (vs_ptr_align ko) \<longrightarrow>
               h x = h y"
 
-abbreviation
-  "is_reply_linked rptr s \<equiv> replyNexts_of s rptr \<noteq> None \<or> replyPrevs_of s rptr \<noteq> None"
-
-definition valid_replies'_except :: "obj_ref set \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "valid_replies'_except RS s \<equiv>
-     (\<forall>rptr. rptr \<notin> RS \<and> is_reply_linked rptr s
-             \<longrightarrow> (\<exists>tptr. replyTCBs_of s rptr = Some tptr
-                         \<and> st_tcb_at' ((=) (BlockedOnReply (Some rptr))) tptr s))"
-
-definition [simplified empty_iff simp_thms valid_replies'_except_def]:
-  "valid_replies' s \<equiv> valid_replies'_except {} s"
-
-defs valid_replies'_sc_asrt_def:
-  "valid_replies'_sc_asrt \<equiv> \<lambda>rptr s.
-     replySCs_of s rptr \<noteq> None
-       \<longrightarrow> (\<exists>tptr. replyTCBs_of s rptr = Some tptr
-                   \<and> st_tcb_at' ((=) (BlockedOnReply (Some rptr))) tptr s)"
 definition
   valid_pspace' :: "kernel_state \<Rightarrow> bool"
 where
   "valid_pspace' \<equiv> valid_objs' and
-                   valid_replies' and
                    pspace_aligned' and
                    pspace_distinct' and
-                   pspace_bounded' and
                    no_0_obj' and
                    valid_mdb'"
 
@@ -1112,8 +885,8 @@ where
 | "runnable' (Structures_H.Inactive)                = False"
 | "runnable' (Structures_H.Restart)                 = True"
 | "runnable' (Structures_H.IdleThreadState)         = False"
-| "runnable' (Structures_H.BlockedOnReceive _ _ _)  = False"
-| "runnable' (Structures_H.BlockedOnReply _)        = False"
+| "runnable' (Structures_H.BlockedOnReceive a b)    = False"
+| "runnable' (Structures_H.BlockedOnReply)          = False"
 | "runnable' (Structures_H.BlockedOnSend a b c d e) = False"
 | "runnable' (Structures_H.BlockedOnNotification x) = False"
 
@@ -1135,7 +908,6 @@ where
   "bitmapQ d p s \<equiv> ksReadyQueuesL1Bitmap s d !! prioToL1Index p
                      \<and> ksReadyQueuesL2Bitmap s (d, invertL1Index (prioToL1Index p))
                          !! unat (p && mask wordRadix)"
-
 definition
   (* A priority is used as a two-part key into the bitmap structure. If an L2 bitmap entry
      is set without an L1 entry, updating the L1 entry (shared by many priorities) may make
@@ -1216,21 +988,6 @@ lemma valid_sched_pointersD:
    \<Longrightarrow> tcbSchedPrevs_of s t = None \<and> tcbSchedNexts_of s t = None"
   by (fastforce simp: valid_sched_pointers_def in_opt_pred opt_map_red)
 
-definition
-  valid_release_queue :: "kernel_state \<Rightarrow> bool"
-where
- "valid_release_queue \<equiv> \<lambda>s. \<forall>t. t \<in> set (ksReleaseQueue s) \<longrightarrow> obj_at' (tcbInReleaseQueue) t s"
-
-definition
-  valid_release_queue' :: "kernel_state \<Rightarrow> bool"
-where
- "valid_release_queue' \<equiv> \<lambda>s. \<forall>t. obj_at' (tcbInReleaseQueue) t s \<longrightarrow> t \<in> set (ksReleaseQueue s)"
-
-abbreviation
-  valid_release_queue_iff :: "kernel_state \<Rightarrow> bool"
-where
-  "valid_release_queue_iff \<equiv> valid_release_queue and valid_release_queue'"
-
 definition tcb_in_cur_domain' :: "32 word \<Rightarrow> kernel_state \<Rightarrow> bool" where
   "tcb_in_cur_domain' t \<equiv> \<lambda>s. obj_at' (\<lambda>tcb. ksCurDomain s = tcbDomain tcb) t s"
 
@@ -1239,26 +996,19 @@ definition
   "ct_idle_or_in_cur_domain' \<equiv> \<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow>
     ksCurThread s = ksIdleThread s \<or> tcb_in_cur_domain' (ksCurThread s) s"
 
-definition ct_in_state' :: "(thread_state \<Rightarrow> bool) \<Rightarrow> kernel_state \<Rightarrow> bool" where
+definition
  "ct_in_state' test \<equiv> \<lambda>s. st_tcb_at' test (ksCurThread s) s"
 
 definition
  "ct_not_inQ \<equiv> \<lambda>s. ksSchedulerAction s = ResumeCurrentThread
                      \<longrightarrow> obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s"
 
-defs ct_not_inQ_asrt_def:
-  "ct_not_inQ_asrt \<equiv> \<lambda>s. ct_not_inQ s"
-
 abbreviation
   "idle' \<equiv> \<lambda>st. st = Structures_H.IdleThreadState"
 
 abbreviation
   "activatable' st \<equiv> runnable' st \<or> idle' st"
 
-defs rct_imp_activatable'_asrt_def:
-  "rct_imp_activatable'_asrt \<equiv> \<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow>
-                                         ct_in_state' activatable' s"
-
 primrec
   sch_act_wf :: "scheduler_action \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
@@ -1266,9 +1016,6 @@ where
 | "sch_act_wf ChooseNewThread     = \<top>"
 | "sch_act_wf (SwitchToThread t)  = (\<lambda>s. st_tcb_at' runnable' t s \<and> tcb_in_cur_domain' t s)"
 
-defs sch_act_wf_asrt_def:
-  "sch_act_wf_asrt \<equiv> \<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-
 definition
   sch_act_simple :: "kernel_state \<Rightarrow> bool"
 where
@@ -1284,45 +1031,19 @@ where
 abbreviation
   "sch_act_not t \<equiv> \<lambda>s. ksSchedulerAction s \<noteq> SwitchToThread t"
 
-definition
-  idle_tcb'_2 :: "Structures_H.thread_state \<times> 32 word option \<times> 32 word option \<times> 32 word option
-                  \<Rightarrow> bool"
-where
-  "idle_tcb'_2 \<equiv> \<lambda>(st, ntfn_opt, sc_opt, yt_opt).
-                    (idle' st \<and> ntfn_opt = None \<and> sc_opt = Some idle_sc_ptr \<and> yt_opt = None)"
+definition idle_tcb'_2 :: "Structures_H.thread_state \<times> machine_word option \<Rightarrow> bool" where
+  "idle_tcb'_2 \<equiv> \<lambda>(st, ntfn_opt). (idle' st \<and> ntfn_opt = None)"
 
 abbreviation
-  "idle_tcb' tcb \<equiv>
-      idle_tcb'_2 (tcbState tcb, tcbBoundNotification tcb, tcbSchedContext tcb, tcbYieldTo tcb)"
+  "idle_tcb' tcb \<equiv> idle_tcb'_2 (tcbState tcb, tcbBoundNotification tcb)"
 
 lemmas idle_tcb'_def = idle_tcb'_2_def
 
-abbreviation idle_sc' :: "sched_context \<Rightarrow> bool" where
-  "idle_sc' sc \<equiv>
-      scPeriod sc = 0
-      \<and> scTCB sc = Some idle_thread_ptr
-      \<and> scNtfn sc = None
-      \<and> scRefillMax sc = MIN_REFILLS
-      \<and> scBadge sc = 0
-      \<and> scYieldFrom sc = None
-      \<and> scReply sc = None"
-
-abbreviation
-  "idle_sc_at' \<equiv> obj_at' idle_sc'"
-
-definition
-  valid_idle' :: "kernel_state \<Rightarrow> bool"
-where
-  "valid_idle' \<equiv>
-     \<lambda>s. obj_at' idle_tcb' (ksIdleThread s) s
-         \<and> idle_sc_at' idle_sc_ptr s
-         \<and> idle_thread_ptr = ksIdleThread s"
-
-defs valid_idle'_asrt_def:
-  "valid_idle'_asrt \<equiv> \<lambda>s. valid_idle' s"
+definition valid_idle' :: "kernel_state \<Rightarrow> bool" where
+  "valid_idle' \<equiv> \<lambda>s. obj_at' idle_tcb' (ksIdleThread s) s \<and> idle_thread_ptr = ksIdleThread s"
 
 lemma valid_idle'_tcb_at':
-  "valid_idle' s \<Longrightarrow> obj_at' idle_tcb' (ksIdleThread s) s \<and> idle_sc_at' idle_sc_ptr s"
+  "valid_idle' s \<Longrightarrow> obj_at' idle_tcb' (ksIdleThread s) s"
   by (clarsimp simp: valid_idle'_def)
 
 definition valid_irq_node' :: "word32 \<Rightarrow> kernel_state \<Rightarrow> bool" where
@@ -1348,7 +1069,7 @@ definition
   global_refs' :: "kernel_state \<Rightarrow> obj_ref set"
 where
   "global_refs' \<equiv> \<lambda>s.
-  {ksIdleThread s, idle_sc_ptr} \<union>
+  {ksIdleThread s} \<union>
    page_directory_refs' (armKSGlobalPD (ksArchState s)) \<union>
    (\<Union>pt \<in> set (armKSGlobalPTs (ksArchState s)). page_table_refs' pt) \<union>
    range (\<lambda>irq :: irq. irq_node' s + (ucast irq << cteSizeBits))"
@@ -1470,51 +1191,49 @@ abbreviation
   "untyped_ranges_zero' s \<equiv> untyped_ranges_zero_inv (cteCaps_of s)
       (gsUntypedZeroRanges s)"
 
+(* FIXME: this really should be a definition like the above. *)
 (* The schedule is invariant. *)
-definition
+abbreviation
   "valid_dom_schedule' \<equiv>
    \<lambda>s. ksDomSchedule s \<noteq> [] \<and> (\<forall>x\<in>set (ksDomSchedule s). dschDomain x \<le> maxDomain \<and> 0 < dschLength x)
        \<and> ksDomSchedule s = ksDomSchedule (newKernelState undefined)
        \<and> ksDomScheduleIdx s < length (ksDomSchedule (newKernelState undefined))"
 
 definition
-  invs' :: "kernel_state \<Rightarrow> bool"
-where
-  "invs' \<equiv> \<lambda>s. valid_pspace' s
-                \<and> valid_queues s
-                \<and> sym_refs (list_refs_of_replies' s)
-                \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' s
-                \<and> valid_global_refs' s \<and> valid_arch_state' s
-                \<and> valid_irq_node' (irq_node' s) s
-                \<and> valid_irq_handlers' s
-                \<and> valid_irq_states' s
-                \<and> valid_machine_state' s
-                \<and> irqs_masked' s
-                \<and> valid_queues' s
-                \<and> valid_release_queue s
-                \<and> valid_release_queue' s
-                \<and> valid_pde_mappings' s
-                \<and> pspace_domain_valid s
-                \<and> ksCurDomain s \<le> maxDomain
-                \<and> valid_dom_schedule' s
-                \<and> untyped_ranges_zero' s"
+  valid_state' :: "kernel_state \<Rightarrow> bool"
+where
+  "valid_state' \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
+                      \<and> sym_refs (state_refs_of' s)
+                      \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' s
+                      \<and> valid_idle' s
+                      \<and> valid_global_refs' s \<and> valid_arch_state' s
+                      \<and> valid_irq_node' (irq_node' s) s
+                      \<and> valid_irq_handlers' s
+                      \<and> valid_irq_states' s
+                      \<and> valid_machine_state' s
+                      \<and> irqs_masked' s
+                      \<and> sym_heap_sched_pointers s
+                      \<and> valid_sched_pointers s
+                      \<and> valid_bitmaps s
+                      \<and> ct_not_inQ s
+                      \<and> ct_idle_or_in_cur_domain' s
+                      \<and> valid_pde_mappings' s
+                      \<and> pspace_domain_valid s
+                      \<and> ksCurDomain s \<le> maxDomain
+                      \<and> valid_dom_schedule' s
+                      \<and> untyped_ranges_zero' s"
 
 definition
   "cur_tcb' s \<equiv> tcb_at' (ksCurThread s) s"
 
-defs cur_tcb'_asrt_def:
-  "cur_tcb'_asrt \<equiv> \<lambda>s. cur_tcb' s"
-
-defs sch_act_sane_asrt_def:
-  "sch_act_sane_asrt \<equiv> \<lambda>s. sch_act_sane s"
-
-defs ct_not_ksQ_asrt_def:
-  "ct_not_ksQ_asrt \<equiv> \<lambda>s. \<forall>pd. ksCurThread s \<notin> set (ksReadyQueues s pd)"
+definition
+  invs' :: "kernel_state \<Rightarrow> bool" where
+  "invs' \<equiv> valid_state' and cur_tcb'"
 
 subsection "Derived concepts"
 
 abbreviation
-  "awaiting_reply' ts \<equiv> isBlockedOnReply ts"
+  "awaiting_reply' ts \<equiv> ts = Structures_H.BlockedOnReply"
 
   (* x-symbol doesn't have a reverse leadsto.. *)
 definition
@@ -1530,8 +1249,6 @@ definition
                     | NotificationT \<Rightarrow> injectKO (makeObject :: Structures_H.notification)
                     | CTET \<Rightarrow> injectKO (makeObject :: cte)
                     | TCBT \<Rightarrow> injectKO (makeObject :: tcb)
-                    | SchedContextT \<Rightarrow> injectKO (makeObject :: sched_context)
-                    | ReplyT \<Rightarrow> injectKO (makeObject :: reply)
                     | UserDataT \<Rightarrow> injectKO (makeObject :: user_data)
                     | UserDataDeviceT \<Rightarrow> injectKO (makeObject :: user_data_device)
                     | KernelDataT \<Rightarrow> KOKernelData
@@ -1558,7 +1275,7 @@ abbreviation
   "simple' st \<equiv> st = Structures_H.Inactive \<or>
                 st = Structures_H.Running \<or>
                 st = Structures_H.Restart \<or>
-                idle' st"
+                idle' st \<or> awaiting_reply' st"
 
 abbreviation
   "ct_active' \<equiv> ct_in_state' active'"
@@ -1566,9 +1283,68 @@ abbreviation
 abbreviation
   "ct_running' \<equiv> ct_in_state' (\<lambda>st. st = Structures_H.Running)"
 
-defs ct_active'_asrt_def:
-  "ct_active'_asrt \<equiv> ct_active'"
+abbreviation(input)
+ "all_invs_but_sym_refs_ct_not_inQ'
+    \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
+           \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' s
+           \<and> valid_idle' s \<and> valid_global_refs' s \<and> valid_arch_state' s
+           \<and> valid_irq_node' (irq_node' s) s \<and> valid_irq_handlers' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s \<and> valid_machine_state' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s \<and> valid_pde_mappings' s
+           \<and> pspace_domain_valid s
+           \<and> ksCurDomain s \<le> maxDomain
+           \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
+
+abbreviation(input)
+ "all_invs_but_ct_not_inQ'
+    \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
+           \<and> sym_refs (state_refs_of' s)
+           \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' s
+           \<and> valid_idle' s \<and> valid_global_refs' s \<and> valid_arch_state' s
+           \<and> valid_irq_node' (irq_node' s) s \<and> valid_irq_handlers' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s \<and> valid_machine_state' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> cur_tcb' s \<and> ct_idle_or_in_cur_domain' s \<and> valid_pde_mappings' s
+           \<and> pspace_domain_valid s
+           \<and> ksCurDomain s \<le> maxDomain
+           \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
+
+lemma all_invs_but_sym_refs_not_ct_inQ_check':
+  "(all_invs_but_sym_refs_ct_not_inQ' and sym_refs \<circ> state_refs_of' and ct_not_inQ) = invs'"
+  by (simp add: pred_conj_def conj_commute conj_left_commute invs'_def valid_state'_def)
+
+lemma all_invs_but_not_ct_inQ_check':
+  "(all_invs_but_ct_not_inQ' and ct_not_inQ) = invs'"
+  by (simp add: pred_conj_def conj_commute conj_left_commute invs'_def valid_state'_def)
+
+definition
+  "all_invs_but_ct_idle_or_in_cur_domain'
+    \<equiv> \<lambda>s. valid_pspace' s \<and> sch_act_wf (ksSchedulerAction s) s
+           \<and> sym_refs (state_refs_of' s)
+           \<and> if_live_then_nonz_cap' s \<and> if_unsafe_then_cap' s
+           \<and> valid_idle' s \<and> valid_global_refs' s \<and> valid_arch_state' s
+           \<and> valid_irq_node' (irq_node' s) s \<and> valid_irq_handlers' s
+           \<and> valid_irq_states' s \<and> irqs_masked' s \<and> valid_machine_state' s
+           \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s
+           \<and> cur_tcb' s \<and> ct_not_inQ s \<and> valid_pde_mappings' s
+           \<and> pspace_domain_valid s
+           \<and> ksCurDomain s \<le> maxDomain
+           \<and> valid_dom_schedule' s \<and> untyped_ranges_zero' s"
+
+lemmas invs_no_cicd'_def = all_invs_but_ct_idle_or_in_cur_domain'_def
+
+lemma all_invs_but_ct_idle_or_in_cur_domain_check':
+  "(all_invs_but_ct_idle_or_in_cur_domain' and ct_idle_or_in_cur_domain') = invs'"
+  by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def pred_conj_def
+                conj_left_commute conj_commute invs'_def valid_state'_def)
+
+abbreviation (input)
+  "invs_no_cicd' \<equiv> all_invs_but_ct_idle_or_in_cur_domain'"
 
+lemma invs'_to_invs_no_cicd'_def:
+  "invs' = (all_invs_but_ct_idle_or_in_cur_domain' and ct_idle_or_in_cur_domain')"
+  by (fastforce simp: invs'_def all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def )
 end
 
 locale mdb_next =
@@ -1586,7 +1362,7 @@ locale mdb_order = mdb_next +
 
 \<comment> \<open>---------------------------------------------------------------------------\<close>
 section "Alternate split rules for preserving subgoal order"
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma ntfn_splits[split]:
   " P (case ntfn of Structures_H.ntfn.IdleNtfn \<Rightarrow> f1
      | Structures_H.ntfn.ActiveNtfn x \<Rightarrow> f2 x
@@ -1612,18 +1388,21 @@ section "Lemmas"
 schematic_goal wordBits_def': "wordBits = numeral ?n" (* arch-specific consequence *)
   by (simp add: wordBits_def word_size)
 
-lemmas valid_bound_ntfn'_def = valid_bound_obj'_def
-lemmas valid_bound_tcb'_def = valid_bound_obj'_def
-lemmas valid_bound_sc'_def = valid_bound_obj'_def
-lemmas valid_bound_reply'_def = valid_bound_obj'_def
+lemma valid_bound_ntfn'_None[simp]:
+  "valid_bound_ntfn' None = \<top>"
+  by (auto simp: valid_bound_ntfn'_def)
 
-lemma valid_bound_obj'_None[simp]:
-  "valid_bound_obj' P None = \<top>"
-  by (auto simp: valid_bound_obj'_def)
+lemma valid_bound_ntfn'_Some[simp]:
+  "valid_bound_ntfn' (Some x) = ntfn_at' x"
+  by (auto simp: valid_bound_ntfn'_def)
 
-lemma valid_bound_obj'_Some[simp]:
-  "valid_bound_obj' P (Some x) = P x"
-  by (auto simp: valid_bound_obj'_def)
+lemma valid_bound_tcb'_None[simp]:
+  "valid_bound_tcb' None = \<top>"
+  by (auto simp: valid_bound_tcb'_def)
+
+lemma valid_bound_tcb'_Some[simp]:
+  "valid_bound_tcb' (Some x) = tcb_at' x"
+  by (auto simp: valid_bound_tcb'_def)
 
 lemmas untypedBits_defs = minUntypedSizeBits_def maxUntypedSizeBits_def
 lemmas objBits_simps = objBits_def objBitsKO_def word_size_def
@@ -1658,22 +1437,26 @@ lemma ps_clear_def2:
   done
 
 lemma projectKO_stateI:
-  "projectKO e s = Some obj \<Longrightarrow> projectKO e s' = Some obj"
+  "fst (projectKO e s) = {(obj, s)} \<Longrightarrow> fst (projectKO e s') = {(obj, s')}"
   unfolding projectKO_def
-  by (auto simp: omonad_defs split: option.splits)
+  by (auto simp: fail_def return_def valid_def split: option.splits)
 
 lemma singleton_in_magnitude_check:
   "(x, s) \<in> fst (magnitudeCheck a b c s') \<Longrightarrow> \<forall>s'. fst (magnitudeCheck a b c s') = {(x, s')}"
-  by (fastforce simp: read_magnitudeCheck_def magnitudeCheck_def in_monad
-               split: option.split_asm)
+  by (simp add: magnitudeCheck_def when_def in_monad return_def
+         split: if_split_asm option.split_asm)
 
 lemma wordSizeCase_simp [simp]: "wordSizeCase a b = a"
   by (simp add: wordSizeCase_def wordBits_def word_size)
 
+lemma projectKO_eq:
+  "(fst (projectKO ko c) = {(obj, c)}) = (projectKO_opt ko = Some obj)"
+  by (simp add: projectKO_def fail_def return_def split: option.splits)
+
 lemma obj_at'_def':
   "obj_at' P p s = (\<exists>ko obj. ksPSpace s p = Some ko \<and> is_aligned p (objBitsKO ko)
-                   \<and> projectKO ko s = Some obj \<and> P obj
-                   \<and> ps_clear p (objBitsKO ko) s \<and> objBitsKO ko < word_bits)"
+                   \<and> fst (projectKO ko s) = {(obj,s)} \<and> P obj
+                   \<and> ps_clear p (objBitsKO ko) s)"
   apply (simp add: obj_at'_real_def ko_wp_at'_def projectKO_eq
                    True_notin_set_replicate_conv objBits_def)
   apply fastforce
@@ -1681,22 +1464,22 @@ lemma obj_at'_def':
 
 lemma obj_at'_def:
   "obj_at' P p s \<equiv> \<exists>ko obj. ksPSpace s p = Some ko \<and> is_aligned p (objBitsKO ko)
-                   \<and> projectKO ko s = Some obj \<and> P obj
-                   \<and> ps_clear p (objBitsKO ko) s \<and> objBitsKO ko < word_bits"
+                   \<and> fst (projectKO ko s) = {(obj,s)} \<and> P obj
+                   \<and> ps_clear p (objBitsKO ko) s"
   by (simp add: obj_at'_def')
 
 lemma obj_atE' [elim?]:
   assumes objat: "obj_at' P ptr s"
   and        rl: "\<And>ko obj.
   \<lbrakk> ksPSpace s ptr = Some ko; is_aligned ptr (objBitsKO ko);
-     projectKO ko s = Some obj; P obj; objBitsKO ko < word_bits;
+     fst (projectKO ko s) = {(obj,s)}; P obj;
      ps_clear ptr (objBitsKO ko) s \<rbrakk> \<Longrightarrow> R"
   shows "R"
   using objat unfolding obj_at'_def by (auto intro!: rl)
 
 lemma obj_atI' [intro?]:
   "\<lbrakk> ksPSpace s ptr = Some ko; is_aligned ptr (objBitsKO ko);
-       projectKO ko s = Some obj; P obj; objBitsKO ko < word_bits;
+       fst (projectKO ko s) = {(obj, s)}; P obj;
        ps_clear ptr (objBitsKO ko) s \<rbrakk>
   \<Longrightarrow> obj_at' P ptr s"
   unfolding obj_at'_def by (auto)
@@ -1709,16 +1492,45 @@ lemma cte_at'_def:
 
 lemma tcb_cte_cases_simps[simp]:
   "tcb_cte_cases 0  = Some (tcbCTable, tcbCTable_update)"
-  "tcb_cte_cases 0x10 = Some (tcbVTable, tcbVTable_update)"
-  "tcb_cte_cases 0x20 = Some (tcbIPCBufferFrame, tcbIPCBufferFrame_update)"
-  "tcb_cte_cases 0x30 = Some (tcbFaultHandler, tcbFaultHandler_update)"
-  "tcb_cte_cases 0x40 = Some (tcbTimeoutHandler, tcbTimeoutHandler_update)"
+  "tcb_cte_cases 16 = Some (tcbVTable, tcbVTable_update)"
+  "tcb_cte_cases 32 = Some (tcbReply, tcbReply_update)"
+  "tcb_cte_cases 48 = Some (tcbCaller, tcbCaller_update)"
+  "tcb_cte_cases 64 = Some (tcbIPCBufferFrame, tcbIPCBufferFrame_update)"
   by (simp add: tcb_cte_cases_def)+
 
-lemmas refs_of'_simps[simp] = refs_of'_def[split_simps kernel_object.split]
-lemmas tcb_st_refs_of'_simps[simp] = tcb_st_refs_of'_def[split_simps thread_state.split]
-lemmas ep_q_refs_of'_simps[simp] = ep_q_refs_of'_def[split_simps endpoint.split]
-lemmas ntfn_q_refs_of'_simps[simp] = ntfn_q_refs_of'_def[split_simps ntfn.split]
+lemma refs_of'_simps[simp]:
+ "refs_of' (KOTCB tcb)           = tcb_st_refs_of' (tcbState tcb) \<union> tcb_bound_refs' (tcbBoundNotification tcb)"
+ "refs_of' (KOCTE cte)           = {}"
+ "refs_of' (KOEndpoint ep)       = ep_q_refs_of' ep"
+ "refs_of' (KONotification ntfn)     = ntfn_q_refs_of' (ntfnObj ntfn) \<union> ntfn_bound_refs' (ntfnBoundTCB ntfn)"
+ "refs_of' (KOUserData)          = {}"
+ "refs_of' (KOUserDataDevice)          = {}"
+ "refs_of' (KOKernelData)        = {}"
+ "refs_of' (KOArch ako)          = {}"
+  by (auto simp: refs_of'_def)
+
+lemma tcb_st_refs_of'_simps[simp]:
+ "tcb_st_refs_of' (Running)                  = {}"
+ "tcb_st_refs_of' (Inactive)                 = {}"
+ "tcb_st_refs_of' (Restart)                  = {}"
+ "tcb_st_refs_of' (BlockedOnReceive x'' a')  = {(x'', TCBBlockedRecv)}"
+ "tcb_st_refs_of' (BlockedOnSend x a b c d)  = {(x, TCBBlockedSend)}"
+ "tcb_st_refs_of' (BlockedOnNotification x') = {(x', TCBSignal)}"
+ "tcb_st_refs_of' (BlockedOnReply)           = {}"
+ "tcb_st_refs_of' (IdleThreadState)          = {}"
+  by (auto simp: tcb_st_refs_of'_def)
+
+lemma ep_q_refs_of'_simps[simp]:
+ "ep_q_refs_of'  IdleEP    = {}"
+ "ep_q_refs_of' (RecvEP q) = set q \<times> {EPRecv}"
+ "ep_q_refs_of' (SendEP q) = set q \<times> {EPSend}"
+  by (auto simp: ep_q_refs_of'_def)
+
+lemma ntfn_q_refs_of'_simps[simp]:
+ "ntfn_q_refs_of'  IdleNtfn         = {}"
+ "ntfn_q_refs_of' (WaitingNtfn q)      = set q \<times> {NTFNSignal}"
+ "ntfn_q_refs_of' (ActiveNtfn b)  = {}"
+  by (auto simp: ntfn_q_refs_of'_def)
 
 lemma ntfn_bound_refs'_simps[simp]:
   "ntfn_bound_refs' (Some t) = {(t, NTFNBound)}"
@@ -1726,74 +1538,38 @@ lemma ntfn_bound_refs'_simps[simp]:
   by (auto simp: ntfn_bound_refs'_def)
 
 lemma tcb_bound_refs'_simps[simp]:
-  "tcb_bound_refs' (Some a) b c = {(a, TCBBound)} \<union> tcb_bound_refs' None b c"
-  "tcb_bound_refs' b (Some a) c = {(a, TCBSchedContext)} \<union> tcb_bound_refs' b None c"
-  "tcb_bound_refs' b c (Some a) = {(a, TCBYieldTo)} \<union> tcb_bound_refs' b c None"
-  "tcb_bound_refs' None None None = {}"
+  "tcb_bound_refs' (Some a) = {(a, TCBBound)}"
+  "tcb_bound_refs' None = {}"
   by (auto simp: tcb_bound_refs'_def)
 
-lemma prod_in_refsD:
-  "\<And>ref x y. (x, ref) \<in> ep_q_refs_of' y \<Longrightarrow> ref \<in> {EPRecv, EPSend}"
-  "\<And>ref x y. (x, ref) \<in> ntfn_q_refs_of' y \<Longrightarrow> ref \<in> {NTFNSignal}"
-  "\<And>ref x y. (x, ref) \<in> tcb_st_refs_of' y \<Longrightarrow> ref \<in> {TCBBlockedRecv, TCBReply, TCBSignal, TCBBlockedSend}"
-  "\<And>ref x a b c. (x, ref) \<in> tcb_bound_refs' a b c \<Longrightarrow> ref \<in> {TCBBound, TCBSchedContext, TCBYieldTo}"
-  apply (rename_tac ep; case_tac ep; simp)
-  apply (rename_tac ep; case_tac ep; simp)
-  apply (rename_tac ep; case_tac ep; clarsimp split: if_splits)
-  apply (clarsimp simp: tcb_bound_refs'_def get_refs_def2)
-  done
-
-\<comment>\<open>
-  Useful rewrite rules for extracting the existence of objects on the other side of symmetric refs.
-  There should be a rewrite corresponding to each entry of @{term symreftype}.
-\<close>
 lemma refs_of_rev':
-  "(x, TCBBlockedSend) \<in> refs_of' ko =
+ "(x, TCBBlockedRecv) \<in> refs_of' ko =
+    (\<exists>tcb. ko = KOTCB tcb \<and> (\<exists>a. tcbState tcb = BlockedOnReceive x a))"
+ "(x, TCBBlockedSend) \<in> refs_of' ko =
     (\<exists>tcb. ko = KOTCB tcb \<and> (\<exists>a b c d. tcbState tcb = BlockedOnSend x a b c d))"
-  "(x, TCBBlockedRecv) \<in> refs_of' ko =
-    (\<exists>tcb. ko = KOTCB tcb \<and> (\<exists>a b. tcbState tcb = BlockedOnReceive x a b))"
-  "(x, TCBSignal) \<in> refs_of' ko =
+ "(x, TCBSignal) \<in> refs_of' ko =
     (\<exists>tcb. ko = KOTCB tcb \<and> tcbState tcb = BlockedOnNotification x)"
-  "(x, TCBBound) \<in>  refs_of' ko =
-    (\<exists>tcb. ko = KOTCB tcb \<and> (tcbBoundNotification tcb = Some x))"
-  "(x, EPSend) \<in> refs_of' ko =
-    (\<exists>ep. ko = KOEndpoint ep \<and> (\<exists>q. ep = SendEP q \<and> x \<in> set q))"
-  "(x, EPRecv) \<in> refs_of' ko =
+ "(x, EPRecv) \<in> refs_of' ko =
     (\<exists>ep. ko = KOEndpoint ep \<and> (\<exists>q. ep = RecvEP q \<and> x \<in> set q))"
-  "(x, NTFNSignal) \<in> refs_of' ko =
+ "(x, EPSend) \<in> refs_of' ko =
+    (\<exists>ep. ko = KOEndpoint ep \<and> (\<exists>q. ep = SendEP q \<and> x \<in> set q))"
+ "(x, NTFNSignal) \<in> refs_of' ko =
     (\<exists>ntfn. ko = KONotification ntfn \<and> (\<exists>q. ntfnObj ntfn = WaitingNtfn q \<and> x \<in> set q))"
-  "(x, NTFNBound) \<in> refs_of' ko =
+ "(x, TCBBound) \<in>  refs_of' ko =
+    (\<exists>tcb. ko = KOTCB tcb \<and> (tcbBoundNotification tcb = Some x))"
+ "(x, NTFNBound) \<in> refs_of' ko =
     (\<exists>ntfn. ko = KONotification ntfn \<and> (ntfnBoundTCB ntfn = Some x))"
-  "(x, TCBSchedContext) \<in> refs_of' ko =
-    (\<exists>tcb. ko = KOTCB tcb \<and> tcbSchedContext tcb = Some x)"
-  "(x, SCTcb) \<in> refs_of' ko =
-    (\<exists>sc. ko = KOSchedContext sc \<and> scTCB sc = Some x)"
-  "(x, NTFNSchedContext) \<in> refs_of' ko =
-    (\<exists>ntfn. ko = KONotification ntfn \<and> ntfnSc ntfn = Some x)"
-  "(x, SCNtfn) \<in> refs_of' ko =
-    (\<exists>sc. ko = KOSchedContext sc \<and> scNtfn sc = Some x)"
-  "(x, SCReply) \<in> refs_of' ko =
-    (\<exists>sc. ko = KOSchedContext sc \<and> scReply sc = Some x)"
-  "(x, ReplySchedContext) \<in> refs_of' ko =
-    (\<exists>reply. ko = KOReply reply \<and> replySC reply = Some x)"
-  "(x, ReplyTCB) \<in> refs_of' ko =
-    (\<exists>reply. ko = KOReply reply \<and> replyTCB reply = Some x)"
-  "(x, TCBYieldTo) \<in> refs_of' ko =
-    (\<exists>tcb. ko = KOTCB tcb \<and> tcbYieldTo tcb = Some x)"
-  "(x, SCYieldFrom) \<in> refs_of' ko =
-    (\<exists>sc. ko = KOSchedContext sc \<and> scYieldFrom sc = Some x)"
   by (auto simp: refs_of'_def
                  tcb_st_refs_of'_def
                  ep_q_refs_of'_def
                  ntfn_q_refs_of'_def
                  ntfn_bound_refs'_def
                  tcb_bound_refs'_def
-                 in_get_refs
           split: Structures_H.kernel_object.splits
                  Structures_H.thread_state.splits
                  Structures_H.endpoint.splits
                  Structures_H.notification.splits
-                 Structures_H.ntfn.splits)
+                 Structures_H.ntfn.splits)+
 
 lemma ko_wp_at'_weakenE:
   "\<lbrakk> ko_wp_at' P p s; \<And>ko. P ko \<Longrightarrow> Q ko \<rbrakk> \<Longrightarrow> ko_wp_at' Q p s"
@@ -1805,7 +1581,7 @@ lemma projectKO_opt_tcbD:
 
 lemma st_tcb_at_refs_of_rev':
   "ko_wp_at' (\<lambda>ko. (x, TCBBlockedRecv) \<in> refs_of' ko) t s
-     = st_tcb_at' (\<lambda>ts. \<exists>a b. ts = BlockedOnReceive x a b) t s"
+     = st_tcb_at' (\<lambda>ts. \<exists>a. ts = BlockedOnReceive x a) t s"
   "ko_wp_at' (\<lambda>ko. (x, TCBBlockedSend) \<in> refs_of' ko) t s
      = st_tcb_at' (\<lambda>ts. \<exists>a b c d. ts = BlockedOnSend x a b c d) t s"
   "ko_wp_at' (\<lambda>ko. (x, TCBSignal) \<in> refs_of' ko) t s
@@ -1831,32 +1607,20 @@ lemma ko_at_state_refs_ofD':
   "ko_at' ko p s \<Longrightarrow> state_refs_of' s p = refs_of' (injectKO ko)"
   by (clarsimp dest!: obj_at_state_refs_ofD')
 
-abbreviation distinct_release_queue :: "kernel_state \<Rightarrow> bool" where
-  "distinct_release_queue \<equiv> \<lambda>s. distinct (ksReleaseQueue s)"
-
 definition
   tcb_ntfn_is_bound' :: "word32 option \<Rightarrow> tcb \<Rightarrow> bool"
 where
   "tcb_ntfn_is_bound' ntfn tcb \<equiv> tcbBoundNotification tcb = ntfn"
 
 lemma st_tcb_at_state_refs_ofD':
-  "st_tcb_at' P t s \<Longrightarrow>
-    \<exists>ts ntfnptr sc_ptr yieldto_ptr. P ts
-                 \<and> obj_at' ((=) ntfnptr o tcbBoundNotification) t s
-                 \<and> obj_at' ((=) sc_ptr o tcbSchedContext) t s
-                 \<and> obj_at' ((=) yieldto_ptr o tcbYieldTo) t s
-                 \<and> state_refs_of' s t = (tcb_st_refs_of' ts
-                                         \<union> tcb_bound_refs' ntfnptr sc_ptr yieldto_ptr)"
+  "st_tcb_at' P t s \<Longrightarrow> \<exists>ts ntfnptr. P ts \<and> obj_at' (tcb_ntfn_is_bound' ntfnptr) t s
+          \<and> state_refs_of' s t = (tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr)"
   by (auto simp: pred_tcb_at'_def tcb_ntfn_is_bound'_def obj_at'_def projectKO_eq
                  project_inject state_refs_of'_def)
 
 lemma bound_tcb_at_state_refs_ofD':
-  "bound_tcb_at' P t s \<Longrightarrow>
-    \<exists>ts ntfnptr sc_ptr yieldto_ptr. P ntfnptr
-                 \<and> obj_at' ((=) ntfnptr o tcbBoundNotification) t s
-                 \<and> obj_at' ((=) sc_ptr o tcbSchedContext) t s
-                 \<and> obj_at' ((=) yieldto_ptr o tcbYieldTo) t s
-          \<and> state_refs_of' s t = (tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr sc_ptr yieldto_ptr)"
+  "bound_tcb_at' P t s \<Longrightarrow> \<exists>ts ntfnptr. P ntfnptr \<and> obj_at' (tcb_ntfn_is_bound' ntfnptr) t s
+          \<and> state_refs_of' s t = (tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr)"
   by (auto simp: pred_tcb_at'_def obj_at'_def tcb_ntfn_is_bound'_def projectKO_eq
                  project_inject state_refs_of'_def)
 
@@ -1879,17 +1643,13 @@ lemma sym_refs_ko_atD':
 
 lemma sym_refs_st_tcb_atD':
   "\<lbrakk> st_tcb_at' P t s; sym_refs (state_refs_of' s) \<rbrakk> \<Longrightarrow>
-     \<exists>ts ntfnptr sc_ptr yieldto_ptr. P ts
-        \<and> obj_at' ((=) ntfnptr o tcbBoundNotification) t s
-        \<and> state_refs_of' s t = tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr sc_ptr yieldto_ptr
-        \<and> (\<forall>(x, tp)\<in>tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr sc_ptr yieldto_ptr.
-              ko_wp_at' (\<lambda>ko. (t, symreftype tp) \<in> refs_of' ko) x s)"
+     \<exists>ts ntfnptr. P ts \<and> obj_at' (tcb_ntfn_is_bound' ntfnptr) t s
+        \<and> state_refs_of' s t = tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr
+        \<and> (\<forall>(x, tp)\<in>tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr. ko_wp_at' (\<lambda>ko. (t, symreftype tp) \<in> refs_of' ko) x s)"
   apply (drule st_tcb_at_state_refs_ofD')
   apply (erule exE)+
   apply (rule_tac x=ts in exI)
   apply (rule_tac x=ntfnptr in exI)
-  apply (rule_tac x=sc_ptr in exI)
-  apply (rule_tac x=yieldto_ptr in exI)
   apply clarsimp
   apply (frule obj_at_state_refs_ofD')
   apply (drule (1)sym_refs_obj_atD')
@@ -1898,48 +1658,26 @@ lemma sym_refs_st_tcb_atD':
 
 lemma sym_refs_bound_tcb_atD':
   "\<lbrakk> bound_tcb_at' P t s; sym_refs (state_refs_of' s) \<rbrakk> \<Longrightarrow>
-     \<exists>ts ntfnptr sc_ptr yieldto_ptr. P ntfnptr
-        \<and> obj_at' ((=) ntfnptr o tcbBoundNotification) t s
-        \<and> state_refs_of' s t = tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr sc_ptr yieldto_ptr
-        \<and> (\<forall>(x, tp)\<in>tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr sc_ptr yieldto_ptr.
-              ko_wp_at' (\<lambda>ko. (t, symreftype tp) \<in> refs_of' ko) x s)"
+     \<exists>ts ntfnptr. P ntfnptr \<and> obj_at' (tcb_ntfn_is_bound' ntfnptr) t s
+        \<and> state_refs_of' s t = tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr
+        \<and> (\<forall>(x, tp)\<in>tcb_st_refs_of' ts \<union> tcb_bound_refs' ntfnptr. ko_wp_at' (\<lambda>ko. (t, symreftype tp) \<in> refs_of' ko) x s)"
   apply (drule bound_tcb_at_state_refs_ofD')
   apply (erule exE)+
   apply (rule_tac x=ts in exI)
   apply (rule_tac x=ntfnptr in exI)
-  apply (rule_tac x=sc_ptr in exI)
-  apply (rule_tac x=yieldto_ptr in exI)
   apply clarsimp
   apply (frule obj_at_state_refs_ofD')
   apply (drule (1)sym_refs_obj_atD')
   apply auto
   done
 
-lemma get_refs_nonempty[simp]:
-  "(get_refs ref_ty ptr_opt \<noteq> {}) = (ptr_opt \<noteq> None)"
-  by (clarsimp simp: get_refs_def split: option.splits)
-
-lemma get_refs_empty[simp]:
-  "(get_refs ref_ty ptr_opt = {}) = (ptr_opt = None)"
-  by (clarsimp simp: get_refs_def split: option.splits)
-
-abbreviation idle_refs :: "(machine_word \<times> reftype) set" where
-  "idle_refs \<equiv> {(idle_sc_ptr, TCBSchedContext), (idle_thread_ptr, SCTcb)}"
-
-\<comment>\<open>
-  This set subtraction gets simplified into a subset relation at all the places
-  we might want to use this rule, so we do that ahead of time.
-\<close>
-lemma refs_of_live'[simplified]:
-  "refs_of' ko - idle_refs \<noteq> {} \<Longrightarrow> live' ko"
-  apply (cases ko; simp)
-      apply clarsimp
-     apply (rename_tac notification)
-     apply (case_tac "ntfnObj notification";
-            fastforce simp: live_ntfn'_def)
-    apply fastforce
-   apply (fastforce simp: live_sc'_def)
-  apply (fastforce simp: live_reply'_def)
+lemma refs_of_live':
+  "refs_of' ko \<noteq> {} \<Longrightarrow> live' ko"
+  apply (cases ko, simp_all)
+    apply clarsimp
+   apply (rename_tac notification)
+   apply (case_tac "ntfnObj notification"; simp)
+    apply fastforce+
   done
 
 lemma if_live_then_nonz_capE':
@@ -1956,11 +1694,10 @@ lemma if_live_then_nonz_capD':
 
 lemma if_live_state_refsE:
   "\<lbrakk> if_live_then_nonz_cap' s;
-     state_refs_of' s p - idle_refs \<noteq> {} \<rbrakk> \<Longrightarrow> ex_nonz_cap_to' p s"
-  apply (erule if_live_then_nonz_capE')
-  apply (simp add: state_refs_of'_def ko_wp_at'_def refs_of_live'
-              split: if_split_asm option.splits)
-  done
+     state_refs_of' s p \<noteq> {} \<rbrakk> \<Longrightarrow> ex_nonz_cap_to' p s"
+  by (clarsimp simp: state_refs_of'_def ko_wp_at'_def
+              split: option.splits if_split_asm
+              elim!: refs_of_live' if_live_then_nonz_capE')
 
 lemmas ex_cte_cap_to'_def = ex_cte_cap_wp_to'_def
 
@@ -1984,10 +1721,6 @@ lemma valid_objsE' [elim]:
   "\<lbrakk> valid_objs' s; ksPSpace s x = Some obj; valid_obj' obj s \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
   unfolding valid_objs'_def by auto
 
-lemma valid_objs_sizeE' [elim]:
-  "\<lbrakk> valid_objs_size' s; ksPSpace s x = Some obj; valid_obj_size' obj s \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
-  unfolding valid_objs_size'_def by auto
-
 lemma pspace_distinctD':
   "\<lbrakk> ksPSpace s x = Some v; pspace_distinct' s \<rbrakk> \<Longrightarrow> ps_clear x (objBitsKO v) s"
   apply (simp add: pspace_distinct'_def)
@@ -2002,13 +1735,6 @@ lemma pspace_alignedD':
   apply simp
   done
 
-lemma pspace_boundedD':
-  "\<lbrakk> ksPSpace s x = Some v; pspace_bounded' s \<rbrakk> \<Longrightarrow> objBitsKO v < word_bits"
-  apply (simp add: pspace_bounded'_def)
-  apply (drule bspec, erule domI)
-  apply simp
-  done
-
 lemma next_unfold:
   "mdb_next s c =
    (case s c of Some cte \<Rightarrow> Some (mdbNext (cteMDBNode cte)) | None \<Rightarrow> None)"
@@ -2035,32 +1761,32 @@ lemma valid_pde_mapping'_simps[simp]:
 lemmas valid_irq_states'_def = valid_irq_masks'_def
 
 lemma valid_pspaceI' [intro]:
-  "\<lbrakk>valid_objs' s; pspace_aligned' s; pspace_distinct' s; pspace_bounded' s; valid_mdb' s; no_0_obj' s;
-    valid_replies' s\<rbrakk>
+  "\<lbrakk>valid_objs' s; pspace_aligned' s; pspace_distinct' s; valid_mdb' s; no_0_obj' s\<rbrakk>
   \<Longrightarrow> valid_pspace' s"  unfolding valid_pspace'_def by simp
 
 lemma valid_pspaceE' [elim]:
   "\<lbrakk>valid_pspace' s;
-    \<lbrakk> valid_objs' s; valid_replies' s; pspace_aligned' s; pspace_distinct' s; pspace_bounded' s;
-      no_0_obj' s; valid_mdb' s\<rbrakk> \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
+    \<lbrakk> valid_objs' s; pspace_aligned' s; pspace_distinct' s; no_0_obj' s;
+      valid_mdb' s\<rbrakk> \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
   unfolding valid_pspace'_def by simp
 
-lemma idle'_only_sc_refs:
-  "valid_idle' s \<Longrightarrow> state_refs_of' s (ksIdleThread s) = {(idle_sc_ptr, TCBSchedContext)}"
+lemma idle'_no_refs:
+  "valid_idle' s \<Longrightarrow> state_refs_of' s (ksIdleThread s) = {}"
   by (clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def tcb_ntfn_is_bound'_def
                      projectKO_eq project_inject state_refs_of'_def idle_tcb'_def)
 
 lemma idle'_not_queued':
   "\<lbrakk>valid_idle' s; sym_refs (state_refs_of' s);
-    state_refs_of' s ptr = insert t queue \<times> {rt}; ksIdleThread s \<in> queue\<rbrakk>
-     \<Longrightarrow> ptr = idle_sc_ptr"
-  by (frule idle'_only_sc_refs, fastforce simp: valid_idle'_def sym_refs_def)
+    state_refs_of' s ptr = insert t queue \<times> {rt}\<rbrakk>\<Longrightarrow>
+   ksIdleThread s \<notin> queue"
+  by (frule idle'_no_refs, fastforce simp: valid_idle'_def sym_refs_def)
 
 lemma idle'_not_queued:
   "\<lbrakk>valid_idle' s; sym_refs (state_refs_of' s);
-    state_refs_of' s ptr = queue \<times> {rt}; ksIdleThread s \<in> queue\<rbrakk>
-      \<Longrightarrow> ptr = idle_sc_ptr"
-  by (frule idle'_only_sc_refs, fastforce simp: valid_idle'_def sym_refs_def)
+    state_refs_of' s ptr = queue \<times> {rt}\<rbrakk> \<Longrightarrow>
+   ksIdleThread s \<notin> queue"
+  by (frule idle'_no_refs, fastforce simp: valid_idle'_def sym_refs_def)
+
 
 lemma obj_at_conj':
   "\<lbrakk> obj_at' P p s; obj_at' Q p s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>k. P k \<and> Q k) p s"
@@ -2072,10 +1798,6 @@ lemma pred_tcb_at_conj':
   apply (erule (1) obj_at_conj')
   done
 
-lemma pred_tcb_at'_eq_commute:
-  "pred_tcb_at' proj ((=) v) = pred_tcb_at' proj (\<lambda>x. x = v)"
-  by (intro ext) (auto simp: pred_tcb_at'_def obj_at'_def)
-
 lemma obj_at_False' [simp]:
   "obj_at' (\<lambda>k. False) t s = False"
   by (simp add: obj_at'_def)
@@ -2088,29 +1810,24 @@ lemma obj_at'_pspaceI:
   "obj_at' t ref s \<Longrightarrow> ksPSpace s = ksPSpace s' \<Longrightarrow>  obj_at' t ref s'"
   by (auto intro!: projectKO_stateI simp: obj_at'_def ps_clear_def)
 
-lemma sc_at'_n_pspaceI:
-  "sc_at'_n n ref s \<Longrightarrow> ksPSpace s = ksPSpace s' \<Longrightarrow>  sc_at'_n n ref s'"
-  by (auto intro!: projectKO_stateI simp: ko_wp_at'_def ps_clear_def)
-
 lemma cte_wp_at'_pspaceI:
   "\<lbrakk>cte_wp_at' P p s; ksPSpace s = ksPSpace s'\<rbrakk> \<Longrightarrow> cte_wp_at' P p s'"
   supply if_cong[cong]
-  apply (clarsimp simp: cte_wp_at'_def getObject_def readObject_def gets_the_def)
+  apply (clarsimp simp add: cte_wp_at'_def getObject_def)
   apply (drule equalityD2)
-  apply (clarsimp simp: in_monad loadObject_cte gets_def asks_def
-                        get_def bind_def split_def oassert_opt_def
-                 split: option.split_asm)
-  apply (rename_tac b; case_tac b)
-           apply (simp_all add: in_monad read_typeError_def)
+  apply (clarsimp simp: in_monad loadObject_cte gets_def
+                        get_def bind_def return_def split_def)
+  apply (case_tac b)
+        apply (simp_all add: in_monad typeError_def)
    prefer 2
-   apply (simp add: in_monad omonad_defs read_alignError_def obind_def
-                    read_alignCheck_def read_magnitudeCheck_def return_def
+   apply (simp add: in_monad return_def alignError_def assert_opt_def
+                    alignCheck_def magnitudeCheck_def when_def bind_def
              split: if_split_asm option.splits)
-  apply (clarsimp simp: in_monad omonad_defs read_alignError_def obind_def
-                        read_alignCheck_def read_magnitudeCheck_def return_def
+  apply (clarsimp simp: in_monad return_def alignError_def fail_def assert_opt_def
+                        alignCheck_def bind_def when_def
                         objBits_cte_conv tcbCTableSlot_def tcbVTableSlot_def
-                        cteSizeBits_def tcbIPCBufferSlot_def tcbFaultHandlerSlot_def
-                 split: if_split_asm option.split_asm
+                        tcbReplySlot_def cteSizeBits_def
+                 split: if_split_asm
                  dest!: singleton_in_magnitude_check)
   done
 
@@ -2129,7 +1846,7 @@ lemma valid_cap'_pspaceI:
   by (cases cap)
      (force intro: obj_at'_pspaceI[rotated]
                   cte_wp_at'_pspaceI valid_untyped'_pspaceI
-                  typ_at'_pspaceI[rotated] sc_at'_n_pspaceI[rotated]
+                  typ_at'_pspaceI[rotated]
             simp: page_table_at'_def page_directory_at'_def
            split: arch_capability.split zombie_type.split option.splits)+
 
@@ -2152,17 +1869,12 @@ lemma valid_obj'_pspaceI:
   unfolding valid_obj'_def
   by (cases obj)
      (auto simp: valid_ep'_def valid_ntfn'_def valid_tcb'_def valid_cte'_def
-                 valid_tcb_state'_def valid_arch_obj'_pspaceI valid_bound_obj'_def
-                 valid_sched_context'_def valid_reply'_def
+                 valid_tcb_state'_def valid_arch_obj'_pspaceI valid_bound_tcb'_def
+                 valid_bound_ntfn'_def
            split: Structures_H.endpoint.splits Structures_H.notification.splits
                   Structures_H.thread_state.splits ntfn.splits option.splits
            intro: obj_at'_pspaceI valid_cap'_pspaceI)
 
-lemma valid_obj_size'_pspaceI:
-  "valid_obj_size' obj s \<Longrightarrow> ksPSpace s = ksPSpace s' \<Longrightarrow> valid_obj_size' obj s'"
-  unfolding valid_obj_size'_def
-  by (cases obj; simp)
-
 lemma pred_tcb_at'_pspaceI:
   "pred_tcb_at' proj P t s \<Longrightarrow> ksPSpace s = ksPSpace s' \<Longrightarrow> pred_tcb_at' proj P t s'"
   unfolding pred_tcb_at'_def by (fast intro: obj_at'_pspaceI)
@@ -2171,33 +1883,23 @@ lemma valid_mdb'_pspaceI:
   "valid_mdb' s \<Longrightarrow> ksPSpace s = ksPSpace s' \<Longrightarrow> valid_mdb' s'"
   unfolding valid_mdb'_def by simp
 
-lemma valid_replies'_pspaceI:
-  "valid_replies' s \<Longrightarrow> ksPSpace s = ksPSpace s' \<Longrightarrow> valid_replies' s'"
-  unfolding valid_replies'_def
-  apply clarsimp
-  apply (drule_tac x=rptr in spec)
-  apply (auto simp: opt_map_def intro: pred_tcb_at'_pspaceI)
-  done
-
 lemma state_refs_of'_pspaceI:
   "P (state_refs_of' s) \<Longrightarrow> ksPSpace s = ksPSpace s' \<Longrightarrow> P (state_refs_of' s')"
-  unfolding state_refs_of'_def ps_clear_def
-  by (erule rsubst[where P=P], rule ext) (simp split: option.splits)
+  unfolding state_refs_of'_def ps_clear_def by (simp cong: option.case_cong)
 
 lemma valid_pspace':
   "valid_pspace' s \<Longrightarrow> ksPSpace s = ksPSpace s' \<Longrightarrow> valid_pspace' s'"
-  by (auto simp add: valid_pspace'_def valid_objs'_def pspace_aligned'_def
+  by  (auto simp add: valid_pspace'_def valid_objs'_def pspace_aligned'_def
                      pspace_distinct'_def ps_clear_def no_0_obj'_def ko_wp_at'_def
-                     typ_at'_def pspace_bounded'_def
-              intro: valid_obj'_pspaceI valid_mdb'_pspaceI valid_replies'_pspaceI)
+                     typ_at'_def
+           intro: valid_obj'_pspaceI valid_mdb'_pspaceI)
 
 lemma valid_idle'_pspace_itI[elim]:
   "\<lbrakk> valid_idle' s; ksPSpace s = ksPSpace s'; ksIdleThread s = ksIdleThread s' \<rbrakk>
       \<Longrightarrow> valid_idle' s'"
   apply (clarsimp simp: valid_idle'_def ex_nonz_cap_to'_def)
-  apply (rule conjI)
-   apply (erule obj_at'_pspaceI, assumption)
-  using obj_at'_pspaceI by blast
+  apply (erule obj_at'_pspaceI, assumption)
+  done
 
 lemma obj_at'_weaken:
   assumes x: "obj_at' P t s"
@@ -2356,83 +2058,43 @@ lemma ps_clear_lookupAround2:
   apply (drule word_le_minus_one_leq, fastforce)
   done
 
-lemma magnitudeCheck_wp:
-  "\<lbrace>\<lambda>s. (case next of
-                  Some next' \<Rightarrow> next' - ptr \<ge> 1 << bits
-                | None \<Rightarrow> True)
-        \<longrightarrow> P s\<rbrace>
-   magnitudeCheck ptr next bits
-   \<lbrace>\<lambda>_. P\<rbrace>"
-  unfolding magnitudeCheck_def read_magnitudeCheck_def
-  apply (simp add: gets_the_def exec_gets assert_opt_def valid_def
-                   return_def split_def fail_def
-            split: option.split)
-  done
-
-
-lemma alignCheck_wp:
-  "\<lbrace>\<lambda>s. is_aligned ptr bits \<longrightarrow> P s\<rbrace>
-   alignCheck ptr bits
-   \<lbrace>\<lambda>_. P\<rbrace>"
-  unfolding alignCheck_def read_alignCheck_def
-  apply (wpsimp simp: read_alignError_def is_aligned_mask omonad_defs)
-  done
-
-lemma lookupAround2_no_after_ps_clear:
-  "snd (lookupAround2 p (ksPSpace s)) = None \<Longrightarrow> ps_clear p bits s"
-  apply (fastforce simp: ps_clear_def lookupAround2_None2 dom_def set_eq_iff word_le_less_eq)
-  done
-
-lemma lookupAround2_after_ps_clear:
-  "\<lbrakk>snd (lookupAround2 p (ksPSpace s)) = Some after;
-    2 ^ bits \<le> after - p;
-    1 < (2 :: machine_word) ^ bits;
-    is_aligned p bits\<rbrakk> \<Longrightarrow>
-   ps_clear p bits s"
-  apply (rule ps_clearI; clarsimp simp: lookupAround2_char2)
-  apply (rename_tac x obj_after)
-  apply (drule_tac x=x in spec)
-  apply (frule word_l_diffs, simp)
-  apply (prop_tac "x < after")
-   apply (frule word_leq_minus_one_le[rotated])
-    apply (metis add.commute arith_simps(49) plus_minus_not_NULL_ab word_le_less_eq
-                 word_not_simps(1))
-   apply (frule_tac a=x in order.strict_trans2; fastforce simp: add.commute)
-  apply clarsimp
-  done
-
-lemma read_magnitude_check_simp[simp]:
-  assumes "is_aligned ptr bits"
-          "(1 :: machine_word) < 2 ^ bits"
-          "ksPSpace s ptr = Some y"
-  shows "read_magnitudeCheck ptr (snd (lookupAround2 ptr (ksPSpace s))) bits s = Some ()
-          = ps_clear ptr bits s"
-  using assms
-  apply (clarsimp simp: read_magnitudeCheck_def)
+lemma in_magnitude_check:
+  "\<lbrakk> is_aligned x n; (1 :: word32) < 2 ^ n; ksPSpace s x = Some y \<rbrakk> \<Longrightarrow>
+   ((v, s') \<in> fst (magnitudeCheck x (snd (lookupAround2 x (ksPSpace s))) n s))
+     = (s' = s \<and> ps_clear x n s)"
   apply (rule iffI)
-   apply (clarsimp simp: lookupAround2_no_after_ps_clear lookupAround2_after_ps_clear omonad_defs
-                  split: option.splits if_split_asm)
-  apply (fastforce elim!: ps_clear_lookupAround2 is_aligned_no_overflow split: option.splits)
+   apply (clarsimp simp: magnitudeCheck_def in_monad lookupAround2_None2
+                         lookupAround2_char2
+                  split: option.split_asm)
+    apply (erule(1) ps_clearI)
+    apply simp
+   apply (erule(1) ps_clearI)
+   apply (simp add: linorder_not_less)
+   apply (drule word_leq_le_minus_one[where x="2 ^ n"])
+    apply (clarsimp simp: power_overflow)
+   apply (drule word_l_diffs)
+    apply simp
+   apply (simp add: field_simps)
+  apply clarsimp
+  apply (erule is_aligned_get_word_bits)
+   apply (erule(1) ps_clear_lookupAround2)
+     apply simp
+    apply (simp add: is_aligned_no_overflow)
+   apply (clarsimp simp add: magnitudeCheck_def in_monad
+                      split: option.split_asm)
+   apply simp
+  apply (simp add: power_overflow)
   done
 
-lemma in_magnitude_check:
-  assumes "is_aligned ptr bits"
-          "(1 :: machine_word) < 2 ^ bits"
-          "ksPSpace s ptr = Some y"
-  shows "((v, s') \<in> fst (magnitudeCheck ptr (snd (lookupAround2 ptr (ksPSpace s))) bits s))
-          = (s' = s \<and> ps_clear ptr bits s)"
-  using assms
-  by (clarsimp simp: magnitudeCheck_def in_monad)
-
-lemma read_magnitude_check3[simp]:
+lemma in_magnitude_check3:
   "\<lbrakk> \<forall>z. x < z \<and> z \<le> y \<longrightarrow> ksPSpace s z = None; is_aligned x n;
      (1 :: word32) < 2 ^ n; ksPSpace s x = Some v; x \<le> y; y - x < 2 ^ n \<rbrakk> \<Longrightarrow>
-   read_magnitudeCheck x (snd (lookupAround2 y (ksPSpace s))) n s
-     = (if ps_clear x n s then Some () else None)"
-  apply (clarsimp simp: read_magnitudeCheck_def lookupAround2_char2
-                        lookupAround2_None2 in_monad
-                 split: option.splits)
-  apply safe
+   fst (magnitudeCheck x (snd (lookupAround2 y (ksPSpace s))) n s)
+     = (if ps_clear x n s then {((), s)} else {})"
+  apply (rule set_eqI, rule iffI)
+   apply (clarsimp simp: magnitudeCheck_def lookupAround2_char2
+                         lookupAround2_None2 in_monad
+                  split: option.split_asm)
     apply (drule(1) range_convergence1)
     apply (erule(1) ps_clearI)
     apply simp
@@ -2444,6 +2106,7 @@ lemma read_magnitude_check3[simp]:
     apply (drule word_l_diffs, simp)
     apply (simp add: field_simps)
    apply (simp add: power_overflow)
+  apply (clarsimp split: if_split_asm)
   apply (erule(1) ps_clear_lookupAround2)
     apply simp
    apply (drule word_le_minus_one_leq[where x="y - x"])
@@ -2452,28 +2115,16 @@ lemma read_magnitude_check3[simp]:
      apply (simp add: field_simps is_aligned_no_overflow)
     apply simp
    apply (simp add: field_simps)
-  apply (fastforce simp: lookupAround2_None2 lookupAround2_char2
-                  split: option.split_asm)
-  done
-
-lemma in_magnitude_check3:
-  "\<lbrakk> \<forall>z. x < z \<and> z \<le> y \<longrightarrow> ksPSpace s z = None; is_aligned x n;
-     (1 :: word32) < 2 ^ n; ksPSpace s x = Some v; x \<le> y; y - x < 2 ^ n \<rbrakk> \<Longrightarrow>
-   fst (magnitudeCheck x (snd (lookupAround2 y (ksPSpace s))) n s)
-     = (if ps_clear x n s then {((), s)} else {})"
-   apply (clarsimp simp: magnitudeCheck_def gets_the_def
-                         exec_gets in_monad return_def assert_opt_def fail_def
-                  split: option.split_asm)
+  apply (simp add: magnitudeCheck_def return_def
+                   iffD2[OF linorder_not_less] when_def
+            split: option.split_asm)
   done
 
-lemma read_alignCheck_simp[simp]:
-  "read_alignCheck x n s = Some v = is_aligned x n"
-  by (simp add: read_alignCheck_def is_aligned_mask[symmetric]
-                read_alignError_def omonad_defs)
-
 lemma in_alignCheck[simp]:
   "((v, s') \<in> fst (alignCheck x n s)) = (s' = s \<and> is_aligned x n)"
-  by (simp add: alignCheck_def in_monad)
+  by (simp add: alignCheck_def in_monad is_aligned_mask[symmetric]
+                alignError_def conj_comms
+          cong: conj_cong)
 
 lemma tcb_space_clear:
   "\<lbrakk> tcb_cte_cases (y - x) = Some (getF, setF);
@@ -2516,70 +2167,73 @@ lemma cte_wp_at_cases':
              \<and> tcb_cte_cases n = Some (getF, setF) \<and> P (getF tcb) \<and> ps_clear (p - n) tcbBlockSizeBits s))"
   (is "?LHS = ?RHS")
   apply (rule iffI)
-   apply (clarsimp simp: cte_wp_at'_def gets_the_def readObject_def
-                         getObject_def bind_def simpler_gets_def omonad_defs
+   apply (clarsimp simp: cte_wp_at'_def split_def
+                         getObject_def bind_def simpler_gets_def
                          assert_opt_def return_def fail_def
-                  split: option.splits dest!: prod_injects
+                  split: option.splits
                     del: disjCI)
-   apply (clarsimp simp: loadObject_cte read_typeError_def split_def
+   apply (clarsimp simp: loadObject_cte typeError_def alignError_def
                          fail_def return_def objBits_simps'
-                         is_aligned_mask[symmetric]
+                         is_aligned_mask[symmetric] alignCheck_def
                          tcbVTableSlot_def field_simps tcbCTableSlot_def
+                         tcbReplySlot_def tcbCallerSlot_def
                          tcbIPCBufferSlot_def
-                         tcbFaultHandlerSlot_def tcbTimeoutHandlerSlot_def
-                         lookupAround2_char1 omonad_defs
+                         lookupAround2_char1
                          cte_level_bits_def Ball_def
                          unless_def when_def bind_def
                   split: kernel_object.splits if_split_asm option.splits
                     del: disjCI)
-       apply ((rule disjI2)?, fastforce simp: field_simps elim: rsubst[where P="\<lambda>x. ksPSpace s x = v" for s v])+
-  apply (simp add: cte_wp_at'_def getObject_def split_def gets_the_def
-                   bind_def simpler_gets_def return_def readObject_def
-                   assert_opt_def fail_def objBits_simps' omonad_defs obind_def
+        apply (subst(asm) in_magnitude_check3, simp+,
+               simp split: if_split_asm, (rule disjI2)?, intro exI, rule conjI,
+               erule rsubst[where P="\<lambda>x. ksPSpace s x = v" for s v],
+               fastforce simp add: field_simps, simp)+
+   apply (subst(asm) in_magnitude_check3, simp+)
+   apply (simp split: if_split_asm)
+  apply (simp add: cte_wp_at'_def getObject_def split_def
+                   bind_def simpler_gets_def return_def
+                   assert_opt_def fail_def objBits_simps'
             split: option.splits)
   apply (elim disjE conjE exE)
    apply (erule(1) ps_clear_lookupAround2)
      apply simp
     apply (simp add: field_simps)
     apply (erule is_aligned_no_wrap')
-    apply (simp add: cte_level_bits_def word_bits_conv)
-   apply (simp add: cte_level_bits_def)
+     apply (simp add: cte_level_bits_def word_bits_conv)
+    apply (simp add: cte_level_bits_def)
    apply (simp add: loadObject_cte unless_def alignCheck_def
                     is_aligned_mask[symmetric] objBits_simps'
-                    cte_level_bits_def magnitudeCheck_def obind_def
-                    read_magnitudeCheck_def read_alignCheck_def
-                    omonad_defs return_def fail_def)
+                    cte_level_bits_def magnitudeCheck_def
+                    return_def fail_def)
    apply (clarsimp simp: bind_def return_def when_def fail_def
                   split: option.splits)
    apply simp
   apply (erule(1) ps_clear_lookupAround2)
-    apply (subgoal_tac "p - n \<le> (p - n) + n", simp)
-    apply (erule is_aligned_no_wrap')
-    apply (simp add: word_bits_conv)
-    apply (simp add: tcb_cte_cases_def split: if_split_asm)
-   apply (subgoal_tac "(p - n) + n \<le> (p - n) + 511")
-    apply (simp add: field_simps)
-   apply (rule word_plus_mono_right)
-    apply (simp add: tcb_cte_cases_def split: if_split_asm)
+    prefer 3
+    apply (simp add: loadObject_cte unless_def alignCheck_def
+                    is_aligned_mask[symmetric] objBits_simps'
+                    cte_level_bits_def magnitudeCheck_def
+                    return_def fail_def tcbCTableSlot_def tcbVTableSlot_def
+                    tcbIPCBufferSlot_def tcbReplySlot_def tcbCallerSlot_def
+                split: option.split_asm)
+     apply (clarsimp simp: bind_def tcb_cte_cases_def split: if_split_asm)
+    apply (clarsimp simp: bind_def tcb_cte_cases_def iffD2[OF linorder_not_less]
+                          return_def
+                   split: if_split_asm)
+   apply (subgoal_tac "p - n \<le> (p - n) + n", simp)
    apply (erule is_aligned_no_wrap')
-   apply simp
-  apply (simp add: loadObject_cte unless_def alignCheck_def
-                   is_aligned_mask[symmetric] objBits_simps'
-                   cte_level_bits_def magnitudeCheck_def
-                   return_def fail_def tcbCTableSlot_def tcbVTableSlot_def
-                   tcbFaultHandlerSlot_def tcbTimeoutHandlerSlot_def
-                   tcbIPCBufferSlot_def omonad_defs obind_def
-                   read_magnitudeCheck_def read_alignCheck_def
-            split: option.split_asm)
-   apply (clarsimp simp: bind_def tcb_cte_cases_def split: if_split_asm)
-  apply (clarsimp simp: bind_def tcb_cte_cases_def iffD2[OF linorder_not_less]
-                        return_def
-                 split: if_split_asm)
+    apply (simp add: word_bits_conv)
+   apply (simp add: tcb_cte_cases_def split: if_split_asm)
+  apply (subgoal_tac "(p - n) + n \<le> (p - n) + 511")
+   apply (simp add: field_simps)
+  apply (rule word_plus_mono_right)
+   apply (simp add: tcb_cte_cases_def split: if_split_asm)
+  apply (erule is_aligned_no_wrap')
+  apply simp
   done
 
 lemma tcb_at_cte_at':
   "tcb_at' t s \<Longrightarrow> cte_at' t s"
-  apply (clarsimp simp add: cte_wp_at_cases' obj_at'_def projectKO_def oassert_opt_def
+  apply (clarsimp simp add: cte_wp_at_cases' obj_at'_def projectKO_def
                        del: disjCI)
   apply (case_tac ko)
    apply (simp_all add: projectKO_opt_tcb fail_def)
@@ -2624,30 +2278,14 @@ lemma obj_at_ko_at':
   "obj_at' P p s \<Longrightarrow> \<exists>ko. ko_at' ko p s \<and> P ko"
   by (auto simp add: obj_at'_def)
 
-lemma ko_at_obj_at':
-  "\<lbrakk>ko_at' ko ptr s; P ko\<rbrakk> \<Longrightarrow>
-   obj_at' P ptr s"
-  by (clarsimp simp: obj_at'_def)
-
-lemma obj_at_ko_at'_eq:
-  "(\<exists>ko. ko_at' ko p s \<and> P ko) = obj_at' P p s"
-  apply (intro iffI; clarsimp simp: obj_at_ko_at')
-  unfolding obj_at'_def
-  by blast
-
-lemma ko_at'_replies_of':
-  "ko_at' reply ptr s \<Longrightarrow> replies_of' s ptr = Some reply"
-  apply (clarsimp simp: obj_at'_def projectKO_eq opt_map_def)
-  done
-
 lemma obj_at_aligned':
-  fixes P :: "'a :: pspace_storable \<Rightarrow> bool"
+  fixes P :: "('a :: pspace_storable) \<Rightarrow> bool"
   assumes oat: "obj_at' P p s"
   and    oab: "\<And>(v :: 'a) (v' :: 'a). objBits v = objBits v'"
   shows "is_aligned p (objBits (obj :: 'a))"
   using oat
   apply (clarsimp simp add: obj_at'_def)
-  apply (clarsimp simp add: projectKO_def fail_def return_def oassert_opt_def
+  apply (clarsimp simp add: projectKO_def fail_def return_def
                             project_inject objBits_def[symmetric]
                      split: option.splits)
   apply (erule subst[OF oab])
@@ -2661,65 +2299,76 @@ lemma locateSlot_conv:
     x \<leftarrow> stateAssert (\<lambda>s. case (gsCNodes s A) of None \<Rightarrow> False | Some n \<Rightarrow> n = bits \<and> B < 2 ^ n) [];
     locateSlotBasic A B od)"
   "locateSlotCap c B = (do
-    x \<leftarrow> stateAssert (\<lambda>s.
-            (
-             (isCNodeCap c
-              \<or> (isZombie c \<and> capZombieType c \<noteq> ZombieTCB))
-             \<and> (case gsCNodes s (capUntypedPtr c) of
-                  None \<Rightarrow> False
+    x \<leftarrow> stateAssert (\<lambda>s. ((isCNodeCap c \<or> (isZombie c \<and> capZombieType c \<noteq> ZombieTCB))
+            \<and> (case gsCNodes s (capUntypedPtr c) of None \<Rightarrow> False
                 | Some n \<Rightarrow> (isCNodeCap c \<and> n = capCNodeBits c
-                             \<or> isZombie c \<and> n = zombieCTEBits (capZombieType c)) \<and> B < 2 ^ n)
-            )
-            \<or> isThreadCap c
-            \<or> (isZombie c \<and> capZombieType c = ZombieTCB)) [];
+                    \<or> isZombie c \<and> n = zombieCTEBits (capZombieType c)) \<and> B < 2 ^ n))
+        \<or> isThreadCap c \<or> (isZombie c \<and> capZombieType c = ZombieTCB)) [];
     locateSlotBasic (capUntypedPtr c) B od)"
   apply (simp_all add: locateSlotCap_def locateSlotTCB_def fun_eq_iff)
     apply (simp add: locateSlotBasic_def objBits_simps cte_level_bits_def objBits_defs)
    apply (simp add: locateSlotCNode_def stateAssert_def)
-  apply (cases c; simp)
-  by (auto simp: locateSlotCNode_def isZombie_def isThreadCap_def
-                 isCNodeCap_def capUntypedPtr_def stateAssert_def
-                 bind_assoc exec_get locateSlotTCB_def assert_def
-                 objBits_simps'
-          split: zombie_type.split option.split)
-
-context
-begin
-
-private method typ_at_proof =
-  unfold obj_at'_real_def typ_at'_def ko_wp_at'_def,
-  (rule ext)+,
-  (rule iffI; clarsimp, case_tac ko; clarsimp simp: projectKO_opts_defs)
+  apply (cases c, simp_all add: locateSlotCNode_def isZombie_def isThreadCap_def
+                                isCNodeCap_def capUntypedPtr_def stateAssert_def
+                                bind_assoc exec_get locateSlotTCB_def
+                                objBits_simps'
+                           split: zombie_type.split
+                           cong: option.case_cong)
+  done
 
 lemma typ_at_tcb':
   "typ_at' TCBT = tcb_at'"
-  by typ_at_proof
+  apply (rule ext)+
+  apply (simp add: obj_at'_real_def typ_at'_def)
+  apply (simp add: ko_wp_at'_def)
+  apply (rule iffI)
+   apply clarsimp
+   apply (case_tac ko)
+   apply (auto simp: projectKO_opt_tcb)[9]
+  apply (case_tac ko)
+  apply (auto simp: projectKO_opt_tcb)
+  done
 
-lemma typ_at_ep:  (* FIXME: rename to ' *)
+lemma typ_at_ep:
   "typ_at' EndpointT = ep_at'"
-  by typ_at_proof
+  apply (rule ext)+
+  apply (simp add: obj_at'_real_def typ_at'_def)
+  apply (simp add: ko_wp_at'_def)
+  apply (rule iffI)
+   apply clarsimp
+   apply (case_tac ko)
+   apply (auto simp: projectKO_opt_ep)[9]
+  apply (case_tac ko)
+  apply (auto simp: projectKO_opt_ep)
+  done
 
-lemma typ_at_ntfn: (* FIXME: rename to ' *)
+lemma typ_at_ntfn:
   "typ_at' NotificationT = ntfn_at'"
-  by typ_at_proof
+  apply (rule ext)+
+  apply (simp add: obj_at'_real_def typ_at'_def)
+  apply (simp add: ko_wp_at'_def)
+  apply (rule iffI)
+   apply clarsimp
+   apply (case_tac ko)
+   apply (auto simp: projectKO_opt_ntfn)[8]
+  apply clarsimp
+  apply (case_tac ko)
+  apply (auto simp: projectKO_opt_ntfn)
+  done
 
-lemma typ_at_cte: (* FIXME: rename to ' *)
+lemma typ_at_cte:
   "typ_at' CTET = real_cte_at'"
-  by typ_at_proof
-
-lemma typ_at_reply':
-  "typ_at' ReplyT = reply_at'"
-  by typ_at_proof
-
-lemma typ_at_sc':
-  "typ_at' SchedContextT = sc_at'"
-  by typ_at_proof
-
-lemmas typ_ats' = typ_at_sc' typ_at_reply' typ_at_cte typ_at_ntfn typ_at_ep typ_at_tcb'
-
-end
-
-
+  apply (rule ext)+
+  apply (simp add: obj_at'_real_def typ_at'_def)
+  apply (simp add: ko_wp_at'_def)
+  apply (rule iffI)
+   apply clarsimp
+   apply (case_tac ko)
+   apply (auto simp: projectKO_opt_cte)[8]
+  apply clarsimp
+  apply (case_tac ko)
+  apply (auto simp: projectKO_opt_cte)
+  done
 
 lemma cte_at_typ':
   "cte_at' c = (\<lambda>s. typ_at' CTET c s \<or> (\<exists>n. typ_at' TCBT (c - n) s \<and> n \<in> dom tcb_cte_cases))"
@@ -2730,213 +2379,58 @@ proof -
   have Q: "\<And>P f. (\<exists>x. (\<exists>y. x = f y) \<and> P x) = (\<exists>y. P (f y))"
     by fastforce
   show ?thesis
-    by (fastforce simp: cte_wp_at_cases' obj_at'_real_def typ_at'_def word_bits_def
+    by (fastforce simp: cte_wp_at_cases' obj_at'_real_def typ_at'_def
                         ko_wp_at'_def objBits_simps' P Q conj_comms cte_level_bits_def)
 qed
 
-lemma typ_at_lift_tcb'_strong:
-  "f \<lbrace>\<lambda>s. P (typ_at' TCBT p s)\<rbrace> \<Longrightarrow> f \<lbrace>\<lambda>s. P (tcb_at' p s)\<rbrace>"
+lemma typ_at_lift_tcb':
+  "\<lbrace>typ_at' TCBT p\<rbrace> f \<lbrace>\<lambda>_. typ_at' TCBT p\<rbrace> \<Longrightarrow> \<lbrace>tcb_at' p\<rbrace> f \<lbrace>\<lambda>_. tcb_at' p\<rbrace>"
   by (simp add: typ_at_tcb')
 
-lemma typ_at_lift_ep'_strong:
-  "f \<lbrace>\<lambda>s. P (typ_at' EndpointT p s)\<rbrace> \<Longrightarrow> f \<lbrace>\<lambda>s. P (ep_at' p s)\<rbrace>"
+lemma typ_at_lift_ep':
+  "\<lbrace>typ_at' EndpointT p\<rbrace> f \<lbrace>\<lambda>_. typ_at' EndpointT p\<rbrace> \<Longrightarrow> \<lbrace>ep_at' p\<rbrace> f \<lbrace>\<lambda>_. ep_at' p\<rbrace>"
   by (simp add: typ_at_ep)
 
-lemma typ_at_lift_ntfn'_strong:
-  "f \<lbrace>\<lambda>s. P (typ_at' NotificationT p s)\<rbrace> \<Longrightarrow> f \<lbrace>\<lambda>s. P (ntfn_at' p s)\<rbrace>"
+lemma typ_at_lift_ntfn':
+  "\<lbrace>typ_at' NotificationT p\<rbrace> f \<lbrace>\<lambda>_. typ_at' NotificationT p\<rbrace> \<Longrightarrow> \<lbrace>ntfn_at' p\<rbrace> f \<lbrace>\<lambda>_. ntfn_at' p\<rbrace>"
   by (simp add: typ_at_ntfn)
 
-lemma typ_at_lift_cte'_strong:
-  "f \<lbrace>\<lambda>s. P (typ_at' CTET p s)\<rbrace> \<Longrightarrow> f \<lbrace>\<lambda>s. P (real_cte_at' p s)\<rbrace>"
+lemma typ_at_lift_cte':
+  "\<lbrace>typ_at' CTET p\<rbrace> f \<lbrace>\<lambda>_. typ_at' CTET p\<rbrace> \<Longrightarrow> \<lbrace>real_cte_at' p\<rbrace> f \<lbrace>\<lambda>_. real_cte_at' p\<rbrace>"
   by (simp add: typ_at_cte)
 
-lemma typ_at_lift_sc'_strong:
-  "f \<lbrace>\<lambda>s. P (typ_at' SchedContextT p s)\<rbrace> \<Longrightarrow> f \<lbrace>\<lambda>s. P (sc_at' p s)\<rbrace>"
-  by (simp add: typ_ats')
-
-lemma typ_at_lift_reply'_strong:
-  "f \<lbrace>\<lambda>s. P (typ_at' ReplyT p s)\<rbrace> \<Longrightarrow> f \<lbrace>\<lambda>s. P (reply_at' p s)\<rbrace>"
-  by (simp add: typ_ats')
-
 lemma typ_at_lift_cte_at':
-  assumes x: "\<And>P T p. f \<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace>"
-  shows      "f \<lbrace>\<lambda>s. P (cte_at' c s)\<rbrace>"
+  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
+  shows      "\<lbrace>cte_at' c\<rbrace> f \<lbrace>\<lambda>rv. cte_at' c\<rbrace>"
   apply (simp only: cte_at_typ')
-  apply (rule P_bool_lift[where P=P])
-   apply (wpsimp wp: hoare_vcg_disj_lift hoare_vcg_ex_lift hoare_vcg_all_lift x)+
+  apply (wp hoare_vcg_disj_lift hoare_vcg_ex_lift x)
   done
 
-lemma typ_at_lift_page_directory_at'_strong:
-  assumes x: "\<And>P p. f \<lbrace>\<lambda>s. P (typ_at' (ArchT PDET) p s)\<rbrace>"
-  shows      "f \<lbrace>\<lambda>s. P (page_directory_at' p s)\<rbrace>"
+lemma typ_at_lift_page_directory_at':
+  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
+  shows      "\<lbrace>page_directory_at' p\<rbrace> f \<lbrace>\<lambda>rv. page_directory_at' p\<rbrace>"
   unfolding page_directory_at'_def All_less_Ball
-  using x
-  apply -
-  apply (rule P_bool_lift[where P=P])
-  apply (wpsimp wp: hoare_vcg_const_Ball_lift hoare_vcg_bex_lift hoare_vcg_imp_lift
-         | fastforce)+
-  done
+  by (wp hoare_vcg_const_Ball_lift x)
 
-lemma typ_at_lift_page_table_at'_strong:
-  assumes x: "\<And>P p. f \<lbrace>\<lambda>s. P (typ_at' (ArchT PTET) p s)\<rbrace>"
-  shows      "f \<lbrace>\<lambda>s. P (page_table_at' p s)\<rbrace>"
+lemma typ_at_lift_page_table_at':
+  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
+  shows      "\<lbrace>page_table_at' p\<rbrace> f \<lbrace>\<lambda>rv. page_table_at' p\<rbrace>"
   unfolding page_table_at'_def All_less_Ball
-  using x
-  apply -
-  apply (rule P_bool_lift[where P=P])
-  apply (wpsimp wp: hoare_vcg_const_Ball_lift hoare_vcg_bex_lift hoare_vcg_imp_lift
-         | fastforce)+
-  done
-
-lemma typ_at_lift_valid_tcb_state'_strong:
-  assumes ep: "\<And>p. f \<lbrace>\<lambda>s. P (typ_at' EndpointT p s)\<rbrace>"
-      and reply: "\<And>p. f \<lbrace>\<lambda>s. P (typ_at' ReplyT p s)\<rbrace>"
-      and ntfn: "\<And>p. f \<lbrace>\<lambda>s. P (typ_at' NotificationT p s)\<rbrace>"
-  shows "f \<lbrace>\<lambda>s. P (valid_tcb_state' st s)\<rbrace>"
-  unfolding valid_tcb_state'_def valid_bound_reply'_def
-  apply (case_tac st
-         ; clarsimp split: option.splits
-         , wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift hoare_vcg_conj_lift_N[where N=P]
-                           typ_at_lift_ep'_strong[OF ep] typ_at_lift_reply'_strong[OF reply]
-                           typ_at_lift_ntfn'_strong[OF ntfn])
-  done
-
-lemmas typ_at_lifts_strong =
-  typ_at_lift_tcb'_strong typ_at_lift_ep'_strong
-  typ_at_lift_ntfn'_strong typ_at_lift_cte'_strong
-  typ_at_lift_reply'_strong typ_at_lift_sc'_strong
-  typ_at_lift_page_directory_at'_strong
-  typ_at_lift_valid_tcb_state'_strong
-  typ_at_lift_page_table_at'_strong
+  by (wp hoare_vcg_const_Ball_lift x)
 
 lemma ko_wp_typ_at':
   "ko_wp_at' P p s \<Longrightarrow> \<exists>T. typ_at' T p s"
   by (clarsimp simp: typ_at'_def ko_wp_at'_def)
 
 lemma koType_obj_range':
-  "koTypeOf k = koTypeOf k' \<Longrightarrow> koTypeOf k = SchedContextT \<longrightarrow> objBitsKO k = objBitsKO k' \<Longrightarrow> obj_range' p k = obj_range' p k'"
+  "koTypeOf k = koTypeOf k' \<Longrightarrow> obj_range' p k = obj_range' p k'"
   apply (rule ccontr)
   apply (simp add: obj_range'_def objBitsKO_def archObjSize_def
             split: kernel_object.splits arch_kernel_object.splits)
   done
 
-lemma typ_at_lift_valid_irq_node':
-  assumes P: "\<And>P T p. \<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
-  shows      "\<lbrace>valid_irq_node' p\<rbrace> f \<lbrace>\<lambda>_. valid_irq_node' p\<rbrace>"
-  apply (simp add: valid_irq_node'_def)
-  apply (wp hoare_vcg_all_lift P typ_at_lifts_strong)
-  done
-
-lemma valid_pde_lift':
-  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
-  shows "\<lbrace>\<lambda>s. valid_pde' pde s\<rbrace> f \<lbrace>\<lambda>rv s. valid_pde' pde s\<rbrace>"
-  by (cases pde) (simp add: valid_mapping'_def|wp x typ_at_lifts_strong[where P=id])+
-
-lemma valid_pte_lift':
-  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
-  shows "\<lbrace>\<lambda>s. valid_pte' pte s\<rbrace> f \<lbrace>\<lambda>rv s. valid_pte' pte s\<rbrace>"
-  by (cases pte) (simp add: valid_mapping'_def|wp x typ_at_lifts_strong[where P=id])+
-
-lemma valid_asid_pool_lift':
-  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
-  shows "\<lbrace>\<lambda>s. valid_asid_pool' ap s\<rbrace> f \<lbrace>\<lambda>rv s. valid_asid_pool' ap s\<rbrace>"
-  by (cases ap) (simp|wp x typ_at_lifts_strong[where P=id] hoare_vcg_const_Ball_lift)+
-
-lemma valid_dom_schedule'_lift:
-  assumes dsi: "\<And>Q. \<lbrace>\<lambda>s. Q (ksDomScheduleIdx s)\<rbrace> f \<lbrace>\<lambda>rv s. Q (ksDomScheduleIdx s)\<rbrace>"
-  assumes ds: "\<And>Q. \<lbrace>\<lambda>s. Q (ksDomSchedule s)\<rbrace> f \<lbrace>\<lambda>rv s. Q (ksDomSchedule s)\<rbrace>"
-    shows "\<lbrace>\<lambda>s. valid_dom_schedule' s\<rbrace> f \<lbrace>\<lambda>rv. valid_dom_schedule'\<rbrace>"
-   unfolding valid_dom_schedule'_def
-   by (wpsimp wp: dsi ds)
-
-lemma valid_bound_tcb_lift:
-  "(\<And>T p. f \<lbrace>typ_at' T p\<rbrace>) \<Longrightarrow> f \<lbrace>valid_bound_tcb' tcb\<rbrace>"
-  by (auto simp: valid_bound_tcb'_def valid_def typ_ats'[symmetric] split: option.splits)
-
-lemma valid_bound_sc_lift:
-  "(\<And>T p. f \<lbrace>typ_at' T p\<rbrace>) \<Longrightarrow> f \<lbrace>valid_bound_sc' tcb\<rbrace>"
-  by (auto simp: valid_bound_obj'_def valid_def typ_ats'[symmetric] split: option.splits)
-
-lemma valid_bound_reply_lift:
-  "(\<And>T p. f \<lbrace>typ_at' T p\<rbrace>) \<Longrightarrow> f \<lbrace>valid_bound_reply' tcb\<rbrace>"
-  by (auto simp: valid_bound_tcb'_def valid_def typ_ats'[symmetric] split: option.splits)
-
-lemma valid_bound_ntfn_lift:
-  "(\<And>T p. f \<lbrace>typ_at' T p\<rbrace>) \<Longrightarrow> f \<lbrace>valid_bound_ntfn' ntfn\<rbrace>"
-  by (auto simp: valid_bound_obj'_def valid_def typ_ats'[symmetric] split: option.splits)
-
-lemma valid_ntfn_lift':
-  "(\<And>T p. f \<lbrace>typ_at' T p\<rbrace>) \<Longrightarrow> f \<lbrace>valid_ntfn' ntfn\<rbrace>"
-  unfolding valid_ntfn'_def
-  apply (cases "ntfnObj ntfn"; clarsimp)
-    apply (wpsimp wp: valid_bound_tcb_lift valid_bound_sc_lift)
-   apply (wpsimp wp: valid_bound_tcb_lift valid_bound_sc_lift)
-  apply (wpsimp wp: hoare_vcg_ball_lift typ_at_lift_tcb'_strong[where P=id, simplified])
-   apply (wpsimp wp: valid_bound_tcb_lift valid_bound_sc_lift)
-  apply simp
-  done
-
-lemma valid_sc_lift':
-  "(\<And>T p. f \<lbrace>typ_at' T p\<rbrace>) \<Longrightarrow> f \<lbrace>valid_sched_context' sc\<rbrace>"
-  unfolding valid_sched_context'_def
-  by (wpsimp wp: valid_bound_ntfn_lift valid_bound_tcb_lift valid_bound_reply_lift)
-
-context begin
-\<comment>\<open>
-  We're using @{command ML_goal} here because there are two useful formulations
-  of typ_at lifting lemmas and we do not want to write all of the possibilities
-  out by hand. If we use typ_at_lift_tcb' as an example, then the first is
-  @{term "\<lbrace>\<lambda>s. P (typ_at' TCBT p s)\<rbrace> f \<lbrace>\<lambda>_ s. P (typ_at' TCBT p s)\<rbrace>
-          \<Longrightarrow> \<lbrace>\<lambda>s. P (tcb_at' p s)\<rbrace> f \<lbrace>\<lambda>_ s. P (tcb_at' p s)\<rbrace>"} and the second is
-  @{term "(\<And>P. \<lbrace>\<lambda>s. P (typ_at' TCBT p s)\<rbrace> f \<lbrace>\<lambda>_ s. P (typ_at' TCBT p s)\<rbrace>)
-          \<Longrightarrow> \<lbrace>\<lambda>s. P (tcb_at' p s)\<rbrace> f \<lbrace>\<lambda>_ s. P (tcb_at' p s)\<rbrace>"}.
-  The first form is stronger, and therefore preferred for backward reasoning
-  using rule. However, since the P in the premise is free in the first form,
-  forward unification using the OF attribute produces flex-flex pairs which
-  causes problems. The second form avoids the unification issue by demanding
-  that there is a P that is free in the lemma supplied to the OF attribute.
-  However, it can only be applied if @{term f} preserves both
-  @{term "typ_at' TCBT p s"} and @{term "\<not> typ_at' TCBT p s"}.
-  The following @{command ML_goal} generates lemmas of the second form based on
-  the previously proven stronger lemmas of the first form.
-\<close>
-ML \<open>
-local
-  val strong_thms = @{thms typ_at_lifts_strong[no_vars]};
-  fun abstract_P term = Logic.all (Free ("P", @{typ "bool \<Rightarrow> bool"})) term
-  fun abstract thm =
-    let
-      val prems = List.map abstract_P (Thm.prems_of thm);
-      fun imp [] = Thm.concl_of thm
-        | imp (p :: pms) = @{const Pure.imp} $ p $ imp pms
-    in
-      imp prems
-    end
-in
-  val typ_at_lifts_internal_goals = List.map abstract strong_thms
-end
-\<close>
-
-private ML_goal typ_at_lifts_internal:
-  \<open>typ_at_lifts_internal_goals\<close>
-  by (auto simp: typ_at_lifts_strong)
-
-lemmas typ_at_lifts = typ_at_lifts_internal
-                      typ_at_lift_cte_at'
-                      valid_pde_lift'
-                      valid_pte_lift'
-                      valid_asid_pool_lift'
-                      valid_bound_tcb_lift
-                      valid_bound_reply_lift
-                      valid_bound_sc_lift
-                      valid_bound_ntfn_lift
-                      valid_ntfn_lift'
-                      valid_sc_lift'
-end
-
 lemma typ_at_lift_valid_untyped':
   assumes P: "\<And>T p. \<lbrace>\<lambda>s. \<not>typ_at' T p s\<rbrace> f \<lbrace>\<lambda>rv s. \<not>typ_at' T p s\<rbrace>"
-  assumes sz: "\<And>p n. \<lbrace>\<lambda>s. sc_at'_n n p s\<rbrace> f \<lbrace>\<lambda>rv s. sc_at'_n n p s\<rbrace>"
   shows "\<lbrace>\<lambda>s. valid_untyped' d p n idx s\<rbrace> f \<lbrace>\<lambda>rv s. valid_untyped' d p n idx s\<rbrace>"
   apply (clarsimp simp: valid_untyped'_def split del:if_split)
   apply (rule hoare_vcg_all_lift)
@@ -2953,112 +2447,81 @@ lemma typ_at_lift_valid_untyped':
   apply (clarsimp simp: typ_at'_def ko_wp_at'_def simp del:atLeastAtMost_iff)
   apply (elim disjE)
     apply (clarsimp simp:psubset_eq simp del:atLeastAtMost_iff)
-   apply (frule_tac p=ptr' in koType_obj_range', clarsimp)
-    apply (fastforce simp: ko_wp_at'_def dest!: use_valid [OF _ sz])
+    apply (drule_tac p=ptr' in koType_obj_range')
+    apply (erule impE)
+    apply simp
    apply simp
-  apply (frule_tac p = ptr' in koType_obj_range', clarsimp)
-   apply (fastforce simp: ko_wp_at'_def dest!: use_valid [OF _ sz])
-  apply simp
+  apply (drule_tac p = ptr' in koType_obj_range')
+  apply (clarsimp split:if_splits)
   done
 
+lemma typ_at_lift_asid_at':
+  "(\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>_. typ_at' T p\<rbrace>) \<Longrightarrow> \<lbrace>asid_pool_at' p\<rbrace> f \<lbrace>\<lambda>_. asid_pool_at' p\<rbrace>"
+  by assumption
+
 lemma typ_at_lift_valid_cap':
   assumes P: "\<And>P T p. \<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
-  assumes sz: "\<And>p n. \<lbrace>\<lambda>s. sc_at'_n n p s\<rbrace> f \<lbrace>\<lambda>rv s. sc_at'_n n p s\<rbrace>"
   shows      "\<lbrace>\<lambda>s. valid_cap' cap s\<rbrace> f \<lbrace>\<lambda>rv s. valid_cap' cap s\<rbrace>"
   including no_pre
   apply (simp add: valid_cap'_def)
   apply wp
   apply (case_tac cap;
-         wpsimp wp: valid_cap'_def P typ_at_lifts_strong
-                    hoare_vcg_prop  typ_at_lift_cte_at'
-                    hoare_vcg_conj_lift [OF typ_at_lift_cte_at']
-                    hoare_vcg_conj_lift)
+         simp add: valid_cap'_def P [where P=id, simplified] typ_at_lift_tcb'
+                   hoare_vcg_prop typ_at_lift_ep'
+                   typ_at_lift_ntfn' typ_at_lift_cte_at'
+                   hoare_vcg_conj_lift [OF typ_at_lift_cte_at'])
      apply (rename_tac zombie_type nat)
      apply (case_tac zombie_type; simp)
-      apply (wp typ_at_lifts_strong[where P=id, simplified] P
-                hoare_vcg_all_lift)+
+      apply (wp typ_at_lift_tcb' P hoare_vcg_all_lift typ_at_lift_cte')+
     apply (rename_tac arch_capability)
     apply (case_tac arch_capability,
            simp_all add: P [where P=id, simplified] page_table_at'_def
                          hoare_vcg_prop page_directory_at'_def All_less_Ball
               split del: if_split)
-       apply (wp hoare_vcg_const_Ball_lift P typ_at_lift_valid_untyped' sz
-                 hoare_vcg_all_lift typ_at_lifts_strong)+
+       apply (wp hoare_vcg_const_Ball_lift P typ_at_lift_valid_untyped'
+                 hoare_vcg_all_lift typ_at_lift_cte')+
   done
 
-lemma typ_at'_valid_obj'_lift:
-  assumes P: "\<And>P T p. \<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
-  assumes sz: "\<And>n p. \<lbrace>\<lambda>s. sc_at'_n n p s\<rbrace> f \<lbrace>\<lambda>rv s. sc_at'_n n p s\<rbrace>"
-  notes [wp] = hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_const_Ball_lift
-               typ_at_lifts[OF P] typ_at_lift_valid_cap'[OF P]
-  shows      "\<lbrace>\<lambda>s. valid_obj' obj s\<rbrace> f \<lbrace>\<lambda>rv s. valid_obj' obj s\<rbrace>"
-  apply (cases obj; simp add: valid_obj'_def hoare_TrueI)
-        apply (rename_tac endpoint)
-        apply (case_tac endpoint; simp add: valid_ep'_def, wp)
-       apply (rename_tac notification)
-       apply (case_tac "ntfnObj notification";
-               simp add: valid_ntfn'_def split: option.splits;
-               (wpsimp|rule conjI)+)
-      apply (rename_tac tcb)
-      apply (case_tac "tcbState tcb";
-             simp add: valid_tcb'_def valid_tcb_state'_def split_def;
-             wpsimp wp: sz)
-     apply (wpsimp simp: valid_cte'_def sz)
-    apply (rename_tac arch_kernel_object)
-    apply (case_tac arch_kernel_object; wpsimp wp: sz)
-   apply wpsimp
-  apply (wpsimp simp: valid_reply'_def)
-  done
 
-lemma typ_at'_valid_sched_context'_lift:
+lemma typ_at_lift_valid_irq_node':
   assumes P: "\<And>P T p. \<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
-  assumes sz: "\<And>n p. \<lbrace>\<lambda>s. sc_at'_n n p s\<rbrace> f \<lbrace>\<lambda>rv s. sc_at'_n n p s\<rbrace>"
-  notes [wp] = hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_const_Ball_lift
-               typ_at_lifts[OF P] typ_at_lift_valid_cap'[OF P]
-  shows      "\<lbrace>\<lambda>s. valid_sched_context' ko s\<rbrace> f \<lbrace>\<lambda>rv s. valid_sched_context' ko s\<rbrace>"
-  by (wpsimp simp: valid_sched_context'_def)
-
-lemmas typ_at_sc_at'_n_lifts =
-  typ_at_lift_valid_untyped' typ_at_lift_valid_cap' typ_at'_valid_obj'_lift
-  typ_at'_valid_obj'_lift[where obj="KOEndpoint ko" for ko, simplified valid_obj'_def kernel_object.case]
-  typ_at'_valid_obj'_lift[where obj="KONotification ko" for ko, simplified valid_obj'_def kernel_object.case]
-  typ_at'_valid_obj'_lift[where obj="KOTCB ko" for ko, simplified valid_obj'_def kernel_object.case]
-  typ_at'_valid_obj'_lift[where obj="KOCTE ko" for ko, simplified valid_obj'_def kernel_object.case]
-  typ_at'_valid_obj'_lift[where obj="KOArch ko" for ko, simplified valid_obj'_def kernel_object.case]
-  typ_at'_valid_obj'_lift[where obj="KOReply ko" for ko, simplified valid_obj'_def kernel_object.case]
-  typ_at'_valid_sched_context'_lift
-
-lemmas typ_at_lifts_all = typ_at_lifts typ_at_sc_at'_n_lifts
-
-end
-
-locale typ_at_props' =
-  fixes f :: "'a kernel"
-  assumes typ': "f \<lbrace>\<lambda>s. P (typ_at' T p' s)\<rbrace>"
-begin
-
-lemmas typ_at_lifts'[wp] = typ_at_lifts[REPEAT [OF typ']]
-
-end
+  shows      "\<lbrace>valid_irq_node' p\<rbrace> f \<lbrace>\<lambda>_. valid_irq_node' p\<rbrace>"
+  apply (simp add: valid_irq_node'_def)
+  apply (wp hoare_vcg_all_lift P typ_at_lift_cte')
+  done
 
-locale typ_at_all_props' = typ_at_props' +
-  assumes scs: "f \<lbrace>\<lambda>s. Q (sc_at'_n n p s)\<rbrace>"
-begin
+lemma valid_pde_lift':
+  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
+  shows "\<lbrace>\<lambda>s. valid_pde' pde s\<rbrace> f \<lbrace>\<lambda>rv s. valid_pde' pde s\<rbrace>"
+  by (cases pde) (simp add: valid_mapping'_def|wp x typ_at_lift_page_table_at')+
 
-lemmas typ_at_sc_at'_n_lifts'[wp] = typ_at_sc_at'_n_lifts[OF typ' scs]
-lemmas typ_at_lifts_all' = typ_at_lifts' typ_at_sc_at'_n_lifts'
+lemma valid_pte_lift':
+  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
+  shows "\<lbrace>\<lambda>s. valid_pte' pte s\<rbrace> f \<lbrace>\<lambda>rv s. valid_pte' pte s\<rbrace>"
+  by (cases pte) (simp add: valid_mapping'_def|wp x typ_at_lift_page_directory_at')+
 
-context begin
-(* We want to enforce that typ_at_lifts_all' only contains lemmas that have no
-   assumptions. The following thm statements should fail if this is not true. *)
-private lemmas check_valid_internal = iffD1[OF refl, where P="valid p g q" for p g q]
-thm typ_at_lifts_all'[atomized, THEN check_valid_internal]
-end
+lemma valid_asid_pool_lift':
+  assumes x: "\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' T p\<rbrace>"
+  shows "\<lbrace>\<lambda>s. valid_asid_pool' ap s\<rbrace> f \<lbrace>\<lambda>rv s. valid_asid_pool' ap s\<rbrace>"
+  by (cases ap) (simp|wp x typ_at_lift_page_directory_at' hoare_vcg_const_Ball_lift)+
 
-end
+lemma valid_bound_tcb_lift:
+  "(\<And>T p. \<lbrace>typ_at' T p\<rbrace> f \<lbrace>\<lambda>_. typ_at' T p\<rbrace>) \<Longrightarrow>
+  \<lbrace>valid_bound_tcb' tcb\<rbrace> f \<lbrace>\<lambda>_. valid_bound_tcb' tcb\<rbrace>"
+  by (auto simp: valid_bound_tcb'_def valid_def typ_at_tcb'[symmetric] split: option.splits)
 
-(* we expect typ_at' and sc_at'_n lemmas to be [wp], so this should be easy: *)
-method typ_at_props' = unfold_locales; wp?
+lemmas typ_at_lifts = typ_at_lift_tcb' typ_at_lift_ep'
+                      typ_at_lift_ntfn' typ_at_lift_cte'
+                      typ_at_lift_cte_at'
+                      typ_at_lift_page_table_at'
+                      typ_at_lift_page_directory_at'
+                      typ_at_lift_asid_at'
+                      typ_at_lift_valid_untyped'
+                      typ_at_lift_valid_cap'
+                      valid_pde_lift'
+                      valid_pte_lift'
+                      valid_asid_pool_lift'
+                      valid_bound_tcb_lift
 
 lemma mdb_next_unfold:
   "s \<turnstile> c \<leadsto> c' = (\<exists>z. s c = Some z \<and> c' = mdbNext (cteMDBNode z))"
@@ -3211,7 +2674,8 @@ lemma valid_mdb_ctesE [elim]:
     \<lbrakk> valid_dlist m; no_0 m; mdb_chain_0 m; valid_badges m;
       caps_contained' m; mdb_chunked m; untyped_mdb' m;
       untyped_inc' m; valid_nullcaps m; ut_revocable' m;
-      class_links m; distinct_zombies m; irq_control m \<rbrakk>
+      class_links m; distinct_zombies m; irq_control m;
+      reply_masters_rvk_fb m \<rbrakk>
           \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   unfolding valid_mdb_ctes_def by auto
 
@@ -3219,10 +2683,12 @@ lemma valid_mdb_ctesI [intro]:
   "\<lbrakk>valid_dlist m; no_0 m; mdb_chain_0 m; valid_badges m;
     caps_contained' m; mdb_chunked m; untyped_mdb' m;
     untyped_inc' m; valid_nullcaps m; ut_revocable' m;
-    class_links m; distinct_zombies m; irq_control m \<rbrakk>
+    class_links m; distinct_zombies m; irq_control m;
+    reply_masters_rvk_fb m \<rbrakk>
   \<Longrightarrow> valid_mdb_ctes m"
   unfolding valid_mdb_ctes_def by auto
 
+end
 locale PSpace_update_eq =
   fixes f :: "kernel_state \<Rightarrow> kernel_state"
   assumes pspace: "ksPSpace (f s) = ksPSpace s"
@@ -3262,18 +2728,6 @@ lemma valid_objs_update [iff]:
   apply (fastforce intro: valid_obj'_pspaceI simp: pspace)
   done
 
-lemma valid_objs_size_update [iff]:
-  "valid_objs_size' (f s) = valid_objs_size' s"
-  apply (simp add: valid_objs_size'_def pspace)
-  apply (fastforce intro: valid_obj_size'_pspaceI simp: pspace)
-  done
-
-lemma valid_replies'_update [iff]:
-  "valid_replies' (f s) = valid_replies' s"
-  apply (simp add: valid_replies'_def pspace)
-  apply (auto simp: pspace pred_tcb_at'_def)
-  done
-
 lemma pspace_aligned_update [iff]:
   "pspace_aligned' (f s) = pspace_aligned' s"
   by (simp add: pspace pspace_aligned'_def)
@@ -3282,14 +2736,6 @@ lemma pspace_distinct_update [iff]:
   "pspace_distinct' (f s) = pspace_distinct' s"
   by (simp add: pspace pspace_distinct'_def ps_clear_def)
 
-lemma pspace_bounded_update [iff]:
-  "pspace_bounded' (f s) = pspace_bounded' s"
-  by (simp add: pspace pspace_bounded'_def)
-
-lemma pspace_no_overlap'_update [iff]:
-  "pspace_no_overlap' p sz (f s) = pspace_no_overlap' p sz s"
-  by (simp add: pspace pspace_no_overlap'_def ps_clear_def)
-
 lemma pred_tcb_at_update [iff]:
   "pred_tcb_at' proj P p (f s) = pred_tcb_at' proj P p s"
   by (simp add: pred_tcb_at'_def)
@@ -3438,26 +2884,6 @@ interpretation ready_queue_bitmap2_update:
   P_Arch_Idle_Int_Cur_update_eq "ksReadyQueuesL2Bitmap_update f"
   by unfold_locales auto
 
-interpretation reprogramTime_update:
-  P_Arch_Idle_Int_Cur_update_eq "ksReprogramTimer_update f"
-  by unfold_locales auto
-
-interpretation ksReleaseQueue_update:
-  P_Arch_Idle_Int_Cur_update_eq "ksReleaseQueue_update f"
-  by unfold_locales auto
-
-interpretation ksConsumedTime_update:
-  P_Arch_Idle_Int_Cur_update_eq "ksConsumedTime_update f"
-  by unfold_locales auto
-
-interpretation ksCurTime_update:
-  P_Arch_Idle_Int_Cur_update_eq "ksCurTime_update f"
-  by unfold_locales auto
-
-interpretation ksCurSc_update:
-  P_Arch_Idle_Int_Cur_update_eq "ksCurSc_update f"
-  by unfold_locales auto
-
 interpretation cur_thread_update':
   P_Arch_Idle_Int_update_eq "ksCurThread_update f"
   by unfold_locales auto
@@ -3515,11 +2941,6 @@ lemma ko_wp_at_norm:
   "ko_wp_at' P p s \<Longrightarrow> \<exists>ko. P ko \<and> ko_wp_at' ((=) ko) p s"
   by (auto simp add: ko_wp_at'_def)
 
-lemma ko_at_ko_wp_atD':
-  "\<lbrakk>ko_at' ko p s; ko_wp_at' P p s\<rbrakk> \<Longrightarrow> P (injectKO ko)"
-  apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKO_eq project_inject)
-  done
-
 lemma valid_mdb_machine_state [iff]:
   "valid_mdb' (ksMachineState_update f s) = valid_mdb' s"
   by (simp add: valid_mdb'_def)
@@ -3532,10 +2953,6 @@ lemma pred_tcb_at' [elim!]:
   "pred_tcb_at' proj P t s \<Longrightarrow> tcb_at' t s"
   by (auto simp add: pred_tcb_at'_def obj_at'_def)
 
-lemma pred_tcb_at'_True[simp]:
-  "pred_tcb_at' proj \<top> p s = tcb_at' p s"
-  by (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-
 lemma valid_pspace_mdb' [elim!]:
   "valid_pspace' s \<Longrightarrow> valid_mdb' s"
   by (simp add: valid_pspace'_def)
@@ -3553,8 +2970,7 @@ lemma ex_cte_cap_to'_pres:
    apply assumption
   apply simp
   done
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma page_directory_pde_atI':
   "\<lbrakk> page_directory_at' p s; x < 2 ^ pageBits \<rbrakk> \<Longrightarrow> pde_at' (p + (x << 2)) s"
   by (simp add: page_directory_at'_def pageBits_def)
@@ -3639,14 +3055,6 @@ lemma valid_bitmaps_arch[simp]:
   "valid_bitmaps (ksArchState_update f s) = valid_bitmaps s"
   by (simp add: valid_bitmaps_def bitmapQ_defs)
 
-lemma valid_release_queue_arch [simp]:
-  "valid_release_queue (ksArchState_update f s) = valid_release_queue s"
-  by (simp add: valid_release_queue_def)
-
-lemma valid_release_queue'_arch [simp]:
-  "valid_release_queue' (ksArchState_update f s) = valid_release_queue' s"
-  by (simp add: valid_release_queue'_def)
-
 lemma if_unsafe_then_cap_arch' [simp]:
   "if_unsafe_then_cap' (ksArchState_update f s) = if_unsafe_then_cap' s"
   by (simp add: if_unsafe_then_cap'_def ex_cte_cap_to'_def)
@@ -3700,14 +3108,6 @@ lemma valid_pspace_valid_objs'[elim!]:
   "valid_pspace' s \<Longrightarrow> valid_objs' s"
   by (simp add: valid_pspace'_def)
 
-lemma valid_pspace_valid_replies'[elim!]:
-  "valid_pspace' s \<Longrightarrow> valid_replies' s"
-  by (simp add: valid_pspace'_def)
-
-lemma valid_pspace_valid_objs_size'[elim!]:
-  "valid_pspace' s \<Longrightarrow> valid_objs_size' s"
-  by (simp add: valid_pspace'_def valid_objs'_valid_objs_size')
-
 declare badgeBits_def [simp]
 
 lemma simple_sane_strg:
@@ -3729,14 +3129,12 @@ lemma vms_sch_act_update'[iff]:
   "valid_machine_state' (ksSchedulerAction_update f s) =
    valid_machine_state' s"
   by (simp add: valid_machine_state'_def )
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma objBitsT_simps:
   "objBitsT EndpointT = epSizeBits"
   "objBitsT NotificationT = ntfnSizeBits"
   "objBitsT CTET = cteSizeBits"
   "objBitsT TCBT = tcbBlockSizeBits"
-  "objBitsT ReplyT = replySizeBits"
   "objBitsT UserDataT = pageBits"
   "objBitsT UserDataDeviceT = pageBits"
   "objBitsT KernelDataT = pageBits"
@@ -3791,29 +3189,6 @@ lemma not_pred_tcb_at'_strengthen:
   "pred_tcb_at' f (Not \<circ> P) p s \<Longrightarrow> \<not> pred_tcb_at' f P p s"
   by (clarsimp simp: pred_tcb_at'_def obj_at'_def)
 
-lemma obj_at'_imp:
-  fixes P Q :: "'a :: pspace_storable \<Rightarrow> bool"
-  shows
-  "(obj_at' (\<lambda>rv. P rv \<longrightarrow> Q rv) p s) =
-    (obj_at' (\<lambda>_ :: 'a. True) p s \<and> (obj_at' P p s \<longrightarrow> obj_at' Q p s))"
-  apply (rule iffI; clarsimp simp: obj_at'_def)
-  done
-
-lemma pred_tcb_at'_imp:
-  "pred_tcb_at' field (\<lambda>rv. P rv \<longrightarrow> Q rv) p s =
-    (tcb_at' p s \<and> (pred_tcb_at' field P p s \<longrightarrow> pred_tcb_at' field Q p s))"
-  apply (rule iffI; clarsimp simp: obj_at'_def pred_tcb_at'_def)
-  done
-
-lemma valid_queues_no_bitmap_def':
-  "valid_queues_no_bitmap =
-     (\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s) \<and>
-                (d > maxDomain \<or> p > maxPriority \<longrightarrow> ksReadyQueues s (d,p) = []))"
-  apply (rule ext, rule iffI)
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_and pred_tcb_at'_def o_def
-                  elim!: obj_at'_weakenE)+
-  done
-
 lemma valid_refs'_cteCaps:
   "valid_refs' S (ctes_of s) = (\<forall>c \<in> ran (cteCaps_of s). S \<inter> capRange c = {})"
   by (fastforce simp: valid_refs'_def cteCaps_of_def elim!: ranE)
@@ -3832,41 +3207,41 @@ lemma cte_at_valid_cap_sizes_0:
   apply simp
   done
 
+lemma invs_valid_stateI' [elim!]:
+  "invs' s \<Longrightarrow> valid_state' s"
+  by (simp add: invs'_def)
+
+lemma tcb_at_invs' [elim!]:
+  "invs' s \<Longrightarrow> tcb_at' (ksCurThread s) s"
+  by (simp add: invs'_def cur_tcb'_def)
+
 lemma invs_valid_objs' [elim!]:
   "invs' s \<Longrightarrow> valid_objs' s"
-  by (simp add: invs'_def valid_pspace'_def)
-
-lemma invs_valid_objs_size' [elim!]:
-  "invs' s \<Longrightarrow> valid_objs_size' s"
-  by (fastforce simp: invs'_def)
+  by (simp add: invs'_def valid_state'_def valid_pspace'_def)
 
 lemma invs_pspace_aligned' [elim!]:
   "invs' s \<Longrightarrow> pspace_aligned' s"
-  by (simp add: invs'_def valid_pspace'_def)
+  by (simp add: invs'_def valid_state'_def valid_pspace'_def)
 
 lemma invs_pspace_distinct' [elim!]:
   "invs' s \<Longrightarrow> pspace_distinct' s"
-  by (simp add: invs'_def valid_pspace'_def)
-
-lemma invs_pspace_bounded' [elim!]:
-  "invs' s \<Longrightarrow> pspace_bounded' s"
-  by (simp add: invs'_def valid_pspace'_def)
+  by (simp add: invs'_def valid_state'_def valid_pspace'_def)
 
 lemma invs_valid_pspace' [elim!]:
   "invs' s \<Longrightarrow> valid_pspace' s"
-  by (simp add: invs'_def)
+  by (simp add: invs'_def valid_state'_def)
 
 lemma invs_arch_state' [elim!]:
   "invs' s \<Longrightarrow> valid_arch_state' s"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_cur' [elim!]:
+  "invs' s \<Longrightarrow> cur_tcb' s"
   by (simp add: invs'_def)
 
 lemma invs_mdb' [elim!]:
   "invs' s \<Longrightarrow> valid_mdb' s"
-  by (simp add: invs'_def valid_pspace'_def)
-
-lemma invs_valid_replies'[elim!]:
-  "invs' s \<Longrightarrow> valid_replies' s"
-  by (simp add: invs'_def valid_pspace'_def)
+  by (simp add: invs'_def valid_state'_def valid_pspace'_def)
 
 lemma valid_mdb_no_loops [elim!]:
   "valid_mdb_ctes m \<Longrightarrow> no_loops m"
@@ -3875,16 +3250,24 @@ lemma valid_mdb_no_loops [elim!]:
 lemma invs_no_loops [elim!]:
   "invs' s \<Longrightarrow> no_loops (ctes_of s)"
   apply (rule valid_mdb_no_loops)
-  apply (simp add: invs'_def valid_pspace'_def valid_mdb'_def)
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def valid_mdb'_def)
   done
 
 lemma invs_iflive'[elim!]:
   "invs' s \<Longrightarrow> if_live_then_nonz_cap' s"
-  by (simp add: invs'_def)
+  by (simp add: invs'_def valid_state'_def)
 
 lemma invs_unsafe_then_cap' [elim!]:
   "invs' s \<Longrightarrow> if_unsafe_then_cap' s"
-  by (simp add: invs'_def)
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_sym' [elim!]:
+  "invs' s \<Longrightarrow> sym_refs (state_refs_of' s)"
+  by (simp add: invs'_def valid_state'_def)
+
+lemma invs_sch_act_wf' [elim!]:
+  "invs' s \<Longrightarrow> sch_act_wf (ksSchedulerAction s) s"
+  by (simp add: invs'_def valid_state'_def)
 
 lemma invs_valid_bitmaps[elim!]:
   "invs' s \<Longrightarrow> valid_bitmaps s"
@@ -3898,25 +3281,17 @@ lemma invs_valid_sched_pointers[elim!]:
   "invs' s \<Longrightarrow> valid_sched_pointers s"
   by (simp add: invs'_def valid_state'_def)
 
-lemma invs_queues'[elim!]:
-  "invs' s \<Longrightarrow> valid_queues' s"
-  by (simp add: invs'_def)
-
-lemma invs_valid_release_queue [elim!]:
-  "invs' s \<Longrightarrow> valid_release_queue s"
-  by (simp add: invs'_def)
-
-lemma invs_valid_release_queue' [elim!]:
-  "invs' s \<Longrightarrow> valid_release_queue' s"
-  by (simp add: invs'_def)
-
-lemma invs_sym_list_refs_of_replies'[elim!]:
-  "invs' s \<Longrightarrow> sym_refs (list_refs_of_replies' s)"
-  by (simp add: invs'_def)
+lemma invs_valid_idle'[elim!]:
+  "invs' s \<Longrightarrow> valid_idle' s"
+  by (fastforce simp: invs'_def valid_state'_def)
 
 lemma invs_valid_global'[elim!]:
   "invs' s \<Longrightarrow> valid_global_refs' s"
-  by (fastforce simp: invs'_def)
+  by (fastforce simp: invs'_def valid_state'_def)
+
+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 invs'_bitmapQ_no_L1_orphans:
   "invs' s \<Longrightarrow> bitmapQ_no_L1_orphans s"
@@ -3924,7 +3299,12 @@ lemma invs'_bitmapQ_no_L1_orphans:
 
 lemma invs_ksCurDomain_maxDomain' [elim!]:
   "invs' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
-  by (simp add: invs'_def)
+  by (simp add: invs'_def valid_state'_def)
+
+lemma simple_st_tcb_at_state_refs_ofD':
+  "st_tcb_at' simple' t s \<Longrightarrow> bound_tcb_at' (\<lambda>x. tcb_bound_refs' x = state_refs_of' s t) t s"
+  by (fastforce simp: pred_tcb_at'_def obj_at'_def state_refs_of'_def
+                      projectKO_eq project_inject)
 
 lemma cur_tcb_arch' [iff]:
   "cur_tcb' (ksArchState_update f s) = cur_tcb' s"
@@ -3936,24 +3316,26 @@ lemma cur_tcb'_machine_state [simp]:
 
 lemma invs_no_0_obj'[elim!]:
   "invs' s \<Longrightarrow> no_0_obj' s"
-  by (simp add: invs'_def valid_pspace'_def)
+  by (simp add: invs'_def valid_state'_def valid_pspace'_def)
 
 lemma invs'_gsCNodes_update[simp]:
   "invs' (gsCNodes_update f s') = invs' s'"
-  apply (clarsimp simp: invs'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs
-             valid_queues'_def valid_release_queue_def valid_release_queue'_def valid_irq_node'_def
-             valid_irq_handlers'_def irq_issued'_def irqs_masked'_def valid_machine_state'_def
-             valid_dom_schedule'_def
-             cur_tcb'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_bitmaps_def bitmapQ_defs
+                        valid_irq_node'_def valid_irq_handlers'_def irq_issued'_def irqs_masked'_def
+                        valid_machine_state'_def cur_tcb'_def)
+  apply (cases "ksSchedulerAction s'";
+         simp add: ct_in_state'_def tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def
+                   ct_not_inQ_def)
   done
 
 lemma invs'_gsUserPages_update[simp]:
   "invs' (gsUserPages_update f s') = invs' s'"
-  apply (clarsimp simp: invs'_def valid_queues_def valid_queues_no_bitmap_def
-             bitmapQ_defs valid_queues'_def valid_release_queue_def valid_release_queue'_def
-             valid_irq_node'_def valid_irq_handlers'_def irq_issued'_def irqs_masked'_def
-             valid_machine_state'_def cur_tcb'_def valid_dom_schedule'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_bitmaps_def bitmapQ_defs
+                        valid_irq_node'_def valid_irq_handlers'_def irq_issued'_def irqs_masked'_def
+                        valid_machine_state'_def cur_tcb'_def)
+  apply (cases "ksSchedulerAction s'";
+         simp add: ct_in_state'_def tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def
+                   ct_not_inQ_def)
   done
 
 lemma pred_tcb'_neq_contra:
@@ -3962,31 +3344,11 @@ lemma pred_tcb'_neq_contra:
 
 lemma invs'_ksDomSchedule:
   "invs' s \<Longrightarrow> KernelStateData_H.ksDomSchedule s = KernelStateData_H.ksDomSchedule (newKernelState undefined)"
-unfolding invs'_def valid_dom_schedule'_def by clarsimp
+unfolding invs'_def valid_state'_def by clarsimp
 
 lemma invs'_ksDomScheduleIdx:
   "invs' s \<Longrightarrow> KernelStateData_H.ksDomScheduleIdx s < length (KernelStateData_H.ksDomSchedule (newKernelState undefined))"
-unfolding invs'_def valid_dom_schedule'_def by clarsimp
-
-lemmas invs'_implies =
-  invs_iflive'
-  invs_unsafe_then_cap'
-  invs_no_0_obj'
-  invs_pspace_aligned'
-  invs_pspace_distinct'
-  invs_pspace_bounded'
-  invs_arch_state'
-  invs_valid_global'
-  invs_mdb'
-  invs_valid_objs'
-  invs_valid_objs_size'
-  invs_valid_pspace'
-  invs_queues
-  invs_queues'
-  invs_valid_release_queue
-  invs_valid_release_queue'
-  invs_sym_list_refs_of_replies'
-  invs_valid_replies'
+unfolding invs'_def valid_state'_def by clarsimp
 
 lemma valid_bitmap_valid_bitmapQ_exceptE:
   "\<lbrakk> valid_bitmapQ_except d p s; bitmapQ d p s \<longleftrightarrow> \<not> tcbQueueEmpty (ksReadyQueues s (d,p));
@@ -4055,87 +3417,14 @@ private lemma ko_at_defn_ko_wp_at':
   by (clarsimp simp: ko_at'_defn_def obj_at'_real_def
                      ko_wp_at'_def project_inject)
 
-(* FIXME: normalise_obj_at' sometimes doesn't normalise obj_at' unless you use it twice.
-          See VER-1364 for more details. *)
-private method normalise_obj_at'_step =
+method normalise_obj_at' =
   (clarsimp?, elim obj_at_ko_at'[folded ko_at'_defn_def, elim_format],
    clarsimp simp: ko_at_defn_rewr ko_at_defn_pred_tcb_at' ko_at_defn_ko_wp_at',
    ((drule(1) ko_at_defn_uniqueD)+)?,
    clarsimp simp: ko_at'_defn_def)
 
-method normalise_obj_at' =
-  normalise_obj_at'_step, normalise_obj_at'_step?
-
 end
 
-lemma valid_replies'D:
-  "valid_replies' s \<Longrightarrow> is_reply_linked rptr s
-   \<Longrightarrow> \<exists>tptr. replyTCBs_of s rptr = Some tptr
-              \<and> st_tcb_at' ((=) (BlockedOnReply (Some rptr))) tptr s"
-  apply (clarsimp simp: valid_replies'_def)
-  apply (drule_tac x=rptr in spec)
-  apply fastforce
-  done
-
-lemma valid_replies'_no_tcb:
-  "\<lbrakk>replyTCBs_of s rptr = None; valid_replies' s\<rbrakk>
-   \<Longrightarrow> \<not> is_reply_linked rptr s"
-  by (force simp: valid_replies'_def opt_map_def)
-
-lemma valid_replies'_other_state:
-  "\<lbrakk>replyTCBs_of s rptr = Some tptr;
-    st_tcb_at' P tptr s; \<not> P (BlockedOnReply (Some rptr));
-    valid_replies' s\<rbrakk>
-   \<Longrightarrow> \<not> is_reply_linked rptr s"
-  apply (clarsimp simp: valid_replies'_def)
-  apply (drule_tac x=rptr in spec)
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def)+
-  done
-
-lemma valid_replies'_sc_asrtD:
-  "valid_replies'_sc_asrt rptr s \<Longrightarrow> replySCs_of s rptr \<noteq> None
-   \<Longrightarrow> (\<exists>tptr. replyTCBs_of s rptr = Some tptr
-               \<and> st_tcb_at' ((=) (BlockedOnReply (Some rptr))) tptr s)"
-  by (clarsimp simp: valid_replies'_sc_asrt_def)
-
-lemma valid_replies'_sc_asrt_replySC_None:
-  "\<lbrakk>valid_replies'_sc_asrt rptr s; replyTCBs_of s rptr = Some tptr;
-    st_tcb_at' P tptr s; \<not> P (BlockedOnReply (Some rptr))\<rbrakk>
-   \<Longrightarrow> replySCs_of s rptr = None"
-  by (force simp: valid_replies'_sc_asrt_def pred_tcb_at'_def obj_at'_def)
-
-lemma valid_replies'_no_tcb_not_linked:
-  "\<lbrakk>replyTCBs_of s replyPtr = None;
-    valid_replies' s; valid_replies'_sc_asrt replyPtr s\<rbrakk>
-    \<Longrightarrow> \<not> is_reply_linked replyPtr s \<and> replySCs_of s replyPtr = None"
-  apply (clarsimp simp: valid_replies'_def valid_replies'_sc_asrt_def)
-  apply (drule_tac x=replyPtr in spec)
-  apply clarsimp
-  done
-
-lemma valid_replies'_sc_asrt_lift:
-  assumes x: "\<And>P. f \<lbrace>\<lambda>s. P (replySCs_of s)\<rbrace>"
-  assumes y: "\<And>P. f \<lbrace>\<lambda>s. P (replyTCBs_of s)\<rbrace>"
-  assumes z: "\<And>rptr t. f \<lbrace>st_tcb_at' ((=) (BlockedOnReply rptr)) t\<rbrace>"
-  shows "f \<lbrace>valid_replies'_sc_asrt replyPtr\<rbrace>"
-  unfolding valid_replies'_sc_asrt_def
-  by (wpsimp wp: hoare_vcg_imp_lift' x y z hoare_vcg_ex_lift)
-
-lemma valid_replies'_lift:
-  assumes rNext: "\<And>P. f \<lbrace>\<lambda>s. P (replyNexts_of s)\<rbrace>"
-  and rPrev: "\<And>P. f \<lbrace>\<lambda>s. P (replyPrevs_of s)\<rbrace>"
-  and rTCB: "\<And>P. f \<lbrace>\<lambda>s. P (replyTCBs_of s)\<rbrace>"
-  and st: "\<And>rptr p. f \<lbrace>st_tcb_at' ((=) (BlockedOnReply rptr)) p\<rbrace>"
-  shows "\<lbrace>valid_replies'\<rbrace> f \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  unfolding valid_replies'_def
-  by (wpsimp wp: hoare_vcg_imp_lift' rNext rPrev rTCB st hoare_vcg_all_lift hoare_vcg_ex_lift)
-
-lemma cteCaps_of_ctes_of_lift:
-  "(\<And>P. f \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>) \<Longrightarrow> f \<lbrace>\<lambda>s. P (cteCaps_of s)\<rbrace>"
-  unfolding cteCaps_of_def .
-
-lemmas ctes_of_cteCaps_of_lift = cteCaps_of_ctes_of_lift
-
 add_upd_simps "invs' (gsUntypedZeroRanges_update f s)"
   (obj_at'_real_def)
 declare upd_simps[simp]
@@ -4186,96 +3475,4 @@ lemma obj_range'_disjoint:
   apply (metis add_mask_fold distinct_obj_range'_not_subset obj_range'_def)
   done
 
-(* sym_heap *)
-
-lemma sym_refs_replyNext_replyPrev_sym:
-  "sym_refs (list_refs_of_replies' s') \<Longrightarrow>
-    replyNexts_of s' rp = Some rp' \<longleftrightarrow> replyPrevs_of s' rp' = Some rp"
-  supply opt_mapE[elim!]
-  apply (rule iffI; clarsimp simp: projectKO_opts_defs split: kernel_object.split_asm)
-   apply (drule_tac tp=ReplyNext and y=rp' and x=rp in sym_refsD[rotated])
-    apply (clarsimp simp: map_set_def opt_map_red list_refs_of_reply'_def projectKO_opt_reply)
-   apply (clarsimp simp: opt_map_red map_set_def get_refs_def2 list_refs_of_reply'_def
-                  split: option.split_asm)
-  apply (drule_tac tp=ReplyPrev and y=rp and x=rp' in sym_refsD[rotated])
-   apply (clarsimp simp: map_set_def opt_map_red list_refs_of_reply'_def projectKO_opt_reply)
-  by (clarsimp simp: opt_map_red map_set_def get_refs_def2 list_refs_of_reply'_def
-              split: option.split_asm)
-
-lemma reply_sym_heap_Next_Prev:
-  "sym_refs (list_refs_of_replies' s') \<Longrightarrow> sym_heap (replyNexts_of s') (replyPrevs_of s')"
-  using sym_refs_replyNext_replyPrev_sym by (clarsimp simp: sym_heap_def)
-
-lemmas reply_sym_heap_Prev_Next
-  = sym_heap_symmetric[THEN iffD1, OF reply_sym_heap_Next_Prev]
-
-lemmas sym_refs_replyNext_None
-  = sym_heap_None[OF reply_sym_heap_Next_Prev]
-
-lemmas sym_refs_replyPrev_None
-  = sym_heap_None[OF reply_sym_heap_Prev_Next]
-
-lemmas sym_refs_reply_heap_path_doubly_linked_Prevs_rev
-  = sym_heap_path_reverse[OF reply_sym_heap_Next_Prev]
-
-lemmas sym_refs_reply_heap_path_doubly_linked_Nexts_rev
-  = sym_heap_path_reverse[OF reply_sym_heap_Prev_Next]
-
-lemmas sym_refs_replyNext_heap_ls_Cons
-  = sym_heap_ls_rev_Cons[OF reply_sym_heap_Next_Prev]
-
-lemmas sym_refs_replyPrev_heap_ls_Cons
-  = sym_heap_ls_rev_Cons[OF reply_sym_heap_Prev_Next]
-
-lemmas sym_refs_replyNext_heap_ls
-  = sym_heap_ls_rev[OF reply_sym_heap_Next_Prev]
-
-lemmas sym_refs_replyPrev_heap_ls
-  = sym_heap_ls_rev[OF reply_sym_heap_Prev_Next]
-
-(* end: sym_heap *)
-
-lemma no_replySC_valid_replies'_sc_asrt:
-  "replySCs_of s r = None \<Longrightarrow> valid_replies'_sc_asrt r s"
-  unfolding valid_replies'_sc_asrt_def
-  by (simp)
-
-(** sc_with_reply' **)
-
-definition sc_with_reply' where
-  "sc_with_reply' rp s' =
-     the_pred_option
-         (\<lambda>sc_ptr. \<exists>xs. heap_ls (replyPrevs_of s') (scReplies_of s' sc_ptr) xs
-                     \<and> rp \<in> set xs)"
-
-lemma sc_with_reply'_SomeD:
-  "sc_with_reply' rp s' = Some scp \<Longrightarrow>
-     \<exists>xs. heap_ls (replyPrevs_of s') (scReplies_of s' scp) xs
-                     \<and> rp \<in> set xs"
-  by (clarsimp simp: sc_with_reply'_def dest!: the_pred_option_SomeD)
-
-lemma sc_with_reply'_NoneD:
-  "sc_with_reply' rp s' = None \<Longrightarrow>
-     \<nexists>!scp. \<exists>xs. heap_ls (replyPrevs_of s') (scReplies_of s' scp) xs
-                     \<and> rp \<in> set xs"
-  by (clarsimp simp: sc_with_reply'_def the_pred_option_def split: if_split_asm)
-
-definition "updateTimeStamp_independent (P :: kernel_state \<Rightarrow> bool)
-  \<equiv> \<forall>f g s. P s \<longrightarrow> P (s\<lparr>ksCurTime := f (ksCurTime s), ksConsumedTime := g (ksConsumedTime s)\<rparr>)"
-
-lemma updateTimeStamp_independentI[intro!, simp]:
-  "\<lbrakk>\<And>s f g. P (s\<lparr>ksCurTime := f (ksCurTime s), ksConsumedTime := g (ksConsumedTime s)\<rparr>) = P s\<rbrakk>
-   \<Longrightarrow> updateTimeStamp_independent P"
-  by (simp add: updateTimeStamp_independent_def)
-
-definition "domain_time_independent_H (P :: kernel_state \<Rightarrow> bool)
-  \<equiv> \<forall>f s. P s \<longrightarrow>
-           P (s\<lparr>ksDomainTime := f (ksDomainTime s)\<rparr>)"
-
-lemma domain_time_independent_HI[intro!, simp]:
-   "\<lbrakk>\<And>s f. P (s\<lparr>ksDomainTime := f (ksDomainTime s)\<rparr>)
-            = P s\<rbrakk>
-    \<Longrightarrow> domain_time_independent_H P"
-   by (simp add: domain_time_independent_H_def)
-
 end
diff --git a/proof/refine/ARM/Invocations_R.thy b/proof/refine/ARM/Invocations_R.thy
index 60ffad1ed0..5f49d06d96 100644
--- a/proof/refine/ARM/Invocations_R.thy
+++ b/proof/refine/ARM/Invocations_R.thy
@@ -8,7 +8,7 @@ theory Invocations_R
 imports Invariants_H
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma invocationType_eq[simp]:
   "invocationType = invocation_type"
diff --git a/proof/refine/ARM/IpcCancel_R.thy b/proof/refine/ARM/IpcCancel_R.thy
index 96eb259c72..c7fb548db4 100644
--- a/proof/refine/ARM/IpcCancel_R.thy
+++ b/proof/refine/ARM/IpcCancel_R.thy
@@ -7,18 +7,16 @@
 theory IpcCancel_R
 imports
   Schedule_R
-  Reply_R
   "Lib.SimpStrategy"
 begin
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 crunch cancelAllIPC
- for aligned'[wp]: pspace_aligned'
-  (wp: crunch_wps mapM_x_wp' simp: unless_def crunch_simps)
+  for aligned'[wp]: pspace_aligned'
+  (wp: crunch_wps mapM_x_wp' simp: unless_def)
 crunch cancelAllIPC
- for distinct'[wp]: pspace_distinct'
-  (wp: crunch_wps mapM_x_wp' simp: unless_def crunch_simps)
+  for distinct'[wp]: pspace_distinct'
+  (wp: crunch_wps mapM_x_wp' simp: unless_def)
 
 crunch cancelAllSignals
   for aligned'[wp]: pspace_aligned'
@@ -27,16 +25,11 @@ crunch cancelAllSignals
   for distinct'[wp]: pspace_distinct'
   (wp: crunch_wps mapM_x_wp')
 
-lemma cancelSignal_st_tcb_at'_cases:
-  "\<lbrace>\<lambda>s. (t = t' \<longrightarrow> Q (P Inactive)) \<and> (t \<noteq> t' \<longrightarrow> Q (st_tcb_at' P t s))\<rbrace>
-   cancelSignal t' n
-   \<lbrace>\<lambda>_ s. Q (st_tcb_at' P t s)\<rbrace>"
-  unfolding cancelSignal_def replyRemoveTCB_def cleanReply_def
-  by (wpsimp wp: sts_st_tcb_at'_cases_strong getNotification_wp hoare_vcg_imp_lift')
-
 lemma cancelSignal_simple[wp]:
   "\<lbrace>\<top>\<rbrace> cancelSignal t ntfn \<lbrace>\<lambda>rv. st_tcb_at' simple' t\<rbrace>"
-  by (wpsimp wp: cancelSignal_st_tcb_at'_cases)
+  apply (simp add: cancelSignal_def Let_def)
+  apply (wp setThreadState_st_tcb | simp)+
+  done
 
 lemma cancelSignal_pred_tcb_at':
   "\<lbrace>pred_tcb_at' proj P t' and K (t \<noteq> t')\<rbrace>
@@ -46,77 +39,81 @@ lemma cancelSignal_pred_tcb_at':
   apply (wp sts_pred_tcb_neq' getNotification_wp | wpc | clarsimp)+
   done
 
-lemma cancelSignal_tcb_at':
-  "cancelSignal tptr ntfnptr \<lbrace>\<lambda>s. P (tcb_at' tptr' s)\<rbrace>"
-  unfolding cancelSignal_def Let_def
-  apply (wpsimp wp: hoare_drop_imp)
+crunch emptySlot
+  for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
+  (wp: setCTE_pred_tcb_at')
+
+lemma set_ep_pred_tcb_at' [wp]:
+  "\<lbrace> pred_tcb_at' proj P t \<rbrace>
+   setEndpoint ep v
+   \<lbrace> \<lambda>rv. pred_tcb_at' proj P t \<rbrace>"
+  apply (simp add: setEndpoint_def pred_tcb_at'_def)
+  apply (rule obj_at_setObject2)
+   apply simp
+  apply (simp add: updateObject_default_def in_monad projectKOs)
   done
 
 defs capHasProperty_def:
   "capHasProperty ptr P \<equiv> cte_wp_at' (\<lambda>c. P (cteCap c)) ptr"
 end
-
-lemma blockedCancelIPC_st_tcb_at:
-  "\<lbrace>\<lambda>s. (t = t' \<longrightarrow> Q (P Inactive)) \<and> (t \<noteq> t' \<longrightarrow> Q (st_tcb_at' P t s))\<rbrace>
-   blockedCancelIPC st t' rptr
-   \<lbrace>\<lambda>_ s. Q (st_tcb_at' P t s)\<rbrace>"
-  unfolding blockedCancelIPC_def getBlockingObject_def
-  by (wpsimp wp: sts_st_tcb_at'_cases_strong replyUnlink_st_tcb_at' getEndpoint_wp hoare_vcg_imp_lift')
-
-lemma cancelIPC_st_tcb_at':
-  "\<lbrace>\<lambda>s. if t' = t \<and> st_tcb_at' (\<lambda>st. st \<notin> {Running, Restart, IdleThreadState}) t' s
-        then P (P' Inactive)
-        else P (st_tcb_at' P' t' s)\<rbrace>
-   cancelIPC t
-   \<lbrace>\<lambda>rv s. P (st_tcb_at' P' t' s)\<rbrace>"
-  apply (clarsimp simp: cancelIPC_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ gts_sp'])
-  apply (wpsimp wp: blockedCancelIPC_st_tcb_at replyRemoveTCB_st_tcb_at'_cases
-                    cancelSignal_st_tcb_at'_cases threadSet_pred_tcb_no_state)
-  apply (auto simp: pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma cancelIPC_simple[wp]:
-  "\<lbrace>\<top>\<rbrace> cancelIPC t \<lbrace>\<lambda>rv. st_tcb_at' simple' t\<rbrace>"
-  unfolding cancelIPC_def blockedCancelIPC_def
-  apply (wpsimp wp: setThreadState_st_tcb gts_wp' threadSet_wp
-              simp: Let_def tcb_obj_at'_pred_tcb'_set_obj'_iff)
-  apply (clarsimp simp: st_tcb_at'_def o_def obj_at'_def isBlockedOnReply_def)
-  done
-
-lemma cancelIPC_st_tcb_at'_different_thread:
-  "\<lbrace>\<lambda>s. P (st_tcb_at' st t' s) \<and> t \<noteq> t'\<rbrace> cancelIPC t \<lbrace>\<lambda>rv s. P (st_tcb_at' st t' s)\<rbrace>"
-  by (wpsimp wp: cancelIPC_st_tcb_at')
-
 (* Assume various facts about cteDeleteOne, proved in Finalise_R *)
 locale delete_one_conc_pre =
   assumes delete_one_st_tcb_at:
     "\<And>P. (\<And>st. simple' st \<longrightarrow> P st) \<Longrightarrow>
      \<lbrace>st_tcb_at' P t\<rbrace> cteDeleteOne slot \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
-  assumes delete_one_typ_at[wp]:
+  assumes delete_one_typ_at:
     "\<And>P. \<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> cteDeleteOne slot \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
-  assumes delete_one_sc_at'_n[wp]:
-    "\<And>P. cteDeleteOne slot \<lbrace>\<lambda>s. P (sc_at'_n n p s)\<rbrace>"
   assumes delete_one_aligned:
     "\<lbrace>pspace_aligned'\<rbrace> cteDeleteOne slot \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
   assumes delete_one_distinct:
     "\<lbrace>pspace_distinct'\<rbrace> cteDeleteOne slot \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
   assumes delete_one_it:
     "\<And>P. \<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> cteDeleteOne cap \<lbrace>\<lambda>rv s. P (ksIdleThread s)\<rbrace>"
+  assumes delete_one_sch_act_simple:
+    "\<lbrace>sch_act_simple\<rbrace> cteDeleteOne sl \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
+  assumes delete_one_sch_act_not:
+    "\<And>t. \<lbrace>sch_act_not t\<rbrace> cteDeleteOne sl \<lbrace>\<lambda>rv. sch_act_not t\<rbrace>"
+  assumes delete_one_reply_st_tcb_at:
+    "\<And>P t. \<lbrace>\<lambda>s. st_tcb_at' P t s \<and> (\<exists>t' r. cte_wp_at' (\<lambda>cte. cteCap cte = ReplyCap t' False r) slot s)\<rbrace>
+      cteDeleteOne slot
+     \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
   assumes delete_one_ksCurDomain:
     "\<And>P. \<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> cteDeleteOne sl \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
   assumes delete_one_tcbDomain_obj_at':
     "\<And>P. \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace> cteDeleteOne slot \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
 
-lemma cancelSignal_st_tcb_at':
-  "\<lbrace>K (P Inactive)\<rbrace>
-   cancelSignal t ntfn
-   \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
-  unfolding cancelSignal_def Let_def
-  apply (rule hoare_gen_asm_single)
-  apply (wpsimp wp: setThreadState_st_tcb_at'_cases)
+lemma (in delete_one_conc_pre) cancelIPC_simple[wp]:
+  "\<lbrace>\<top>\<rbrace> cancelIPC t \<lbrace>\<lambda>rv. st_tcb_at' simple' t\<rbrace>"
+  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def
+             cong: Structures_H.thread_state.case_cong list.case_cong)
+  apply (rule bind_wp [OF _ gts_sp'])
+  apply (rule hoare_pre)
+   apply (wpc
+           | wp sts_st_tcb_at'_cases hoare_vcg_conj_lift
+                hoare_vcg_const_imp_lift delete_one_st_tcb_at
+                threadSet_pred_tcb_no_state
+                hoare_strengthen_post [OF cancelSignal_simple]
+           | simp add: o_def if_fun_split
+           | rule hoare_drop_imps
+           | clarsimp elim!: pred_tcb'_weakenE)+
+  apply (auto simp: pred_tcb_at'
+             elim!: pred_tcb'_weakenE)
+  done
+
+lemma (in delete_one_conc_pre) cancelIPC_st_tcb_at':
+  "\<lbrace>st_tcb_at' P t' and K (t \<noteq> t')\<rbrace>
+     cancelIPC t
+   \<lbrace>\<lambda>rv. st_tcb_at' P t'\<rbrace>"
+  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def locateSlot_conv
+                   capHasProperty_def isCap_simps)
+  apply (wp sts_pred_tcb_neq' hoare_drop_imps delete_one_reply_st_tcb_at
+       | wpc | clarsimp)+
+          apply (wp getCTE_wp | clarsimp)+
+         apply (wp hoare_vcg_ex_lift threadSet_cte_wp_at' hoare_vcg_imp_lift
+                   cancelSignal_pred_tcb_at' sts_pred_tcb_neq' getEndpoint_wp gts_wp'
+                   threadSet_pred_tcb_no_state
+              | wpc | clarsimp)+
+  apply (auto simp: cte_wp_at_ctes_of isCap_simps)
   done
 
 context begin interpretation Arch .
@@ -124,296 +121,214 @@ crunch emptySlot
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
 end
 
-sublocale delete_one_conc_pre < delete_one: typ_at_all_props' "cteDeleteOne slot"
-  by typ_at_props'
-
-declare if_weak_cong [cong]
-declare delete_remove1 [simp]
-declare delete.simps [simp del]
-
-lemma sch_act_wf_weak_sch_act_wf[elim!]:
-  "sch_act_wf (ksSchedulerAction s) s \<Longrightarrow> weak_sch_act_wf (ksSchedulerAction s) s"
-  by (clarsimp simp: weak_sch_act_wf_def)
+crunch cancelSignal
+  for tcb_at'[wp]: "tcb_at' t"
+  (wp: crunch_wps simp: crunch_simps)
 
-lemma replyTCB_update_corres:
-  "corres dc (reply_at rp) (reply_at' rp)
-            (set_reply_obj_ref reply_tcb_update rp new)
-            (updateReply rp (replyTCB_update (\<lambda>_. new)))"
-  apply (simp add: update_sk_obj_ref_def updateReply_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_reply_corres])
-      apply (rule set_reply_corres)
-      apply (simp add: reply_relation_def)
-  by (wpsimp simp: obj_at'_def replyPrev_same_def)+
+context delete_one_conc_pre
+begin
 
-lemma replyUnlinkTcb_corres:
-  "corres dc
-     (valid_tcbs and pspace_aligned and pspace_distinct
-       and st_tcb_at (\<lambda>st. \<exists>ep pl. st = Structures_A.BlockedOnReceive ep (Some rp) pl
-                           \<or> st = Structures_A.BlockedOnReply rp) t
-       and reply_tcb_reply_at ((=) (Some t)) rp)
-        (valid_tcbs' and valid_release_queue_iff)
-        (reply_unlink_tcb t rp) (replyUnlink rp t)" (is "corres _ _ ?conc_guard _ _")
-  apply (rule_tac Q="?conc_guard
-         and st_tcb_at' (\<lambda>st. (\<exists>ep pl. st = BlockedOnReceive ep (receiver_can_grant pl) (Some rp))
-                               \<or> st = BlockedOnReply (Some rp)) t"
-         in corres_cross_over_guard)
-   apply clarsimp
-   apply (drule (1) st_tcb_at_coerce_concrete; clarsimp simp: state_relation_def)
-   apply (fastforce simp: pred_tcb_at'_def obj_at'_def)
-  apply (simp add: reply_unlink_tcb_def replyUnlink_def liftM_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_reply_corres])
-      apply (rule corres_assert_gen_asm_l)
-      apply (rename_tac reply'; prop_tac "replyTCB reply' = Some t")
-       apply (clarsimp simp: reply_relation_def)
-      apply simp
-      apply (rule corres_split[OF getThreadState_corres])
-        apply (rule corres_assert_gen_asm_l)
-        apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-         apply (rule corres_split[OF replyTCB_update_corres])
-           apply (rule setThreadState_corres)
-           apply (clarsimp simp: thread_state_relation_def)
-          apply wpsimp
+lemmas delete_one_typ_ats[wp] = typ_at_lifts [OF delete_one_typ_at]
 
-         apply (wpsimp simp: updateReply_def)
-        apply (fastforce simp: replyUnlink_assertion_def thread_state_relation_def)
-       apply (wpsimp wp: hoare_vcg_disj_lift gts_wp get_simple_ko_wp)+
-   apply (clarsimp simp: sk_obj_at_pred_def obj_at_def is_reply pred_tcb_at_def is_tcb)
-  apply (clarsimp simp: obj_at'_def st_tcb_at'_def projectKOs)
-  apply (prop_tac "reply_at' rp s")
-   apply (fastforce simp: valid_tcbs'_def valid_tcb'_def valid_tcb_state'_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
+lemma cancelIPC_tcb_at'[wp]:
+  "\<lbrace>tcb_at' t\<rbrace> cancelIPC t' \<lbrace>\<lambda>_. tcb_at' t\<rbrace>"
+  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def)
+  apply (wp delete_one_typ_ats hoare_drop_imps
+       | simp add: o_def if_apply_def2 | wpc | assumption)+
   done
 
-lemma setNotification_valid_tcb'[wp]:
-  "setNotification ntfn val \<lbrace>valid_tcb' tcb\<rbrace>"
-  apply (clarsimp simp: setNotification_def)
-  apply (rule setObject_valid_tcb')
-  done
+end
 
-lemma setNotification_valid_tcbs'[wp]:
-  "setNotification ntfn val \<lbrace>valid_tcbs'\<rbrace>"
-  unfolding valid_tcbs'_def
-  by (wpsimp wp: set_ntfn'.setObject_wp hoare_vcg_all_lift hoare_vcg_imp_lift'
-           simp: setNotification_def)+
+declare if_weak_cong [cong]
+declare delete_remove1 [simp]
+declare delete.simps [simp del]
 
-lemma setEndpoint_valid_tcb'[wp]:
-  "setEndpoint epPtr val \<lbrace>valid_tcb' tcb\<rbrace>"
-  apply (clarsimp simp: setEndpoint_def)
-  apply (rule setObject_valid_tcb')
+lemma invs_weak_sch_act_wf[elim!]:
+  "invs' s \<Longrightarrow> weak_sch_act_wf (ksSchedulerAction s) s"
+  apply (drule invs_sch_act_wf')
+  apply (clarsimp simp: weak_sch_act_wf_def)
   done
 
-lemma setEndpoint_valid_tcbs'[wp]:
-  "setEndpoint ePtr val \<lbrace>valid_tcbs'\<rbrace>"
-  unfolding valid_tcbs'_def
-  by (wpsimp wp: set_ep'.setObject_wp hoare_vcg_all_lift hoare_vcg_imp_lift'
-           simp: setEndpoint_def)+
-
-lemma replyUnlink_valid_tcbs'[wp]:
-  "replyUnlink replyPtr tcbPtr \<lbrace>valid_tcbs'\<rbrace>"
-  apply (clarsimp simp: replyUnlink_def getReply_def
-                        updateReply_def)
-  apply (wpsimp wp: set_reply'.getObject_wp set_reply'.getObject_wp gts_wp'
-              simp: valid_tcb_state'_def )
-  done
+crunch set_endpoint
+  for tcb_at[wp]: "tcb_at t"
+crunch setEndpoint
+  for tcb_at'[wp]: "tcb_at' t"
 
 lemma blocked_cancelIPC_corres:
-  "\<lbrakk> st = Structures_A.BlockedOnReceive epPtr reply_opt p' \<or>
-     st = Structures_A.BlockedOnSend epPtr p; thread_state_relation st st';
-     st = Structures_A.BlockedOnSend epPtr p \<longrightarrow> reply_opt = None \<rbrakk> \<Longrightarrow>
-   corres dc (valid_objs and pspace_aligned and pspace_distinct
-              and st_tcb_at ((=) st) t and (\<lambda>s. sym_refs (state_refs_of s)))
-             (valid_objs' and valid_release_queue_iff and st_tcb_at' ((=) st') t)
-           (blocked_cancel_ipc st t reply_opt)
-           (blockedCancelIPC st' t reply_opt)" (is "\<lbrakk> _ ; _ ; _ \<rbrakk> \<Longrightarrow> corres _ (?abs_guard and _) _ _ _")
-  apply add_sym_refs
-  apply (prop_tac "getBlockingObject st' = return epPtr")
-   apply (case_tac st; clarsimp simp: getBlockingObject_def epBlocked_def)
-  apply (simp add: blocked_cancel_ipc_def blockedCancelIPC_def gbep_ret)
+  "\<lbrakk> st = Structures_A.BlockedOnReceive epPtr p' \<or>
+     st = Structures_A.BlockedOnSend epPtr p; thread_state_relation st st' \<rbrakk> \<Longrightarrow>
+   corres dc (invs and st_tcb_at ((=) st) t) (invs' and st_tcb_at' ((=) st') t)
+           (blocked_cancel_ipc st t)
+           (do ep \<leftarrow> getEndpoint epPtr;
+               y \<leftarrow> assert (\<not> (case ep of IdleEP \<Rightarrow> True | _ \<Rightarrow> False));
+               ep' \<leftarrow>
+               if remove1 t (epQueue ep) = [] then return IdleEP
+               else
+                 return $ epQueue_update (%_. (remove1 t (epQueue ep))) ep;
+               y \<leftarrow> setEndpoint epPtr ep';
+               setThreadState Structures_H.thread_state.Inactive t
+            od)"
+  apply (simp add: blocked_cancel_ipc_def gbep_ret)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getEndpoint_corres])
       apply (rule_tac F="ep \<noteq> IdleEP" in corres_gen_asm2)
       apply (rule corres_assert_assume[rotated])
        apply (clarsimp split: endpoint.splits)
-       \<comment>\<open>drop sym_refs assumtions; add reply_tcb link\<close>
-      apply (rule_tac P="?abs_guard and (\<lambda>s. bound reply_opt \<longrightarrow> reply_tcb_reply_at ((=) (Some t)) (the reply_opt) s)
-                         and valid_ep rv
-                         and (\<lambda>_. (st = Structures_A.BlockedOnSend epPtr p
-                                      \<longrightarrow> (\<exists>list. rv = Structures_A.SendEP list))
-                                \<and> (st = Structures_A.thread_state.BlockedOnReceive epPtr reply_opt p'
-                                     \<longrightarrow> (\<exists>list. rv = Structures_A.RecvEP list)))"
-                  and P'="valid_objs' and valid_release_queue_iff and st_tcb_at' ((=) st') t
-                          and valid_ep' ep"
-                   in corres_inst)
-      \<comment>\<open>cross over replyTCB\<close>
-      apply (rule_tac Q="\<lambda>s. bound reply_opt \<longrightarrow> obj_at' (\<lambda>r. replyTCB r = Some t) (the reply_opt) s" in corres_cross_add_guard)
-       apply clarsimp
-       apply (drule state_relationD)
-       apply (frule_tac s'=s' in pspace_aligned_cross, simp)
-       apply (frule_tac s'=s' in pspace_distinct_cross, simp, simp)
-       apply (clarsimp simp: obj_at_def sk_obj_at_pred_def)
-       apply (rename_tac rp list reply)
-       apply (drule_tac x=rp in pspace_relation_absD, simp)
-       apply (clarsimp simp: obj_relation_cuts_def2 obj_at'_def reply_relation_def projectKOs)
-       apply (rename_tac ko)
-       apply (case_tac ko; simp)
-       apply (rename_tac reply')
-       apply (frule_tac x=rp in pspace_alignedD', simp)
-       apply (frule_tac x=rp in pspace_distinctD', simp)
-       apply (drule_tac x=rp in pspace_boundedD'[OF _ pspace_relation_pspace_bounded'], simp)
-       apply (clarsimp simp: reply_relation_def)
-       \<comment>\<open>main corres proof\<close>
-      apply (rule corres_gen_asm)
-      apply (erule disjE; clarsimp simp: ep_relation_def get_ep_queue_def split del: if_split)
-       \<comment>\<open>BlockedOnReceive\<close>
+      apply (rule_tac P="invs and st_tcb_at ((=) st) t" and
+                      P'="invs' and st_tcb_at' ((=) st') t" in corres_inst)
+      apply (case_tac rv)
+        apply (simp add: ep_relation_def)
+       apply (simp add: get_ep_queue_def ep_relation_def split del: if_split)
        apply (rename_tac list)
-       apply (cases reply_opt;
-              simp split del: if_split add: bind_assoc cong: if_cong)
-         \<comment>\<open>reply_opt = None\<close>
+       apply (case_tac "remove1 t list")
+        apply simp
         apply (rule corres_guard_imp)
           apply (rule corres_split[OF setEndpoint_corres])
-             apply (simp add: ep_relation_def split: list.split)
+             apply (simp add: ep_relation_def)
             apply (rule setThreadState_corres)
             apply simp
-           apply wpsimp+
-         apply (frule (1) Receive_or_Send_ep_at[rotated], fastforce)
-         apply (intro conjI;
-                clarsimp simp: st_tcb_at_def obj_at_def is_ep is_tcb
-                       intro!: valid_ep_remove1_RecvEP)
-        apply clarsimp
-        apply (frule Receive_or_Send_ep_at'[rotated], simp)
-         apply (simp add: thread_state_relation_def)
-        apply (fastforce simp: valid_ep'_def)
-         \<comment>\<open>reply_opt bound\<close>
+           apply (simp add: valid_tcb_state_def pred_conj_def)
+           apply (wp weak_sch_act_wf_lift)+
+         apply (clarsimp simp: st_tcb_at_tcb_at)
+         apply (clarsimp simp: st_tcb_at_def obj_at_def)
+         apply (erule pspace_valid_objsE)
+          apply fastforce
+         apply (auto simp: valid_tcb_state_def valid_tcb_def
+                           valid_obj_def obj_at_def)[1]
+        apply (clarsimp simp: pred_tcb_at')
+        apply (clarsimp simp: pred_tcb_at'_def)
+        apply (drule obj_at_ko_at')
+        apply clarify
+        apply (drule ko_at_valid_objs')
+          apply fastforce
+         apply (simp add: projectKOs)
+        apply (auto simp add: valid_obj'_def valid_tcb'_def
+                              valid_tcb_state'_def)[1]
+       apply clarsimp
        apply (rule corres_guard_imp)
-         apply (rule_tac R="\<lambda>_. ep_at epPtr and reply_tcb_reply_at ((=) (Some t)) a  and ?abs_guard"
-                     and R'="\<lambda>_. ep_at' epPtr and obj_at' (\<lambda>r. replyTCB r = Some t) a
-                                 and valid_objs' and valid_release_queue_iff
-                                 and st_tcb_at' ((=) st') t"
-                      in corres_split[OF setEndpoint_corres])
-            apply (simp add: ep_relation_def split: list.split)
-           apply (rule corres_guard_imp)
-             apply (rule corres_split[OF replyUnlinkTcb_corres])
-               apply (rule setThreadState_corres, simp)
-              apply wpsimp
-             apply (wpsimp wp: replyUnlink_valid_objs')
-            apply (fastforce simp: pred_tcb_at_def obj_at_def is_tcb)
-           apply (fastforce simp: obj_at'_def pred_tcb_at'_def)
-          apply (wpsimp wp: set_simple_ko_wp)
-         apply (wpsimp wp: set_ep'.set_wp)
-        apply clarsimp
-        apply (frule (1) Reply_or_Receive_reply_at[rotated], fastforce)
-        apply (frule (1) Receive_or_Send_ep_at[rotated], fastforce)
+         apply (rule corres_split[OF setEndpoint_corres])
+            apply (simp add: ep_relation_def)
+           apply (rule setThreadState_corres)
+           apply simp
+          apply (wp)+
         apply (clarsimp simp: st_tcb_at_tcb_at)
-        apply (rule conjI, clarsimp simp: obj_at_def is_ep)
-        apply (rule conjI, clarsimp simp: sk_obj_at_pred_def obj_at_def)
-        apply (intro conjI)
-           apply (fastforce elim!: valid_objs_ep_update intro!: valid_ep_remove1_RecvEP)
-          apply (clarsimp elim!: pspace_aligned_obj_update dest!: invs_psp_aligned
-                           simp: a_type_def is_ep)
-         apply (clarsimp elim!: pspace_distinct_same_type dest!: invs_distinct
-                          simp: a_type_def is_ep obj_at_def)
-        apply (clarsimp simp: pred_tcb_at_def obj_at_def is_ep)
-       apply (clarsimp split del: if_split)
-       apply (frule (1) Receive_or_Send_ep_at'[rotated], blast)
-       apply (clarsimp split del: if_split)
-       apply (rule conjI, clarsimp simp: obj_at'_def projectKOs ps_clear_upd objBits_simps)
-       apply (rule conjI; clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs ps_clear_upd)
-       apply (intro conjI impI; clarsimp?)
-         apply (erule valid_objs'_ep_update)
-          apply (case_tac "remove1 t list"
-                 ; clarsimp simp: valid_ep'_def obj_at'_def projectKOs
-                 ; metis distinct.simps(2) distinct_remove1 list.set_intros(1) list.set_intros(2)
-                         set_remove1)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-        apply ((clarsimp simp: obj_at'_def projectKOs valid_ep'_def)+)[2]
-        apply (erule valid_release_queue_ksPSpace_update)
-         apply ((clarsimp simp: ko_wp_at'_def objBitsKO_def koTypeOf_def)+)[2]
-       apply (erule valid_release_queue'_ksPSpace_update)
-        apply ((clarsimp simp: ko_wp_at'_def objBitsKO_def koTypeOf_def)+)[2]
-      \<comment>\<open>BlockedOnSend\<close>
+        apply (clarsimp simp: st_tcb_at_def obj_at_def)
+        apply (erule pspace_valid_objsE)
+         apply fastforce
+        apply (auto simp: valid_tcb_state_def valid_tcb_def
+                          valid_obj_def obj_at_def)[1]
+       apply (clarsimp simp: pred_tcb_at')
+       apply (clarsimp simp: pred_tcb_at'_def)
+       apply (drule obj_at_ko_at')
+       apply clarify
+       apply (drule ko_at_valid_objs')
+         apply fastforce
+        apply (simp add: projectKOs)
+       apply (auto simp add: valid_obj'_def valid_tcb'_def
+                             valid_tcb_state'_def)[1]
+      apply (simp add: get_ep_queue_def ep_relation_def split del: if_split)
       apply (rename_tac list)
+      apply (case_tac "remove1 t list")
+       apply simp
+       apply (rule corres_guard_imp)
+         apply (rule corres_split[OF setEndpoint_corres])
+            apply (simp add: ep_relation_def)
+           apply (rule setThreadState_corres)
+           apply simp
+          apply (simp add: valid_tcb_state_def pred_conj_def)
+          apply (wp weak_sch_act_wf_lift)+
+        apply (clarsimp simp: st_tcb_at_tcb_at)
+        apply (clarsimp simp: st_tcb_at_def obj_at_def)
+        apply (erule pspace_valid_objsE)
+         apply fastforce
+        apply (auto simp: valid_tcb_state_def valid_tcb_def
+                          valid_obj_def obj_at_def)[1]
+       apply (clarsimp simp: pred_tcb_at')
+       apply (clarsimp simp: pred_tcb_at'_def)
+       apply (drule obj_at_ko_at')
+       apply clarify
+       apply (drule ko_at_valid_objs')
+         apply fastforce
+        apply (simp add: projectKOs)
+       apply (auto simp add: valid_obj'_def valid_tcb'_def
+                             valid_tcb_state'_def)[1]
+      apply clarsimp
       apply (rule corres_guard_imp)
         apply (rule corres_split[OF setEndpoint_corres])
-           apply (simp add: ep_relation_def split: list.split)
+           apply (simp add: ep_relation_def)
           apply (rule setThreadState_corres)
           apply simp
-         apply (simp add: valid_tcb_state_def pred_conj_def)
-         apply wpsimp+
-       apply (frule (1) Receive_or_Send_ep_at[rotated], fastforce)
-       apply (intro conjI;
-              clarsimp simp: st_tcb_at_def obj_at_def is_ep is_tcb
-                     intro!: valid_ep_remove1_SendEP)
-      apply (clarsimp split del: if_split)
-      apply (frule (1) Receive_or_Send_ep_at'[rotated], blast)
-      apply (fastforce simp: valid_ep'_def)
-     apply (wpsimp wp: getEndpoint_wp hoare_vcg_conj_lift get_simple_ko_wp)+
-   apply (frule (2) Receive_or_Send_ep_at, clarsimp)
-   apply (rule conjI, clarsimp)
-    apply (drule (1) st_tcb_recv_reply_state_refs)
-    apply (clarsimp simp: sk_obj_at_pred_def obj_at_def)
-   apply (rule conjI)
-    apply (clarsimp simp: obj_at_def)
-    apply (erule (1) valid_objsE[where x=epPtr])
-    apply (clarsimp simp: valid_obj_def)
-   apply (erule disjE; clarsimp simp: obj_at_def pred_tcb_at_def)
-    apply (frule (2) sym_ref_BlockedOnReceive_RecvEP[OF _ _ sym], simp)
-   apply (frule (2) sym_ref_BlockedOnSend_SendEP[OF _ _ sym], simp)
+         apply (wp)+
+       apply (clarsimp simp: st_tcb_at_tcb_at)
+       apply (clarsimp simp: st_tcb_at_def obj_at_def)
+       apply (erule pspace_valid_objsE)
+        apply fastforce
+       apply (auto simp: valid_tcb_state_def valid_tcb_def
+                         valid_obj_def obj_at_def)[1]
+      apply (clarsimp simp: pred_tcb_at')
+      apply (clarsimp simp: pred_tcb_at'_def)
+      apply (drule obj_at_ko_at')
+      apply clarify
+      apply (drule ko_at_valid_objs')
+        apply fastforce
+       apply (simp add: projectKOs)
+      apply (auto simp add: valid_obj'_def valid_tcb'_def
+                            valid_tcb_state'_def)[1]
+     apply (wp getEndpoint_wp)+
+   apply (clarsimp simp: st_tcb_at_def obj_at_def)
+   apply (erule pspace_valid_objsE)
+    apply fastforce
+   apply (auto simp: valid_tcb_state_def valid_tcb_def
+                     valid_obj_def obj_at_def)[1]
   apply clarsimp
-  apply (rule context_conjI)
-   apply (erule (1) Receive_or_Send_ep_at'[rotated])
-   apply (fastforce simp: thread_state_relation_def)
-  apply (clarsimp simp: obj_at'_def projectKOs )
   apply (rule conjI)
-   apply (erule (1) valid_objsE', clarsimp simp: valid_obj'_def)
-  apply (erule disjE)
-   apply (fastforce dest!: sym_ref_BlockedOnReceive_RecvEP' simp: ko_wp_at'_def)
-  apply (fastforce dest!: sym_ref_BlockedOnSend_SendEP' simp: ko_wp_at'_def)
+   apply (clarsimp simp: pred_tcb_at'_def)
+   apply (drule obj_at_ko_at')
+   apply clarify
+   apply (drule ko_at_valid_objs')
+     apply fastforce
+    apply (simp add: projectKOs)
+   apply (auto simp add: valid_obj'_def valid_tcb'_def
+                         valid_tcb_state'_def)[1]
+  apply (fastforce simp: ko_wp_at'_def obj_at'_def projectKOs dest: sym_refs_st_tcb_atD')
   done
 
 lemma cancelSignal_corres:
   "corres dc
-          (invs and valid_ready_qs and st_tcb_at ((=) (Structures_A.BlockedOnNotification ntfn)) t)
+          (invs and st_tcb_at ((=) (Structures_A.BlockedOnNotification ntfn)) t)
           (invs' and st_tcb_at' ((=) (BlockedOnNotification ntfn)) t)
           (cancel_signal t ntfn)
           (cancelSignal t ntfn)"
-  apply add_sym_refs
-  apply add_ready_qs_runnable
   apply (simp add: cancel_signal_def cancelSignal_def Let_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply clarsimp
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getNotification_corres])
       apply (rule_tac F="isWaitingNtfn (ntfnObj ntfnaa)" in corres_gen_asm2)
-      apply (case_tac "ntfn_obj ntfna"; simp add: ntfn_relation_def isWaitingNtfn_def)
-      apply (case_tac "ntfna", case_tac "ntfnaa")
-      apply clarsimp
-      apply wpfix
-      apply (rename_tac list bound_tcb sc)
-      apply (rule_tac R="remove1 t list = []" in corres_cases')
-       apply (simp del: dc_simp)
+      apply (case_tac "ntfn_obj ntfna")
+        apply (simp add: ntfn_relation_def isWaitingNtfn_def)
+       apply (simp add: isWaitingNtfn_def ntfn_relation_def split del: if_split)
+       apply (rename_tac list)
+       apply (rule_tac R="remove1 t list = []" in corres_cases)
+        apply (simp del: dc_simp)
+        apply (rule corres_split[OF setNotification_corres])
+           apply (simp add: ntfn_relation_def)
+          apply (rule setThreadState_corres)
+          apply simp
+         apply (wp)+
+       apply (simp add: list_case_If del: dc_simp)
        apply (rule corres_split[OF setNotification_corres])
-          apply (simp add: ntfn_relation_def)
+          apply (clarsimp simp add: ntfn_relation_def neq_Nil_conv)
          apply (rule setThreadState_corres)
          apply simp
-        apply (wp abs_typ_at_lifts)+
-      apply (simp add: list_case_If del: dc_simp)
-      apply (rule corres_split[OF setNotification_corres])
-         apply (clarsimp simp add: ntfn_relation_def)
-        apply (rule setThreadState_corres)
-        apply simp
-       apply (wp abs_typ_at_lifts)+
-     apply (wp get_simple_ko_wp getNotification_wp)+
+        apply (wp)+
+      apply (simp add: isWaitingNtfn_def ntfn_relation_def)
+     apply (wp getNotification_wp)+
    apply (clarsimp simp: conj_comms st_tcb_at_tcb_at)
    apply (clarsimp simp: st_tcb_at_def obj_at_def)
-   apply (erule pspace_valid_objsE, fastforce)
+   apply (erule pspace_valid_objsE)
+    apply fastforce
    apply (clarsimp simp: valid_obj_def valid_tcb_def valid_tcb_state_def)
    apply (drule sym, simp add: obj_at_def)
-   apply clarsimp
-   apply (erule pspace_valid_objsE[where p=ntfn], fastforce)
-   apply (fastforce simp: valid_obj_def valid_ntfn_def
-                   split: option.splits Structures_A.ntfn.splits)
+   apply fastforce
   apply (clarsimp simp: conj_comms pred_tcb_at' cong: conj_cong)
   apply (rule conjI)
    apply (simp add: pred_tcb_at'_def)
@@ -424,10 +339,10 @@ lemma cancelSignal_corres:
     apply (simp add: projectKOs)
    apply (clarsimp simp: valid_obj'_def valid_tcb'_def valid_tcb_state'_def)
    apply (drule sym, simp)
-  apply (intro conjI impI allI; fastforce?)
+  apply (clarsimp simp: invs_weak_sch_act_wf)
   apply (drule sym_refs_st_tcb_atD', fastforce)
   apply (fastforce simp: isWaitingNtfn_def ko_wp_at'_def obj_at'_def projectKOs
-                         ntfn_bound_refs'_def get_refs_def
+                         ntfn_bound_refs'_def
                   split: Structures_H.notification.splits ntfn.splits option.splits)
   done
 
@@ -435,7 +350,128 @@ lemma cte_map_tcb_2:
   "cte_map (t, tcb_cnode_index 2) = t + 2*2^cte_level_bits"
   by (simp add: cte_map_def tcb_cnode_index_def to_bl_1)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
+
+lemma cte_wp_at_master_reply_cap_to_ex_rights:
+  "cte_wp_at (is_master_reply_cap_to t) ptr
+   = (\<lambda>s. \<exists>rights. cte_wp_at ((=) (cap.ReplyCap t True rights)) ptr s)"
+  by (rule ext, rule iffI; clarsimp simp: cte_wp_at_def is_master_reply_cap_to_def)
+
+lemma cte_wp_at_reply_cap_to_ex_rights:
+  "cte_wp_at (is_reply_cap_to t) ptr
+   = (\<lambda>s. \<exists>rights. cte_wp_at ((=) (cap.ReplyCap t False rights)) ptr s)"
+  by (rule ext, rule iffI; clarsimp simp: cte_wp_at_def is_reply_cap_to_def)
+
+lemma reply_no_descendants_mdbNext_null:
+  assumes descs: "descendants_of (t, tcb_cnode_index 2) (cdt s) = {}"
+  and        sr: "(s, s') \<in> state_relation"
+  and      invs: "valid_reply_caps s" "valid_reply_masters s"
+                 "valid_objs s" "valid_mdb s" "valid_mdb' s'" "pspace_aligned' s'"
+                 "pspace_distinct' s'"
+  and       tcb: "st_tcb_at (Not \<circ> halted) t s"
+  and       cte: "ctes_of s' (t + 2*2^cte_level_bits) = Some cte"
+  shows          "mdbNext (cteMDBNode cte) = nullPointer"
+proof -
+  from invs st_tcb_at_reply_cap_valid[OF tcb]
+    have "cte_wp_at (is_master_reply_cap_to t) (t, tcb_cnode_index 2) s"
+    by (fastforce simp: cte_wp_at_caps_of_state is_cap_simps is_master_reply_cap_to_def)
+
+  hence "\<exists>r. cteCap cte = capability.ReplyCap t True r"
+    using invs sr
+    by (fastforce simp: cte_wp_at_master_reply_cap_to_ex_rights
+                        cte_wp_at_ctes_of cte cte_map_def tcb_cnode_index_def
+                  dest: pspace_relation_cte_wp_at state_relation_pspace_relation)
+
+  hence class_link:
+    "\<forall>cte'. ctes_of s' (mdbNext (cteMDBNode cte)) = Some cte' \<longrightarrow>
+            capClass (cteCap cte') = ReplyClass t"
+    using invs
+    apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def)
+    apply (drule class_linksD[where m="ctes_of s'", OF cte])
+      apply (simp add: mdb_next_unfold cte)
+     apply assumption
+    apply simp
+    done
+
+  from invs tcb descs have "\<forall>ptr m g.
+      cte_wp_at ((=) (cap.ReplyCap t m g)) ptr s \<longrightarrow> ptr = (t, tcb_cnode_index 2)"
+    apply (intro allI impI)
+    apply (case_tac m)
+     apply (fastforce simp: invs_def valid_state_def valid_reply_masters_def
+                            cte_wp_at_master_reply_cap_to_ex_rights)
+    apply (fastforce simp: has_reply_cap_def cte_wp_at_reply_cap_to_ex_rights
+                     dest: reply_master_no_descendants_no_reply elim: st_tcb_at_tcb_at)
+    done
+  hence "\<forall>ptr m mdb r.
+      ctes_of s' ptr = Some (CTE (capability.ReplyCap t m r) mdb) \<longrightarrow> ptr = t + 2*2^cte_level_bits"
+    using sr invs
+    apply (intro allI impI)
+    apply (drule(2) pspace_relation_cte_wp_atI
+                    [OF state_relation_pspace_relation])
+    apply (elim exE, case_tac c, simp_all del: split_paired_All)
+    apply (elim allE, erule impE, fastforce)
+    apply (clarsimp simp: cte_map_def tcb_cnode_index_def)
+    done
+  hence class_unique:
+    "\<forall>ptr cte'. ctes_of s' ptr = Some cte' \<longrightarrow>
+                capClass (cteCap cte') = ReplyClass t \<longrightarrow>
+                ptr = t + 2*2^cte_level_bits"
+    apply (intro allI impI)
+    apply (case_tac cte', rename_tac cap node, case_tac cap, simp_all)
+    apply (rename_tac arch_capability)
+    apply (case_tac arch_capability, simp_all)
+    done
+
+  from invs have no_null: "ctes_of s' nullPointer = None"
+    by (clarsimp simp: no_0_def nullPointer_def valid_mdb'_def valid_mdb_ctes_def)
+
+  from invs cte have no_loop: "mdbNext (cteMDBNode cte) \<noteq> t + 2*2^cte_level_bits"
+    by (fastforce simp: mdb_next_rel_def mdb_next_def
+                       valid_mdb'_def
+                 dest: valid_mdb_no_loops no_loops_direct_simp)
+
+  from invs cte have
+    "mdbNext (cteMDBNode cte) \<noteq> nullPointer \<longrightarrow>
+     (\<exists>cte'. ctes_of s' (mdbNext (cteMDBNode cte)) = Some cte')"
+    by (fastforce simp: valid_mdb'_def valid_mdb_ctes_def nullPointer_def
+                 elim: valid_dlistEn)
+  hence
+    "mdbNext (cteMDBNode cte) \<noteq> nullPointer \<longrightarrow>
+     mdbNext (cteMDBNode cte) = t + 2*2^cte_level_bits"
+    using class_link class_unique
+    by clarsimp
+  thus ?thesis
+    by (simp add: no_loop)
+qed
+
+lemma reply_descendants_mdbNext_nonnull:
+  assumes descs: "descendants_of (t, tcb_cnode_index 2) (cdt s) \<noteq> {}"
+  and        sr: "(s, s') \<in> state_relation"
+  and       tcb: "st_tcb_at (Not \<circ> halted) t s"
+  and       cte: "ctes_of s' (t + 2*2^cte_level_bits) = Some cte"
+  shows          "mdbNext (cteMDBNode cte) \<noteq> nullPointer"
+proof -
+  from tcb have "cte_at (t, tcb_cnode_index 2) s"
+    by (simp add: st_tcb_at_tcb_at tcb_at_cte_at dom_tcb_cap_cases)
+  hence "descendants_of' (t + 2*2^cte_level_bits) (ctes_of s') \<noteq> {}"
+    using sr descs
+    by (fastforce simp: state_relation_def cdt_relation_def cte_map_def tcb_cnode_index_def)
+  thus ?thesis
+    using cte unfolding nullPointer_def
+    by (fastforce simp: descendants_of'_def dest: subtree_next_0)
+qed
+
+lemma reply_descendants_of_mdbNext:
+  "\<lbrakk> (s, s') \<in> state_relation; valid_reply_caps s; valid_reply_masters s;
+     valid_objs s; valid_mdb s; valid_mdb' s'; pspace_aligned' s';
+     pspace_distinct' s'; st_tcb_at (Not \<circ> halted) t s;
+     ctes_of s' (t + 2*2^cte_level_bits) = Some cte \<rbrakk> \<Longrightarrow>
+   (descendants_of (t, tcb_cnode_index 2) (cdt s) = {}) =
+       (mdbNext (cteMDBNode cte) = nullPointer)"
+  apply (case_tac "descendants_of (t, tcb_cnode_index 2) (cdt s) = {}")
+   apply (simp add: reply_no_descendants_mdbNext_null)
+  apply (simp add: reply_descendants_mdbNext_nonnull)
+  done
 
 lemma reply_mdbNext_is_descendantD:
   assumes sr: "(s, s') \<in> state_relation"
@@ -465,1275 +501,132 @@ end
 
 locale delete_one_conc = delete_one_conc_pre +
   assumes delete_one_invs:
-    "\<And>p. \<lbrace>invs' and sch_act_simple\<rbrace> cteDeleteOne p \<lbrace>\<lambda>rv. invs'\<rbrace>"
+    "\<And>p. \<lbrace>invs'\<rbrace> cteDeleteOne p \<lbrace>\<lambda>rv. invs'\<rbrace>"
 
 locale delete_one = delete_one_conc + delete_one_abs +
   assumes delete_one_corres:
-    "corres dc
-          (einvs and simple_sched_action and cte_wp_at can_fast_finalise ptr
-           and current_time_bounded)
-          (invs' and cte_at' (cte_map ptr))
+    "corres dc (einvs and cte_wp_at can_fast_finalise ptr)
+               (invs' and cte_at' (cte_map ptr))
           (cap_delete_one ptr) (cteDeleteOne (cte_map ptr))"
 
-lemma gbep_ret':
-  "\<lbrakk> st = BlockedOnReceive epPtr r d \<or> st = BlockedOnSend epPtr p1 p2 p3 p4 \<rbrakk>
-      \<Longrightarrow> getBlockingObject st = return epPtr"
-  by (auto simp add: getBlockingObject_def epBlocked_def assert_opt_def)
-
-lemma replySC_None_not_head:
-  "replySC reply = None \<longleftrightarrow> \<not> isHead (replyNext reply)"
-  by (fastforce simp: isHead_def getHeadScPtr_def split: reply_next.split_asm option.split_asm)
-
-lemma sr_inv_sc_with_reply_None_helper:
-  "\<not> isHead (replyNext reply') \<Longrightarrow>
-   sr_inv
-     (valid_objs and pspace_aligned and pspace_distinct and valid_replies and
-      st_tcb_at ((=) (Structures_A.thread_state.BlockedOnReply rp)) t and
-      (\<lambda>s. sym_refs (state_refs_of s)) and (\<lambda>s. sc_with_reply rp s = None) and reply_at rp)
-     (valid_objs' and valid_release_queue_iff and
-      (\<lambda>s'. sym_refs (list_refs_of_replies' s')) and
-      (\<lambda>s. sym_refs (state_refs_of' s)) and ko_at' reply' rp and
-      ((\<lambda>s'. sc_with_reply' rp s' = None) and pspace_aligned' and pspace_distinct' and pspace_bounded'))
-     (do y <-
-         do y <-
-            when (\<exists>y. replyNext reply' = Some y)
-             (updateReply (theReplyNextPtr (replyNext reply'))
-               (replyPrev_update Map.empty));
-            when (\<exists>y. replyPrev reply' = Some y)
-             (updateReply (the (replyPrev reply'))
-               (replyNext_update Map.empty))
-         od;
-         cleanReply rp
-      od)"
-  apply (case_tac "replyNext reply'"; simp add: getHeadScPtr_def isHead_def split: reply_next.splits )
-   (* replyNext reply' = None *)
-   apply (case_tac "replyPrev reply'"; simp)
-    (* replyNext reply' = None & replyPrev reply' = None *)
-    apply (rule sr_inv_imp)
-      apply (rule cleanReply_sr_inv[where P=\<top> and P'=\<top>])
-     apply simp
-    apply simp
-   (* replyNext reply' = None & replyPrev reply' = Some prv_rp *)
-   apply (rename_tac prv_rp)
-   apply (rule sr_inv_bind)
-     apply (rule sr_inv_imp)
-       apply (rule cleanReply_sr_inv[where P=\<top> and P'="valid_objs' and valid_release_queue_iff
-                                                        and reply_at' rp"])
-      apply simp
-     apply simp
-    apply (rule updateReply_sr_inv)
-     apply (fastforce simp: reply_relation_def opt_map_red obj_at'_def projectKOs
-                     dest!: sym_refs_replyNext_replyPrev_sym[where rp'=rp, THEN iffD2])
-    apply clarsimp
-    apply (frule_tac rp=prv_rp in sc_replies_relation_sc_with_reply_None)
-        apply simp
-       apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-      apply (erule (7) sc_with_reply_replyPrev_None)
-       apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)+
-    apply (fastforce simp: projectKO_opt_sc obj_at'_def opt_map_red projectKOs)
-   apply (wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def obj_at'_def)
-  (* replyNext reply' = Some nxt_rp *)
-  apply (rename_tac nxt_rp)
-  apply (case_tac "replyPrev reply'"; simp)
-   (* replyNext reply' = Some nxt_rp & replyPrev reply' = None *)
-   apply (rule sr_inv_bind)
-     apply (rule sr_inv_imp)
-       apply (rule cleanReply_sr_inv[where P=\<top> and P'="valid_objs' and valid_release_queue_iff
-                                                        and reply_at' rp"])
-      apply simp
-     apply simp
-    apply (rule updateReply_sr_inv)
-     apply (clarsimp simp: reply_relation_def)
-    apply (clarsimp simp: projectKO_opt_sc obj_at'_def opt_map_red projectKOs sc_replies_relation_def)
-    apply (rename_tac nreply')
-    apply (rule heap_path_heap_upd_not_in, simp)
-    apply (rename_tac scp replies)
-    apply (drule_tac x=scp and y=replies in spec2, simp)
-    apply (prop_tac "rp \<notin> set replies")
-     apply (drule_tac sc=scp in valid_replies_sc_with_reply_None, simp)
-     apply (clarsimp simp: sc_replies_sc_at_def obj_at_def is_reply sc_replies_of_scs_def
-                           scs_of_kh_def map_project_def
-                    elim!: opt_mapE)
-    apply (erule (1) heap_ls_prev_not_in)
-    apply (fastforce elim!: sym_refs_replyNext_replyPrev_sym[THEN iffD1] simp: opt_map_red)
-   apply (wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def obj_at'_def)
-  (* replyNext reply' = Some nxt_rp & replyPrev reply' = Some prv_rp *)
-  apply (rename_tac prv_rp)
-  apply (rule_tac Q="valid_objs and pspace_aligned and pspace_distinct and valid_replies
-                     and (\<lambda>s. sym_refs (state_refs_of s))
-                     and (\<lambda>s. sc_with_reply rp s = None)
-                     and (\<lambda>s. sc_with_reply prv_rp s = None)
-                     and (\<lambda>s. sc_with_reply nxt_rp s = None)
-                     and reply_at rp"
-             and Q'="valid_objs' and valid_release_queue_iff and reply_at' rp
-                     and pspace_aligned' and pspace_distinct'
-                     and reply_at' prv_rp and reply_at' nxt_rp
-                     and (\<lambda>s'. sc_with_reply' rp s' = None)
-                     and (\<lambda>s'. sc_with_reply' prv_rp s' = None)
-                     and (\<lambda>s'. sc_with_reply' nxt_rp s' = None)
-                     and (\<lambda>s'. sym_refs (state_refs_of' s'))
-                     and (\<lambda>s'. replyPrevs_of s' nxt_rp = Some rp)
-                     and (\<lambda>s'. replyNexts_of s' prv_rp = Some rp)"
-         in sr_inv_stronger_imp)
-    apply (rule sr_inv_bind)
-      apply (rule sr_inv_imp)
-        apply (rule cleanReply_sr_inv[where P=\<top> and P'="valid_objs' and valid_release_queue_iff
-                                                        and reply_at' rp"])
-       apply simp
-      apply simp
-     apply (rule sr_inv_bind)
-       apply (rule sr_inv_imp)
-         apply (rule updateReply_sr_inv_next[simplified])
-        apply simp
-       apply simp
-      apply (rule sr_inv_imp)
-        apply (rule updateReply_sr_inv_prev[simplified])
-       apply simp+
-     apply wpsimp
-    apply (wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def)
-  apply clarsimp
-   apply (rule  conjI)
-    apply (fastforce simp: obj_at'_def projectKOs opt_map_red
-                    elim!: state_relationE sc_with_reply_replyPrev_None sc_with_reply_replyNext_None)
-   apply (fastforce simp: obj_at'_def projectKOs opt_map_red
-                   elim!: state_relationE sc_with_reply_replyNext_None)
-  apply (prop_tac"sc_with_reply prv_rp s = None \<and> sc_with_reply nxt_rp s = None")
-   apply (rule conjI)
-    apply (fastforce simp: obj_at'_def projectKOs opt_map_red
-                    elim!: state_relationE sc_with_reply_replyPrev_None sc_with_reply_replyNext_None)
-   apply (fastforce simp: obj_at'_def projectKOs opt_map_red
-                   elim!: state_relationE sc_with_reply_replyNext_None)
-  apply (erule state_relationE)
-  apply (clarsimp simp: sc_replies_relation_sc_with_reply_cross_eq)
-  apply (rule conjI)
-   apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (frule (1) reply_ko_at_valid_objs_valid_reply')
-  apply (clarsimp simp: valid_reply'_def valid_bound_obj'_def)
-  apply (fastforce simp: obj_at'_def projectKOs opt_map_red
-                  elim!: sym_refs_replyNext_replyPrev_sym[THEN iffD1]
-                         sym_refs_replyNext_replyPrev_sym[THEN iffD2])
-  done
-
-lemma no_fail_sc_wtih_reply_None_helper:
-  "\<not> isHead (replyNext reply') \<Longrightarrow>
-   no_fail
-     (\<lambda>s'. (s, s') \<in> state_relation \<and>
-           (valid_objs' and valid_release_queue_iff and
-            (\<lambda>s'. sym_refs (list_refs_of_replies' s')) and
-            (\<lambda>s. sym_refs (state_refs_of' s)) and
-            ko_at' reply' rp and
-            ((\<lambda>s'. sc_with_reply' rp s' = None) and
-             pspace_aligned' and pspace_distinct' and pspace_bounded'))
-            s')
-     (do y <-
-         do y <-
-            when (\<exists>y. replyNext reply' = Some y)
-             (updateReply (theReplyNextPtr (replyNext reply'))
-               (replyPrev_update Map.empty));
-            when (\<exists>y. replyPrev reply' = Some y)
-             (updateReply (the (replyPrev reply'))
-               (replyNext_update Map.empty))
-         od;
-         cleanReply rp
-      od)"
-  apply (case_tac "replyNext reply'"; simp split del: if_split)
-   apply wpsimp
-   apply (frule (1) reply_ko_at_valid_objs_valid_reply')
-   apply (clarsimp simp: obj_at'_def projectKOs valid_reply'_def)
-  apply (rename_tac nextr; case_tac nextr; simp add: isHead_def)
-  apply (case_tac "replyPrev reply'"; simp)
-   apply (wpsimp;
-          frule (1) reply_ko_at_valid_objs_valid_reply';
-          clarsimp simp: obj_at'_def projectKOs valid_reply'_def)+
-  done
-
-lemma replyRemoveTCB_corres:
-  "corres dc (valid_objs and pspace_aligned and pspace_distinct and valid_replies
-              and st_tcb_at ((=) (Structures_A.thread_state.BlockedOnReply rp)) t and (\<lambda>s. sym_refs (state_refs_of s)))
-             (valid_objs' and valid_release_queue_iff and (\<lambda>s'. sym_refs (list_refs_of_replies' s')))
-                (reply_remove_tcb t rp) (replyRemoveTCB t)"
-  (is "corres _ ?abs_guard ?conc_guard _ _")
-  apply add_sym_refs
-  apply (rule_tac Q="st_tcb_at' ((=) (thread_state.BlockedOnReply (Some rp))) t" in corres_cross_add_guard)
-   apply (fastforce dest!: st_tcb_at_coerce_concrete elim!: pred_tcb'_weakenE)
-  apply (clarsimp simp: reply_remove_tcb_def replyRemoveTCB_def isReply_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getThreadState_corres])
-      apply (rule corres_assert_gen_asm_l)
-      apply (rule corres_assert_gen_asm2)
-      apply (rule corres_assert_opt_assume)
-       apply (case_tac state; simp)
-       apply (drule sym[of rp], simp)
-       apply (rule_tac P'="?conc_guard and (\<lambda>s'. sym_refs (state_refs_of' s')) and reply_at' rp"
-                   and P="?abs_guard" in corres_symb_exec_r)
-                 (* get sc_with_reply *)
-          apply (rule corres_symb_exec_l)
-             apply (rename_tac reply' sc_opt)
-             apply (rule_tac P="?abs_guard and (\<lambda>s. sc_with_reply rp s = sc_opt) and reply_at rp"
-                         and P'="?conc_guard and (\<lambda>s. sym_refs (state_refs_of' s)) and ko_at' reply' rp"
-                    in corres_inst)
-             apply (rule_tac Q="(\<lambda>s'. sc_with_reply' rp s' = sc_opt) and pspace_aligned'
-                                      and pspace_distinct' and pspace_bounded'"
-                    in corres_cross_add_guard)
-              apply (frule pspace_relation_pspace_bounded'[OF state_relation_pspace_relation])
-              apply (fastforce simp: sc_replies_relation_sc_with_reply_cross_eq
-                              dest!: state_relationD pspace_distinct_cross dest: pspace_aligned_cross)
-             apply (case_tac sc_opt; simp split del: if_split add: bind_assoc)
-
-              (** sc_with_reply rp s = None **)
-              apply (rule_tac F="replySC reply' = None" in corres_req)
-               apply (fastforce dest!: sc_with_reply_None_reply_sc_reply_at dest: replySCs_of_cross
-                                 simp: obj_at'_def projectKOs opt_map_red)
-              apply (clarsimp simp: replySC_None_not_head)
-  subgoal for reply'
-    apply (simp only: bind_assoc[symmetric])
-    apply (rule corres_symb_exec_r_sr)
-       apply (rule corres_guard_imp)
-         apply (rule replyUnlinkTcb_corres[simplified dc_def])
-        apply (clarsimp dest!: valid_objs_valid_tcbs)
-        apply (frule (1) st_tcb_reply_state_refs)
-        apply (clarsimp simp: pred_tcb_at_def obj_at_def is_tcb is_reply reply_tcb_reply_at_def)
-       apply simp
-      apply (erule sr_inv_sc_with_reply_None_helper)
-     apply (wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def obj_at'_def)
-     apply (fastforce elim!: reply_ko_at_valid_objs_valid_reply')
-    apply (erule no_fail_sc_wtih_reply_None_helper)
-    done
-
-            (** sc_with_reply \<noteq> None : rp is in a reply stack **)
-             apply (rename_tac scp)
-             apply (rule_tac F="replyNext reply' \<noteq> None" in corres_req)
-              apply clarsimp
-              apply (prop_tac "sc_at scp s")
-               apply (fastforce dest!: sc_with_reply_SomeD1
-                                 simp: sc_replies_sc_at_def obj_at_def is_sc_obj_def
-                                 elim: valid_sched_context_size_objsI)
-              apply (prop_tac "sc_at' scp s'")
-               apply (fastforce dest!: state_relationD sc_at_cross)
-              apply (drule sc_with_reply'_SomeD, clarsimp)
-              apply (case_tac "hd xs = rp")
-               apply (drule heap_path_head, clarsimp)
-               apply (drule (3) sym_refs_scReplies)
-               apply (clarsimp simp: obj_at'_def projectKOs sym_heap_def elim!: opt_mapE)
-
-              apply (frule (1) heap_path_takeWhile_lookup_next)
-              apply (frule heap_path_head, clarsimp)
-              apply (prop_tac "takeWhile ((\<noteq>) rp) xs = hd xs # tl (takeWhile ((\<noteq>) rp) xs)")
-               apply (case_tac xs; simp)
-              apply (simp del: heap_path.simps)
-              apply (drule_tac p1="hd xs" and ps1="tl (takeWhile ((\<noteq>) rp) xs)"
-                     in sym_refs_reply_heap_path_doubly_linked_Nexts_rev[where p'=rp, THEN iffD1])
-               apply clarsimp
-              apply (case_tac "rev (tl (takeWhile ((\<noteq>) rp) xs))";
-                     clarsimp simp: obj_at'_def projectKOs elim!: opt_mapE)
-             apply (clarsimp simp: liftM_def bind_assoc split del: if_split)
-             apply (rename_tac next_reply)
-             apply (rule_tac Q="\<lambda>x. ?abs_guard
-                                and (\<lambda>s. \<exists>n. kheap s scp = Some (Structures_A.SchedContext x n))
-                                and (\<lambda>s. sc_with_reply rp s = Some scp)
-                                and  K (rp \<in> set (sc_replies x))"
-                    in corres_symb_exec_l)
-                apply (rename_tac sc)
-                apply (rule_tac Q="(\<lambda>s'. scReplies_of s' scp = hd_opt (sc_replies sc)) and sc_at' scp"
-                       in corres_cross_add_guard)
-                 apply (clarsimp; rule conjI)
-                  apply (frule state_relation_sc_replies_relation)
-                  apply (frule sc_replies_relation_scReplies_of[symmetric])
-                    apply (fastforce dest!: sc_at_cross valid_objs_valid_sched_context_size
-                                      simp: obj_at_def is_sc_obj_def obj_at'_def)
-                   apply (fastforce dest!: sc_at_cross valid_objs_valid_sched_context_size
-                                     simp: obj_at_def is_sc_obj_def state_relation_def obj_at'_def
-                                           projectKOs opt_map_def)
-                  apply (clarsimp simp: sc_replies_of_scs_def map_project_def opt_map_def
-                                        scs_of_kh_def)
-                 apply (fastforce dest!: state_relation_pspace_relation sc_at_cross
-                                         valid_objs_valid_sched_context_size
-                                   simp: obj_at_def is_sc_obj)
-                apply (rule corres_gen_asm')
-                apply (rule corres_symb_exec_l)
-                   apply (rename_tac replysc)
-                   apply (rule_tac P="?abs_guard and (\<lambda>s. sc_with_reply rp s = Some scp)
-                                      and obj_at (\<lambda>ko. \<exists>n. ko = Structures_A.SchedContext sc n) scp
-                                      and reply_sc_reply_at ((=) replysc) rp"
-                          in corres_inst)
-                   apply (rename_tac replysc)
-                   apply (rule_tac F="replySC reply' = replysc" in corres_req)
-               apply (fastforce dest!: replySCs_of_cross simp: obj_at'_def projectKOs opt_map_red)
-                   apply (case_tac "hd (sc_replies sc) = rp"; simp split del: if_split)
-
-                   (* hd (sc_replies sc) = rp & replysc = Some scp: rp is at the head of the queue *)
-                   (* i.e. replyNext reply'  *)
-                    apply (rule corres_guard_imp)
-                      apply (rule corres_assert_gen_asm_l2)
-                      apply (simp add: getHeadScPtr_def isHead_def neq_conv[symmetric] split: reply_next.splits)
-                      apply (rule corres_split[OF setSchedContext_scReply_update_None_corres[simplified dc_def]])
-                         apply (rule_tac Q =\<top> and
-                                         P'="valid_objs' and valid_release_queue_iff and ko_at' reply' rp" and
-                                         Q'="(\<lambda>s'. \<forall>prp. replyPrev reply' = Some prp
-                                                         \<longrightarrow> replyNexts_of s' prp = Some rp)"
-                             in corres_inst_add)
-                         apply (rule corres_symb_exec_r_sr)
-                            apply (rule corres_guard_imp)
-                             apply (rule corres_split[OF cleanReply_sc_with_reply_None_corres])
-                                apply (rule replyUnlinkTcb_corres[simplified dc_def])
-                               apply wpsimp
-                              apply wpsimp
-                             apply simp
-                            apply simp
-                           apply (clarsimp cong: conj_cong)
-                           apply (case_tac "replyPrev reply'"; simp)
-                           apply (rename_tac prev_rp)
-                           apply (rule sr_inv_imp)
-                             apply (rule_tac P =\<top> and
-                                             P'=" (\<lambda>s'. \<forall>prp. replyPrev reply' = Some prp
-                                                              \<longrightarrow> replyNexts_of s' prev_rp = Some rp)"
-                                          in updateReply_sr_inv)
-                              apply (clarsimp simp: reply_relation_def projectKOs obj_at'_def obj_at_def
-                                             elim!: opt_mapE)
-                             apply clarsimp
-                             apply (drule_tac rp=prev_rp in sc_replies_relation_replyNext_update, simp)
-                             apply simp
-                            apply simp
-                           apply clarsimp
-                          apply wpsimp
-                         apply wpsimp
-                         apply (clarsimp dest!: reply_ko_at_valid_objs_valid_reply' simp: valid_reply'_def)
-                        apply simp
-                       apply (wpsimp wp: sc_replies_update_takeWhile_sc_with_reply
-                                         sc_replies_update_takeWhile_valid_replies)
-                      apply (wpsimp wp: scReply_update_empty_sc_with_reply')
-                     apply clarsimp
-                     apply (frule_tac reply_ptr=rp and sc_ptr= scp and list="tl (sc_replies sc)"
-                            in sym_refs_reply_sc_reply_at)
-                      apply (clarsimp simp: sc_replies_sc_at_def obj_at_def is_reply)
-                      apply (metis list.sel(1) list.sel(3) list.set_cases)
-                     apply (clarsimp simp: getHeadScPtr_def reply_sc_reply_at_def obj_at_def is_reply
-                                    split: reply_next.splits)
-                     apply (frule (1) st_tcb_reply_state_refs)
-                     apply (clarsimp dest!: valid_objs_valid_tcbs
-                                      simp: obj_at_def is_reply reply_tcb_reply_at_def)
-                     apply (clarsimp simp: opt_map_red opt_map_def split: option.splits)
-                     apply (rule context_conjI; clarsimp simp: vs_heap_simps obj_at_def)
-                     apply (intro conjI)
-                      apply (metis list.sel(1) list.set_cases)
-                     apply (clarsimp simp: pred_tcb_at_def obj_at_def)
-                    apply clarsimp
-                    apply (rule conjI)
-                     apply (clarsimp dest!: sc_ko_at_valid_objs_valid_sc'
-                                      simp: valid_sched_context'_def valid_sched_context_size'_def
-                                            objBits_simps)
-                     apply (erule sym_refs_replyNext_replyPrev_sym[THEN iffD2])
-                     apply (clarsimp simp: opt_map_red obj_at'_def projectKOs)
-                    apply (frule (3) sym_refs_scReplies)
-                    apply (clarsimp simp: hd_opt_def projectKOs opt_map_red sym_heap_def
-                                   split: list.split_asm)
-                    apply (clarsimp simp: opt_map_red obj_at'_def projectKOs split: reply_next.splits)
-
-                  (* rp is in the middle of the reply stack *)
-                  (* hd (sc_replies sc) \<noteq> rp & rp \<in> set (sc_replies sc) *)
-                   apply (rule corres_guard_imp)
-                     apply (rule_tac Q="valid_objs' and valid_release_queue_iff and ko_at' reply' rp
-                                        and (\<lambda>s'. sym_refs (list_refs_of_replies' s')) and sc_at' scp
-                                        and (\<lambda>s'. sym_refs (state_refs_of' s'))
-                                        and (\<lambda>s'. sc_with_reply' rp s' = Some scp)
-                                        and (\<lambda>s'. scReplies_of s' scp = hd_opt (sc_replies sc))
-                                        and (\<lambda>s'. \<forall>prp. replyPrev reply' = Some prp
-                                                        \<longrightarrow> replyNexts_of s' prp = Some rp)"
-                            in corres_assert_gen_asm_l)
-                     apply (simp split del: if_split)
-                     apply (clarsimp simp: getHeadScPtr_def isHead_def neq_conv[symmetric]
-                                    split: reply_next.splits)
-                     apply (rename_tac nxt_rp)
-                     apply (rule stronger_corres_guard_imp)
-                       apply (rule corres_split
-                                     [OF updateReply_replyPrev_takeWhile_middle_corres])
-                           apply simp
-                          apply simp
-                         apply (rule_tac P ="?abs_guard and reply_sc_reply_at ((=) None) rp" and
-                                         Q ="\<lambda>s. sc_with_reply rp s = None" and
-                                         P'="valid_objs' and valid_release_queue_iff
-                                             and ko_at' reply' rp and sc_at' scp" and
-                                         Q'="(\<lambda>s'. \<forall>prp. replyPrev reply' = Some prp
-                                                         \<longrightarrow> replyNexts_of s' prp = Some rp)"
-                               in corres_inst_add)
-                         apply (rule corres_symb_exec_r_sr)
-                            apply (rule corres_guard_imp)
-                              apply (rule corres_split[OF cleanReply_sc_with_reply_None_corres])
-                                apply (rule replyUnlinkTcb_corres[simplified dc_def])
-                               apply wpsimp
-                              apply wpsimp
-                             apply clarsimp
-                             apply (frule (1) st_tcb_reply_state_refs, frule valid_objs_valid_tcbs)
-                             apply (fastforce simp: obj_at_def is_reply reply_tcb_reply_at_def pred_tcb_at_def)
-                            apply simp
-                           apply (clarsimp cong: conj_cong)
-                           apply (case_tac "replyPrev reply'"; simp)
-                           apply (rename_tac prev_rp)
-                           apply (rule sr_inv_imp)
-                             apply (rule_tac P =\<top> and
-                                             P'=" (\<lambda>s'. \<forall>prp. replyPrev reply' = Some prp
-                                                              \<longrightarrow> replyNexts_of s' prev_rp = Some rp)"
-                                    in updateReply_sr_inv)
-                              apply (clarsimp simp: reply_relation_def projectKOs obj_at'_def obj_at_def
-                                             elim!: opt_mapE)
-                             apply clarsimp
-                             apply (drule_tac rp=prev_rp in sc_replies_relation_replyNext_update, simp)
-                             apply simp
-                            apply simp
-                           apply clarsimp
-                          apply wpsimp
-                         apply wpsimp
-                         apply (clarsimp dest!: reply_ko_at_valid_objs_valid_reply'
-                                          simp: valid_reply'_def)
-                        apply (wpsimp wp: sc_replies_update_takeWhile_sc_with_reply
-                                          sc_replies_update_takeWhile_middle_sym_refs
-                                          sc_replies_update_takeWhile_valid_replies)
-                       apply (wpsimp wp: updateReply_valid_objs' updateReply_ko_at'_other)
-                      apply (clarsimp cong: conj_cong)
-                      apply simp
-                     apply (clarsimp simp: valid_reply'_def)
-                     apply (rule context_conjI)
-                      apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-                     apply (clarsimp simp: obj_at_def del: opt_mapE)
-                     apply (frule (1) valid_sched_context_objsI)
-                     apply (clarsimp simp: valid_sched_context_def del: opt_mapE)
-                     apply (frule (4) next_reply_in_sc_replies[OF state_relation_sc_replies_relation])
-                        apply (fastforce dest!: state_relationD pspace_aligned_cross pspace_distinct_cross)
-                       apply (fastforce dest!: state_relationD pspace_distinct_cross)
-                      apply (fastforce dest!: state_relationD pspace_relation_pspace_bounded')
-                     apply (clarsimp simp: obj_at'_def)
-                     apply (clarsimp simp: vs_heap_simps)
-                    apply clarsimp
-                    apply (rule conjI)
-                     apply (clarsimp simp: list_all_iff dest!: set_takeWhileD)
-                    apply (drule (2) sc_replies_middle_reply_sc_None)
-                       apply (clarsimp simp: vs_heap_simps obj_at_def elim!: opt_mapE)
-                      apply (fastforce simp: obj_at_def is_sc_obj_def elim!: valid_sched_context_size_objsI)
-                     apply (erule reply_sc_reply_at)
-                    apply (clarsimp simp: reply_sc_reply_at_def obj_at_def)
-                   apply (fastforce elim!: sym_refs_replyNext_replyPrev_sym[THEN iffD2]
-                                     simp: opt_map_red obj_at'_def projectKOs)
-                  apply (wpsimp simp: get_sk_obj_ref_def wp: get_reply_exs_valid)
-                   apply (fastforce dest!: Reply_or_Receive_reply_at[rotated] simp: obj_at_def is_reply)
-                  apply simp
-                 apply (wpsimp wp: get_sk_obj_ref_wp)
-                 apply (clarsimp simp: obj_at_def reply_sc_reply_at_def)
-                apply (wpsimp simp: get_sk_obj_ref_def get_simple_ko_def obj_at_def
-                                wp: get_object_wp)
-                apply (prop_tac "reply_at rp s")
-                 apply (fastforce dest!: st_tcb_at_valid_st2 simp: valid_tcb_state_def)
-                apply (fastforce simp: obj_at_def is_reply partial_inv_def a_type_def)
-               apply (wpsimp wp: get_sched_context_exs_valid)
-                apply (drule sc_with_reply_SomeD)
-                apply (wpsimp simp: is_sc_obj_def
-                       | clarsimp split: Structures_A.kernel_object.splits)+
-              apply (fastforce dest!: sc_with_reply_SomeD1 simp: sc_replies_sc_at_def obj_at_def)
-             apply (wpsimp wp: get_sched_context_no_fail)
-             apply (fastforce dest!: sc_with_reply_SomeD elim!: valid_sched_context_size_objsI
-                               simp: obj_at_def is_sc_obj_def)
-            apply wpsimp
-           apply wpsimp
-           apply (fastforce dest!: st_tcb_at_valid_st2 simp: valid_tcb_state_def)
-          apply wpsimp
-         apply (wpsimp wp: get_reply_inv' wp_del: getReply_wp)
-          apply (wpsimp simp: getReply_def)
-         apply clarsimp
-        apply wpsimp
-       apply wpsimp
-      apply clarsimp
-     apply (wpsimp wp: gts_wp)
-    apply wpsimp
-   apply (clarsimp simp: st_tcb_at_tcb_at pred_tcb_at_def obj_at_def is_tcb)
-  apply clarsimp
-  apply (rule context_conjI; clarsimp)
-  apply (prop_tac "reply_at' rp s")
-   apply (fastforce dest: tcb_in_valid_state' simp: valid_tcb_state'_def)
-  apply (clarsimp, rule conjI)
-  using fold_list_refs_of_replies' apply metis
-  apply (clarsimp simp: st_tcb_at'_def obj_at'_def projectKOs)
-  apply (rename_tac tcb reply)
-  apply (case_tac "tcbState tcb"; simp)
-  done
-
-lemma setSchedContext_pop_head_corres:
-  "\<lbrakk> replyNext reply' = Some (Head ptr)  \<rbrakk> \<Longrightarrow>
-   corres dc
-          ((\<lambda>s. (sc_replies_of s |> hd_opt) ptr = Some rp)
-                and valid_objs and pspace_aligned and pspace_distinct)
-          (ko_at' reply' rp)
-          (update_sched_context ptr (sc_replies_update tl))
-          (do sc' \<leftarrow> getSchedContext ptr;
-              setSchedContext ptr (scReply_update (\<lambda>_. replyPrev reply') sc')
-           od)"
-  supply opt_mapE[elim!]
-  apply (rule_tac Q="sc_at' ptr" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD simp: obj_at_def is_sc_obj_def vs_heap_simps
-                    elim!: sc_at_cross valid_objs_valid_sched_context_size)
-  apply (rule_tac Q="pspace_aligned' and pspace_distinct'" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD elim!: pspace_aligned_cross pspace_distinct_cross)
-  apply (rule_tac Q="\<lambda>s'. scReplies_of s' ptr = Some rp" in corres_cross_add_guard)
-   apply (subst sc_replies_relation_scReplies_of[symmetric, OF state_relation_sc_replies_relation])
-      apply simp
-     apply clarsimp
-     apply (fastforce simp: opt_map_red dest!: sc_at'_cross[OF state_relation_pspace_relation])
-    apply (clarsimp simp: opt_map_red obj_at_simps)+
-  apply (rule corres_symb_exec_r)
-     apply (rule_tac P'="ko_at' sc' ptr and ko_at' reply' rp
-                         and pspace_aligned' and pspace_distinct' and  K (scReply sc' = Some rp)" in corres_inst)
-     apply (rule corres_gen_asm2')
-     apply (rule_tac Q="sc_obj_at (objBits sc' - minSchedContextBits) ptr" in corres_cross_add_abs_guard)
-      apply (fastforce dest!: state_relationD ko_at_sc_cross)
+lemma (in delete_one) cancelIPC_ReplyCap_corres:
+  "corres dc (einvs  and st_tcb_at awaiting_reply t)
+             (invs' and st_tcb_at' awaiting_reply' t)
+      (reply_cancel_ipc t)
+      (do y \<leftarrow> threadSet (\<lambda>tcb. tcb \<lparr> tcbFault := None \<rparr>) t;
+          slot \<leftarrow> getThreadReplySlot t;
+          callerCap \<leftarrow> liftM (mdbNext \<circ> cteMDBNode) (getCTE slot);
+          when (callerCap \<noteq> nullPointer) (do
+              y \<leftarrow> stateAssert (capHasProperty callerCap (\<lambda>cap. isReplyCap cap
+                                                             \<and> \<not> capReplyMaster cap))
+                  [];
+              cteDeleteOne callerCap
+          od)
+       od)"
+  proof -
+  interpret Arch . (*FIXME: arch-split*)
+  show ?thesis
+  apply (simp add: reply_cancel_ipc_def getThreadReplySlot_def
+                   locateSlot_conv liftM_def tcbReplySlot_def
+              del: split_paired_Ex)
+  apply (rule_tac Q="\<lambda>_. invs and valid_list and valid_sched and st_tcb_at awaiting_reply t"
+              and Q'="\<lambda>_. invs' and st_tcb_at' awaiting_reply' t"
+               in corres_underlying_split)
      apply (rule corres_guard_imp)
-       apply (rule_tac P="(\<lambda>s. (sc_replies_of s |> hd_opt) ptr = Some rp)
-                          and sc_obj_at (objBits sc' - minSchedContextBits) ptr"
-                  and n1="objBits sc' - minSchedContextBits"
-                            in monadic_rewrite_corres_l[OF update_sched_context_rewrite])
-       apply (rule corres_symb_exec_l)
-          apply (rule corres_guard_imp)
-            apply (rule_tac P="(\<lambda>s. kheap s ptr =
-                                       Some (kernel_object.SchedContext sc (objBits sc' - minSchedContextBits)))
-                               and K (rp = hd (sc_replies sc))"
-                        and P'="ko_at' sc' ptr and ko_at' reply' rp
-                               and pspace_distinct' and pspace_aligned'"  in corres_inst)
-            apply (rule corres_gen_asm')
-            apply (rule stronger_corres_guard_imp)
-              apply (rule_tac sc=sc and sc'=sc' in setSchedContext_update_corres; simp?)
-               apply (clarsimp simp: sc_relation_def objBits_simps)+
-            apply (clarsimp simp: obj_at'_def projectKOs)
-            apply (prop_tac "heap_ls (replyPrevs_of s') (Some rp) (sc_replies sc)")
-             apply (drule state_relation_sc_replies_relation)
-             apply (drule (2) sc_replies_relation_prevs_list, simp)
-            apply (case_tac "sc_replies sc"; clarsimp simp: opt_map_red)
-           apply simp
-          apply simp
-         apply (wpsimp wp: get_sched_context_exs_valid simp: is_sc_obj_def obj_at_def)
-          apply (rename_tac ko xs; case_tac ko; clarsimp)
-         apply simp
-        apply (wpsimp simp: obj_at_def is_sc_obj_def vs_heap_simps opt_pred_def)
-       apply (wpsimp wp: get_sched_context_no_fail simp: obj_at_def is_sc_obj)
-      apply (clarsimp simp: obj_at_def is_sc_obj_def)
-     apply simp
-    apply (wpsimp simp: projectKOs obj_at'_def)+
-  done
-
-lemma sched_context_donate_weak_valid_sched_action[wp]:
-  "\<lbrace>weak_valid_sched_action and bound_sc_tcb_at ((=) None) tcb_ptr\<rbrace>
-   sched_context_donate sc_ptr tcb_ptr
-   \<lbrace>\<lambda>_. weak_valid_sched_action\<rbrace>"
-  apply (wpsimp wp: set_tcb_obj_ref_wp update_sched_context_wp test_reschedule_wp
-                    tcb_sched_action_wp get_sc_obj_ref_wp
-              simp: sched_context_donate_def tcb_release_remove_def)
-  apply (frule weak_valid_sched_action_no_sc_sched_act_not)
-   apply (fastforce simp: vs_all_heap_simps tcb_at_kh_simps)
-  by (auto simp: obj_at_kh_kheap_simps vs_all_heap_simps fun_upd_def pred_map_simps tcb_sched_dequeue_def scheduler_act_not_def
-                 valid_sched_action_def weak_valid_sched_action_def opt_map_simps map_join_simps
-           cong: conj_cong)
-
-crunch sched_context_donate
-  for sc_at[wp]: "sc_at scp"
-  (simp: crunch_simps wp: crunch_wps)
-
-crunch rescheduleRequired, setQueue, tcbSchedEnqueue, tcbReleaseRemove, updateReply
-  for scReplies_of[wp]: "\<lambda>s. P' (scReplies_of s)"
-  (simp: crunch_simps wp: crunch_wps)
-
-crunch updateReply, setSchedContext, updateSchedContext
-  for tcbSCs_of[wp]: "\<lambda>s. P' (tcbSCs_of s)"
-  and list_refs_of_replies'[wp]: "\<lambda>s. P (list_refs_of_replies' s)"
-  (simp: crunch_simps opt_map_Some_eta_fold wp: crunch_wps)
-
-lemma scReplies_of_scTCB_update[simp]:
-  "\<lbrakk> ko_at' sc scp s\<rbrakk>
-   \<Longrightarrow> P (\<lambda>a. if a = scp then scReply (scTCB_update (\<lambda>_. Some tp) sc) else scReplies_of s a)
-       \<longleftrightarrow> P (scReplies_of s)"
-  by (fastforce simp: obj_at'_def projectKOs opt_map_red elim!: rsubst[where P=P])
-
-crunch schedContextDonate
-  for replies_of': "\<lambda>s. P (replies_of' s)" (* this interfers with list_refs_of_replies' *)
-  and scReplies_of[wp]: "\<lambda>s. P' (scReplies_of s)"
-  (simp: crunch_simps wp: crunch_wps)
-
-lemma updateReply_replyNext_update_None:
-  "\<lbrace> \<top> \<rbrace>
-   updateReply rp (replyNext_update Map.empty)
-   \<lbrace>\<lambda>rv s. (replies_of' s |> replyNext) rp = None \<rbrace>"
-  by (wpsimp wp: updateReply_wp_all)
-
-lemma update_sched_context_sc_replies_update_tl:
-  "\<lbrace>\<lambda>s. \<exists>x. (kheap s |> sc_of ||> sc_replies) scp = Some (x#list)\<rbrace>
-   update_sched_context scp (sc_replies_update tl)
-   \<lbrace>\<lambda>_. sc_replies_sc_at ((=) list) scp\<rbrace>"
-  apply (wpsimp wp: update_sched_context_wp)
-  apply (clarsimp simp: obj_at_def sc_replies_sc_at_def opt_map_red)
-  done
-
-lemma setSchedContext_local_sym_refs:
-  "\<lbrace>\<lambda>s. ko_at' r' rp s \<and> ko_at' sc scp s \<and> replyPrev r' \<noteq> Some rp
-        \<and> (\<forall>p'. p' \<noteq> scp \<longrightarrow> scReplies_of s p' \<noteq> Some rp)\<rbrace>
-   setSchedContext scp (scReply_update (\<lambda>_. replyPrev r') sc)
-   \<lbrace>\<lambda>rv s. \<forall>p'. scReplies_of s p' \<noteq> Some rp\<rbrace>"
-  apply (wpsimp wp: setObject_sc_wp simp: setSchedContext_def)
-  apply (clarsimp simp: obj_at'_def projectKOs opt_map_red elim!: opt_mapE split: if_split_asm)
-  apply (drule_tac x=p' in spec)
-  apply (clarsimp simp: opt_map_red)
-  done
-
-lemma replyPop_corres:
-  "\<lbrakk>st = Structures_A.thread_state.BlockedOnReply rp;
-    st' = Structures_H.thread_state.BlockedOnReply (Some rp)\<rbrakk> \<Longrightarrow>
-   corres dc
-     (valid_objs and pspace_aligned and pspace_distinct
-      and st_tcb_at ((=) st) t and weak_valid_sched_action
-      and sc_at scp and reply_at rp and active_scs_valid
-      and valid_replies and (\<lambda>s. sym_refs (state_refs_of s))
-      and bound_sc_tcb_at ((=) tcbsc) t
-      and reply_tcb_reply_at ((=) (Some t)) rp
-      and (\<lambda>s. sc_with_reply rp s = Some scp)
-      and (\<lambda>s. (sc_replies_of s |> hd_opt) scp = Some rp))
-     (valid_objs' and valid_release_queue_iff and valid_queues and valid_queues'
-      and reply_at' rp and sc_at' scp
-      and (\<lambda>s'. sym_refs (list_refs_of_replies' s')))
-     (do x <- reply_unlink_sc scp rp;
-         y <- when (tcbsc = None) (sched_context_donate scp t);
-         reply_unlink_tcb t rp
-      od)
-     (replyPop rp t)"
-  (is "\<lbrakk> _ ; _ \<rbrakk> \<Longrightarrow> corres _ (?abs_guard and valid_replies and (\<lambda>s. sym_refs (state_refs_of s))
-                              and bound_sc_tcb_at ((=) tcbsc) t and reply_tcb_reply_at ((=) (Some t)) rp
-                              and (\<lambda>s. sc_with_reply rp s = _) and ?sc_replies)
-                             (?conc_guard and (\<lambda>s'. sym_refs (list_refs_of_replies' s'))) _ _")
-  supply if_split[split del] opt_mapE[elim!]
-  apply add_sym_refs
-  apply (rule_tac Q="st_tcb_at' ((=) st') t" in corres_cross_add_guard)
-   apply (fastforce dest!: st_tcb_at_coerce_concrete elim!: pred_tcb'_weakenE)
-  apply (rule_tac Q="\<lambda>s. tcbSCs_of s t = tcbsc" in corres_cross_add_guard)
-   apply (fastforce dest!: bound_sc_tcb_at_cross elim!: obj_at'_weakenE)
-  apply (rule_tac Q="pspace_distinct'" in corres_cross_add_guard)
-   apply (fastforce dest!: pspace_distinct_cross)
-  apply (rule_tac Q="pspace_aligned'" in corres_cross_add_guard)
-   apply (fastforce dest!: pspace_aligned_cross)
-  apply (rule_tac Q="pspace_bounded'" in corres_cross_add_guard)
-   apply (fastforce dest!: pspace_relation_pspace_bounded'[OF state_relation_pspace_relation])
-  apply (rule_tac Q="\<lambda>s. scReplies_of s scp = Some rp" in corres_cross_add_guard)
-   apply (fastforce simp: opt_map_red obj_at'_def projectKOs
-                   dest!: sc_replies_relation_scReplies_of state_relation_sc_replies_relation)
-  apply (simp add: reply_unlink_sc_def replyPop_def bind_assoc liftM_def)
-  apply (rule_tac Q="\<lambda>sc. ?abs_guard and reply_tcb_reply_at ((=) (Some t)) rp
-                          and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext sc n) scp s)
-                          and bound_sc_tcb_at ((=) tcbsc) t
-                          and K (\<exists>ls. sc_replies sc = rp#ls \<and> distinct (rp#ls))"
-         in corres_symb_exec_l)
-     apply (rename_tac sc)
-     apply (rule corres_gen_asm') (* sc_replies sc = rp # ls, distinct (rp#ls) *)
-     apply (rule corres_stateAssert_add_assertion[rotated])
-      apply (clarsimp simp: sym_refs_asrt_def)
+       apply (rule threadset_corresT; simp?)
+          apply (simp add: tcb_relation_def fault_rel_optionation_def)
+         apply (simp add: tcb_cap_cases_def)
+        apply (simp add: tcb_cte_cases_def)
+       apply (simp add: exst_same_def)
+      apply (fastforce simp: st_tcb_at_tcb_at)
+     apply clarsimp
+    defer
+    apply (wp thread_set_invs_trivial thread_set_no_change_tcb_state
+              threadSet_invs_trivial threadSet_pred_tcb_no_state thread_set_not_state_valid_sched
+         | fastforce simp: tcb_cap_cases_def inQ_def
+         | wp (once) sch_act_simple_lift)+
+  apply (rule corres_underlying_split)
      apply (rule corres_guard_imp)
-       apply (rule corres_split[OF get_reply_corres])
-         apply (rename_tac r r')
-         apply (rule_tac P="?abs_guard and reply_tcb_reply_at ((=) (Some t)) rp
-                            and ko_at (Structures_A.Reply r) rp and bound_sc_tcb_at ((=) tcbsc) t
-                            and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext sc n) scp s)"
-                     and P'="?conc_guard and (\<lambda>s'. sym_refs (list_refs_of_replies' s'))
-                            and pspace_aligned' and pspace_distinct' and pspace_bounded' and (\<lambda>s. sym_refs (state_refs_of' s))
-                            and st_tcb_at' ((=) st') t and (\<lambda>s. tcbSCs_of s t = tcbsc) and ko_at' r' rp
-                            and (\<lambda>s. scReplies_of s scp = Some rp)
-                            and K (replyTCB r' = Some t) and K (replyNext r' = Some (Head scp))"
-                in corres_inst)
-         apply (rule corres_gen_asm2') (* replyNext r' = Some (Head scp) *)
-         apply (rule corres_gen_asm2') (* replyTCB r' = Some t *)
-         apply (erule exE, rename_tac list)
-         apply (rule_tac F="case list of [] \<Rightarrow> replyPrev r' = None | a#_ \<Rightarrow> replyPrev r' = Some a"
-                in corres_req)
-          apply (clarsimp simp: obj_at_simps)
-          apply (drule (1) sc_replies_relation_prevs_list'[OF state_relation_sc_replies_relation])
-          apply (clarsimp simp: opt_map_red del: opt_mapE)
-          apply (case_tac list; simp)
-         apply (simp add: bind_assoc)
-         apply (rule corres_symb_exec_l) (* assert reply_sc r = Some scp *)
-            apply (rule corres_symb_exec_r) (* get threadState for t *)
-               apply (rename_tac state)
-               apply (rule_tac P="?abs_guard and reply_tcb_reply_at ((=) (Some t)) rp
-                                  and ko_at (Structures_A.Reply r) rp
-                                  and bound_sc_tcb_at ((=) tcbsc) t
-                                  and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext sc n) scp s)"
-                           and P'="?conc_guard and (\<lambda>s'. sym_refs (list_refs_of_replies' s'))
-                                  and pspace_aligned' and pspace_distinct' and pspace_bounded'
-                                  and (\<lambda>s. sym_refs (state_refs_of' s)) and st_tcb_at' ((=) st') t
-                                  and (\<lambda>s. tcbSCs_of s t = tcbsc)
-                                  and (\<lambda>s. scReplies_of s scp = Some rp)
-                                  and ko_at' r' rp and sc_at' scp and K (state = st')"
-                      in corres_inst)
-               apply (rule corres_gen_asm2')
-               apply (simp add: bind_assoc isReply_def isHead_def)
-               apply (subst bind_assoc[symmetric, where m="getSchedContext _"])
-               apply (rule corres_guard_imp)
-                 apply (rule corres_split[OF setSchedContext_pop_head_corres[where rp=rp]])
-                    apply simp  (* scReplies at scp = replyPrev r', tl (sc_replies sc) *)
-                   apply (rule corres_split[where r'=dc])
-                      apply (case_tac list; simp)
-                      apply (rename_tac a ls)
-                      apply (rule_tac P="?abs_guard and reply_tcb_reply_at ((=) (Some t)) rp
-                                         and sc_replies_sc_at ((=) (a#ls)) scp
-                                         and ko_at (Structures_A.Reply r) rp
-                                         and bound_sc_tcb_at ((=) tcbsc) t"
-                                  and P'="?conc_guard and (\<lambda>s'. sym_refs (list_refs_of_replies' s'))
-                                         and st_tcb_at' ((=) st') t and (\<lambda>s. tcbSCs_of s t = tcbsc)
-                                          and ko_at' r' rp and (\<lambda>s. \<forall>p'. scReplies_of s p' \<noteq> Some rp)
-                                         and (\<lambda>s. \<forall>p'. replyPrevs_of s p' \<noteq> Some rp)"
-                             in corres_inst)
-                      apply (rule stronger_corres_guard_imp)
-                        apply (rule updateReply_replyPrev_same_corres)
-                        apply (clarsimp simp: reply_relation_def)
-                       apply clarsimp
-                       apply (clarsimp simp: sc_replies_sc_at_def obj_at_def is_sc_obj)
-                       apply (erule (1) valid_objsE[where x=scp])
-                       apply (clarsimp simp: valid_obj_def valid_sched_context_def dest!: sym[of _ "sc_replies _"])
-                       apply (clarsimp simp: obj_at_def)
-                      apply clarsimp
-                      apply (erule valid_objsE'[where x=rp])
-                       apply (fastforce simp: obj_at'_def projectKOs)
-                      apply (clarsimp simp: valid_obj'_def valid_reply'_def)
-                     apply (rule corres_guard_imp)
-                       apply (rule corres_split[OF updateReply_replyNext_not_head_corres])
-                          apply (clarsimp simp: isHead_def)
-                         apply (rule_tac P="?abs_guard and reply_tcb_reply_at ((=) (Some t)) rp
-                                             and bound_sc_tcb_at ((=) tcbsc) t
-                                             and sc_replies_sc_at (\<lambda>ls. rp \<notin> set ls) scp
-                                             and reply_sc_reply_at ((=) None) rp "
-                                     and P'="?conc_guard and st_tcb_at' ((=) st') t
-                                             and (\<lambda>s. (replies_of' s |> replyNext) rp = None)
-                                             and (\<lambda>s. \<forall>p'. replyPrevs_of s p' \<noteq> Some rp)
-                                             and (\<lambda>s. \<forall>p'. scReplies_of s p' \<noteq> Some rp)
-                                             and (\<lambda>s. tcbSCs_of s t = tcbsc)"
-                                in corres_inst)
-                         apply (rule_tac Q'="\<lambda>rv. ?conc_guard and st_tcb_at' ((=) st') t
-                                                  and (\<lambda>s. (replies_of' s |> replyNext) rp = None)
-                                                  and (\<lambda>s. \<forall>p'. replyPrevs_of s p' \<noteq> Some rp)
-                                                  and (\<lambda>s. \<forall>p'. scReplies_of s p' \<noteq> Some rp)
-                                                  and (\<lambda>s. tcbSCs_of s t = rv)"
-                                in corres_symb_exec_r)
-                            apply (rename_tac tcbsc')
-                            apply (rule stronger_corres_guard_imp)
-                              apply (rule_tac Q'="K (tcbsc' = tcbsc)" in corres_inst_add)
-                              apply (rule corres_gen_asm2')
-                              apply (rule corres_split[OF corres_when2])
-                                  apply simp
-                                 apply (rule schedContextDonate_corres) (* donate *)
-                                apply (rule_tac P="?abs_guard and reply_tcb_reply_at ((=) (Some t)) rp"
-                                            and P'="valid_objs' and valid_release_queue_iff
-                                                   and st_tcb_at' ((=) st') t and reply_at' rp
-                                                   and (\<lambda>s. (replies_of' s |> replyNext) rp = None)
-                                                   and (\<lambda>s. \<forall>p'. replyPrevs_of s p' \<noteq> Some rp)
-                                                   and (\<lambda>s. \<forall>p'. scReplies_of s p' \<noteq> Some rp)"
-                                       in corres_inst)
-                                apply (rule corres_symb_exec_r_sr_strong) (* replyPrev at rp = None *)
-                                   apply (rule corres_guard_imp)
-                                     apply (rule replyUnlinkTcb_corres)
-                                    apply (clarsimp simp: valid_objs_valid_tcbs elim!: pred_tcb_weakenE)
-                                   apply simp
-                                  apply (simp add: cleanReply_def)
-                                  apply (rule_tac Q'="\<lambda>_ s. reply_at' rp s \<and> (replies_of' s |> replyNext) rp = None
-                                                            \<and> (\<forall>p'. replyPrevs_of s p' \<noteq> Some rp)
-                                                            \<and> (\<forall>p'. scReplies_of s p' \<noteq> Some rp)"
-                                         in sr_inv_ul_bind[rotated])
-                                    apply (rule updateReply_sr_inv)
-                                     apply (clarsimp simp: reply_relation_def)
-                                    apply (intro conjI impI allI)
-                                    apply (erule sc_replies_relation_replyNext_None; clarsimp)
-                                    apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-                                   apply clarsimp
-                                   apply (wpsimp wp: updateReply_wp_all)
-                                   apply (clarsimp simp: obj_at'_def projectKOs objBits_simps ps_clear_upd opt_map_red)
-                                   apply (rename_tac s s' reply' sc')
-                                   apply (intro conjI allI; clarsimp split: if_split_asm simp: projectKOs)
-                                   apply (rename_tac scp' sc'')
-                                   apply (drule_tac x=scp' in spec[where P="\<lambda>x. scReplies_of _ x \<noteq> Some rp"])
-                                   apply (clarsimp simp: opt_map_red)
-                                  apply (clarsimp simp: sr_inv_def updateReply_def)
-                                  apply (clarsimp simp: setReply_def getReply_def getObject_def
-                                                        setObject_def split_def objBits_simps'
-                                                        updateObject_default_def in_monad fail_def
-                                                        in_magnitude_check obj_at_simps return_def
-                                                        loadObject_default_def ARM_H.fromPPtr_def
-                                                 split: if_split_asm option.split_asm
-                                                 dest!: readObject_misc_ko_at')
-                                  apply (prop_tac "(ksPSpace s')(rp \<mapsto>
-                                                          KOReply (replyNext_update Map.empty reply))
-                                                   = ksPSpace s'")
-                                   apply (rule ext)
-                                   apply (clarsimp simp: opt_map_red split: if_split)
-                                   apply (case_tac reply; simp)
-                                  apply simp
-                                 apply wpsimp
-                                apply wpsimp
-                               apply wpsimp
-                              apply (rule hoare_when_cases, simp)
-                              apply (wpsimp wp: schedContextDonate_valid_objs'
-                                                schedContextDonate_replies_of' schedContextDonate_reply_projs)
-                             apply (fastforce split: if_split)
-                            apply (clarsimp simp: pred_tcb_at'_def opt_map_red obj_at_simps pred_tcb_at_def)
-                            apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation, where x=t])
-                            apply (rename_tac tcb' sc')
-                            apply (clarsimp simp: other_obj_relation_def tcb_relation_def)
-                           apply (wpsimp wp: threadGet_wp)
-                           apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-                          apply wpsimp
-                         apply wpsimp
-                        apply wpsimp
-                       apply (wpsimp wp: updateReply_valid_objs' updateReply_replyNext_update_None)
-                      apply wpsimp
-                      apply simp
-                     apply simp
-                    apply wpsimp
-                   apply (elim conjE)
-                   apply (wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def)
-                  apply (clarsimp cong: conj_cong imp_cong simp: pred_conj_def)
-                  apply (wpsimp wp: update_sched_context_sc_replies_update_tl)
-                  apply (rule_tac Q'="\<lambda>_. sc_replies_sc_at ((=) list) scp" in hoare_strengthen_post[rotated])
-                   apply (clarsimp simp: sc_replies_sc_at_def obj_at_def)
-                  apply (wpsimp wp: update_sched_context_sc_replies_update_tl)
-                 apply (fold updateSchedContext_def)
-                 apply (rule_tac Q'="\<lambda>_. valid_objs' and valid_release_queue_iff
-                                        and valid_queues and valid_queues'
-                                        and ko_at' r' rp and sc_at' scp
-                                        and (\<lambda>s. sym_refs (list_refs_of_replies' s))
-                                        and st_tcb_at' ((=) (Structures_H.thread_state.BlockedOnReply (Some rp))) t
-                                        and (\<lambda>s. \<forall>p'. scReplies_of s p' \<noteq> Some rp)
-                                        and (\<lambda>s. \<forall>p'. replyPrevs_of s p' \<noteq> Some rp)
-                                        and (\<lambda>s. tcbSCs_of s t = tcbsc)"
-                        in hoare_strengthen_post[rotated])
-                  apply (clarsimp split: if_split simp: valid_reply'_def opt_map_Some_eta_fold obj_at'_def)
-                 apply (wpsimp wp: hoare_vcg_if_lift2 hoare_drop_imp simp: valid_reply'_def)
-                 apply (rule hoare_vcg_conj_lift)
-                  apply (wpsimp wp: updateSchedContext_wp)
-                 apply wpsimp
-                 apply (rule hoare_vcg_conj_lift)
-                  apply (wpsimp wp: setSchedContext_local_sym_refs simp: updateSchedContext_def)
-                 apply wpsimp
-                apply (clarsimp simp: sc_replies_sc_at_def obj_at_def is_sc_obj opt_map_red)
-                apply (rule conjI, clarsimp simp: vs_all_heap_simps opt_map_red)
-                apply (rename_tac n sc0)
-                apply (clarsimp simp: reply_relation_def)
-                apply (erule (1) valid_objsE[where x=scp])
-                apply (clarsimp simp: valid_obj_def valid_sched_context_def obj_at_def)
-                apply (case_tac "sc_replies sc0"; simp)
-                apply (intro conjI impI allI; rename_tac ls; case_tac ls; clarsimp)
-               apply (clarsimp simp: valid_obj'_def projectKOs opt_map_red opt_map_Some_eta_fold)
-               apply (intro conjI impI)
-                   apply (fastforce simp: obj_at'_def opt_map_red opt_pred_def projectKOs
-                                          valid_sched_context'_def valid_obj'_def valid_reply'_def)
-                  apply (fold fun_upd_def)
-                  apply (clarsimp simp: obj_at'_def projectKOs opt_map_red ps_clear_upd objBits_simps
-                                 split: if_split)
-                 apply (fastforce dest!: sym_refs_replyNext_replyPrev_sym[where rp'=rp and rp=rp, THEN iffD2]
-                                   simp: obj_at_simps opt_map_red)
-                apply (clarsimp del: opt_mapE)
-                apply (drule (4) sym_refs_scReplies[simplified sym_heap_def, rule_format, THEN iffD1])
-                apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-               apply (clarsimp del: opt_mapE)
-               apply (drule (1) reply_sym_heap_Prev_Next[simplified sym_heap_def, rule_format, THEN iffD1])
-               apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-              apply wpsimp
-              apply (fastforce elim!: pred_tcb'_weakenE)
-             apply wpsimp
-            apply wpsimp
-           apply (wpsimp simp: assert_def reply_relation_def split: if_split)
-          apply wpsimp
-         apply (wpsimp simp: reply_relation_def)
-        apply wpsimp
-        apply (wpsimp wp: get_simple_ko_wp)
-       apply wpsimp
-      apply simp
-     apply (clarsimp del: opt_mapE)
-     apply (rule conjI)
-      apply (clarsimp simp: sym_refs_asrt_def pred_tcb_at'_def obj_at'_def projectKOs)
-      apply (drule sym_ref_Receive_or_Reply_replyTCB')
-        apply (fastforce simp: obj_at'_def projectKOs)
-       apply (rule disjI2, rule sym, simp)
-      apply clarsimp
-     apply (drule (4) sym_refs_scReplies[simplified sym_heap_def, rule_format, THEN iffD1])
-     apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-    apply (wpsimp wp: get_sched_context_exs_valid)
-     apply (clarsimp simp: obj_at_def is_sc_obj)
-    apply simp
-   apply wpsimp
-   apply (prop_tac "distinct (sc_replies sc)")
-    apply (fastforce simp: valid_obj_def obj_at_def is_sc_obj valid_sched_context_def)
-   apply (clarsimp simp: obj_at_simps opt_map_red vs_all_heap_simps)
-  apply wpsimp
-  apply (clarsimp simp: obj_at_def is_sc_obj)
-  done
-
-lemma get_tcb_obj_ref_exs_valid[wp]:
-  "\<exists>tcb. kheap s tp = Some (Structures_A.TCB tcb)
-   \<Longrightarrow> \<lbrace>(=) s\<rbrace> get_tcb_obj_ref f tp \<exists>\<lbrace>\<lambda>_. (=) s\<rbrace>"
-  by (clarsimp simp: get_tcb_obj_ref_def thread_get_def gets_the_def get_tcb_def bind_def
-                     gets_def get_def return_def exs_valid_def
-              split: Structures_A.kernel_object.splits)
-
-lemma replyRemove_corres:
-  "\<lbrakk> st = Structures_A.thread_state.BlockedOnReply rp;
-     st'= BlockedOnReply (Some rp)\<rbrakk> \<Longrightarrow>
-   corres dc (valid_objs and pspace_aligned and pspace_distinct and valid_replies
-              and weak_valid_sched_action and active_scs_valid
-              and st_tcb_at ((=) st) t and (\<lambda>s. sym_refs (state_refs_of s)))
-             (valid_objs' and valid_release_queue_iff and valid_queues and valid_queues'
-              and (\<lambda>s'. sym_refs (list_refs_of_replies' s')) and K (rp' = rp))
-             (reply_remove t rp) (replyRemove rp' t)"
-  (is "\<lbrakk> _ ; _ \<rbrakk> \<Longrightarrow> corres _ ?abs_guard ?conc_guard _ _")
-  apply (rule corres_gen_asm2', simp only:)
-  apply add_sym_refs
-  apply (rule_tac Q="st_tcb_at' ((=) st') t" in corres_cross_add_guard)
-   apply (fastforce dest!: st_tcb_at_coerce_concrete elim!: pred_tcb'_weakenE)
-  apply (clarsimp simp: reply_remove_def replyRemove_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: sym_refs_asrt_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_reply_corres])
-      apply (rename_tac reply reply')
-      apply (rule_tac P="?abs_guard and ko_at (Structures_A.Reply reply) rp"
-                 and P'="?conc_guard and (\<lambda>s. sym_refs (state_refs_of' s)) and st_tcb_at' ((=) st') t
-                         and ko_at' reply' rp"
-             in corres_inst)
-      apply (rule corres_guard_imp)
-        apply (rule corres_assert_gen_asm_l)
-        apply (prop_tac "reply_tcb reply = replyTCB reply'")
-         apply (clarsimp simp: reply_relation_def)
-        apply (clarsimp simp: assert_opt_def isReply_def split del: if_split)
-        apply (rule_tac P="?abs_guard and ko_at (Structures_A.Reply reply) rp"
-                   and P'="?conc_guard and (\<lambda>s. sym_refs (state_refs_of' s)) and st_tcb_at' ((=) st') t
-                           and ko_at' reply' rp"
-               in corres_inst)
-        apply (rule_tac Q'="\<lambda>rv'. ?conc_guard and st_tcb_at' ((=) st') t and (\<lambda>s'. sym_refs (state_refs_of' s'))
-                                  and ko_at' reply' rp and K (rv' = st')"
-               in corres_symb_exec_r)
-           apply (rename_tac rv')
-           apply (rule corres_gen_asm2')
-           apply (simp only:)
-           apply (rule corres_guard_imp)
-             apply (rule corres_assert_gen_asm2; simp split del: if_split)
-             apply (rule corres_symb_exec_l)
-                apply (rename_tac sc_opt)
-                apply (rule_tac P="?abs_guard and (\<lambda>s. sc_with_reply rp s = sc_opt) and  ko_at (Structures_A.Reply reply) rp"
-                           and P'="?conc_guard and (\<lambda>s. sym_refs (state_refs_of' s)) and ko_at' reply' rp"
-                       in corres_inst)
-                apply (rule_tac Q="(\<lambda>s'. sc_with_reply' rp s' = sc_opt) and pspace_aligned'
-                                         and pspace_distinct' and pspace_bounded'"
-                       in corres_cross_add_guard)
-                 apply (frule pspace_relation_pspace_bounded'[OF state_relation_pspace_relation])
-                 apply (fastforce simp: sc_replies_relation_sc_with_reply_cross_eq
-                                 dest!: state_relationD pspace_distinct_cross dest: pspace_aligned_cross)
-                apply (case_tac sc_opt; simp split del: if_split add: bind_assoc)
-                 (* sc_with_reply rp s = None *)
-                 apply (rule_tac F="replySC reply' = None" in corres_req)
-                  apply (fastforce dest!: sc_with_reply_None_reply_sc_reply_at replySCs_of_cross
-                                   elim!: obj_at_weakenE
-                                    simp: is_reply obj_at'_def projectKOs opt_map_red)
-                 apply (clarsimp simp: replySC_None_not_head)
-                 apply (simp only: bind_assoc[symmetric])
-                 apply (rule corres_symb_exec_r_sr)
-                    apply (rule corres_guard_imp)
-                      apply (rule replyUnlinkTcb_corres[simplified dc_def])
-                     apply (fastforce dest: valid_objs_valid_tcbs st_tcb_reply_state_refs
-                                      simp: obj_at_def is_reply reply_tcb_reply_at_def elim!: pred_tcb_weakenE)
-                    apply simp
-                   apply (rule sr_inv_imp)
-                     apply (erule sr_inv_sc_with_reply_None_helper)
-                    apply (fastforce elim!: obj_at_weakenE simp: is_reply)
-                   apply simp
-                  apply (wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def obj_at'_def)
-                  apply (fastforce elim!: reply_ko_at_valid_objs_valid_reply')
-                 apply (wpsimp wp: no_fail_sc_wtih_reply_None_helper, simp)
-                (* sc_with_reply \<noteq> None : rp is in a reply stack *)
-                apply (rename_tac scp)
-                apply (rule_tac F="replyNext reply' \<noteq> None" in corres_req)
-                 apply clarsimp
-                 apply (prop_tac "sc_at scp s")
-                  apply (fastforce dest!: sc_with_reply_SomeD1
-                                    simp: sc_replies_sc_at_def obj_at_def is_sc_obj_def
-                                    elim: valid_sched_context_size_objsI)
-                 apply (prop_tac "sc_at' scp s'")
-                  apply (fastforce dest!: state_relationD sc_at_cross)
-                 apply (drule sc_with_reply'_SomeD, clarsimp)
-                 apply (case_tac "hd xs = rp")
-                  apply (drule heap_path_head, clarsimp)
-                  apply (drule (3) sym_refs_scReplies)
-                  apply (clarsimp simp: obj_at'_def projectKOs sym_heap_def elim!: opt_mapE)
-                 apply (frule (1) heap_path_takeWhile_lookup_next)
-                 apply (frule heap_path_head, clarsimp)
-                 apply (prop_tac "takeWhile ((\<noteq>) rp) xs = hd xs # tl (takeWhile ((\<noteq>) rp) xs)")
-                  apply (case_tac xs; simp)
-                 apply (simp del: heap_path.simps)
-                 apply (drule_tac p1="hd xs" and ps1="tl (takeWhile ((\<noteq>) rp) xs)"
-                        in sym_refs_reply_heap_path_doubly_linked_Nexts_rev[where p'=rp, THEN iffD1])
-                  apply clarsimp
-                 apply (case_tac "rev (tl (takeWhile ((\<noteq>) rp) xs))";
-                        clarsimp simp: obj_at'_def projectKOs elim!: opt_mapE)
-                apply (clarsimp simp: liftM_def bind_assoc split del: if_split)
-                apply (rename_tac next_reply)
-                apply (rule_tac Q="\<lambda>sc. ?abs_guard
-                                        and (\<lambda>s. \<exists>n. kheap s scp = Some (Structures_A.SchedContext sc n))
-                                        and (\<lambda>s. sc_with_reply rp s = Some scp)
-                                        and ko_at (Structures_A.Reply reply) rp
-                                        and  K (rp \<in> set (sc_replies sc))"
-                       in corres_symb_exec_l)
-                   apply (rename_tac sc)
-                   apply (rule_tac Q="\<lambda>s. scReplies_of s scp = hd_opt (sc_replies sc) \<and> sc_at' scp s"
-                          in corres_cross_add_guard)
-                    apply (clarsimp; rule conjI)
-                     apply (frule state_relation_sc_replies_relation)
-                     apply (frule sc_replies_relation_scReplies_of[symmetric])
-                       apply (fastforce dest!: sc_at_cross valid_objs_valid_sched_context_size
-                                         simp: obj_at_def is_sc_obj_def obj_at'_def)
-                      apply (fastforce dest!: sc_at_cross valid_objs_valid_sched_context_size
-                                        simp: obj_at_def is_sc_obj_def state_relation_def obj_at'_def
-                                              projectKOs opt_map_def)
-                     apply (clarsimp simp: sc_replies_of_scs_def map_project_def opt_map_def
-                                           scs_of_kh_def)
-                    apply (fastforce dest!: state_relation_pspace_relation sc_at_cross
-                                            valid_objs_valid_sched_context_size
-                                      simp: obj_at_def is_sc_obj)
-                   apply (rule corres_gen_asm')
-                   apply (rule corres_symb_exec_l)
-                      apply (rename_tac tcbsc)
-                      apply (rule_tac P="?abs_guard and (\<lambda>s. sc_with_reply rp s = Some scp)
-                                         and obj_at (\<lambda>ko. \<exists>n. ko = Structures_A.SchedContext sc n) scp
-                                         and bound_sc_tcb_at ((=) tcbsc) t
-                                         and ko_at (Structures_A.Reply reply) rp
-                                         and reply_sc_reply_at
-                                                  (\<lambda>ko. (hd (sc_replies sc) = rp \<longrightarrow> Some scp = ko)
-                                                      \<and> (hd (sc_replies sc) \<noteq> rp \<longrightarrow> None = ko)) rp"
-                             in corres_inst)
-                      apply (rule_tac F="(hd (sc_replies sc) = rp \<longrightarrow> replySC reply' = Some scp)
-                                          \<and> (hd (sc_replies sc) \<noteq> rp \<longrightarrow> replySC reply' = None)"
-                             in corres_req, clarsimp)
-                       apply (drule (1) replySCs_of_cross)
-                       apply (clarsimp simp: obj_at'_def opt_map_red projectKOs getHeadScPtr_def
-                                      split: reply_next.splits)
-                      apply (case_tac "hd (sc_replies sc) = rp"; simp add: bind_assoc split del: if_split)
-
-                       (* hd (sc_replies sc) = rp & replysc = Some scp: rp is at the head of the queue *)
-                       apply (simp add: isHead_def)
-                       apply (rule corres_guard_imp)
-                         (* replyPop *)
-                         apply (rule replyPop_corres[simplified dc_def]; simp)
-                        apply (clarsimp simp: obj_at_def is_sc_obj is_reply opt_map_red
-                                              reply_tcb_reply_at_def vs_all_heap_simps)
-                        apply (drule (1) valid_sched_context_size_objsI, simp)
-                        apply (drule sc_with_reply_SomeD)
-                        apply (metis list.sel(1) list.set_cases)
-                       apply (clarsimp simp: obj_at'_def projectKOs)
-
-                      (* rp is in the middle of the reply stack *)
-                      (* hd (sc_replies sc) \<noteq> rp & rp \<in> set (sc_replies sc) *)
-                      apply (simp add: reply_unlink_sc_def bind_assoc liftM_def split del: if_split)
-                      apply (rule_tac Q="\<lambda>rv. ?abs_guard and (\<lambda>s. sc_with_reply rp s = Some scp)
-                                              and obj_at (\<lambda>ko. \<exists>n. ko = kernel_object.SchedContext sc n) scp
-                                              and bound_sc_tcb_at ((=) tcbsc) t
-                                              and ko_at (Structures_A.Reply reply) rp
-                                              and reply_sc_reply_at ((=) None) rp and K (rv = sc)"
-                             in corres_symb_exec_l)
-                         apply (rule corres_gen_asm', simp split del: if_split)
-                         apply (rule_tac Q="\<lambda>rv. ?abs_guard and (\<lambda>s. sc_with_reply rp s = Some scp)
-                                                  and obj_at (\<lambda>ko. \<exists>n. ko = kernel_object.SchedContext sc n) scp
-                                                  and bound_sc_tcb_at ((=) tcbsc) t
-                                                  and ko_at (Structures_A.Reply reply) rp
-                                                  and reply_sc_reply_at ((=) None) rp and K (rv = reply)"
-                                in corres_symb_exec_l)
-                            apply (rule corres_gen_asm')
-                            apply (simp split del: if_split add: bind_assoc)
-                            apply (rule corres_guard_imp)
-                              apply (rule_tac Q="?conc_guard and ko_at' reply' rp and sc_at' scp
-                                                 and (\<lambda>s'. sym_refs (state_refs_of' s'))
-                                                 and (\<lambda>s'. sc_with_reply' rp s' = Some scp)
-                                                 and (\<lambda>s'. scReplies_of s' scp = hd_opt (sc_replies sc))
-                                                 and (\<lambda>s'. \<forall>prp. replyPrev reply' = Some prp
-                                                                 \<longrightarrow> replyNexts_of s' prp = Some rp)"
-                                     in corres_assert_gen_asm_l)
-                              apply (clarsimp simp: getHeadScPtr_def isHead_def neq_conv[symmetric]
-                                             split: reply_next.splits)
-                              apply (rename_tac nxt_rp)
-                              apply (rule stronger_corres_guard_imp)
-                                apply (rule corres_split
-                                              [OF updateReply_replyPrev_takeWhile_middle_corres])
-                                    apply simp
-                                   apply simp
-                                  apply (rule_tac P ="?abs_guard and reply_sc_reply_at ((=) None) rp
-                                                       and ko_at (Structures_A.Reply reply) rp
-                                                       and bound_sc_tcb_at ((=) tcbsc) t" and
-                                                  Q ="\<lambda>s. sc_with_reply rp s = None" and
-                                                  P'="valid_objs' and valid_release_queue_iff
-                                                      and ko_at' reply' rp and sc_at' scp" and
-                                                  Q'="(\<lambda>s'. \<forall>prp. replyPrev reply' = Some prp
-                                                                  \<longrightarrow> replyNexts_of s' prp = Some rp)"
-                                        in corres_inst_add)
-                                  apply (rule corres_symb_exec_r_sr)
-                                     apply (rule corres_symb_exec_r_sr)
-                                        apply (rule corres_guard_imp)
-                                          apply (rule replyUnlinkTcb_corres[simplified dc_def])
-                                         apply (fastforce dest: valid_objs_valid_tcbs st_tcb_reply_state_refs
-                                                          simp: obj_at_def is_reply reply_tcb_reply_at_def elim!: pred_tcb_weakenE)
-                                        apply simp
-                                       apply (rule sr_inv_imp)
-                                         apply (rule cleanReply_sr_inv)
-                                        apply simp
-                                       apply simp
-                                      apply wpsimp
-                                     apply wpsimp
-                                     apply (clarsimp dest!: state_relationD simp: reply_sc_reply_at_def)
-                                     apply (fastforce intro!: reply_at_cross elim!: obj_at_weakenE simp: is_reply)
-                                    apply (clarsimp cong: conj_cong)
-                                    apply (case_tac "replyPrev reply'"; simp)
-                                    apply (rename_tac prev_rp)
-                                    apply (rule sr_inv_imp)
-                                      apply (rule_tac P =\<top> and
-                                                      P'=" (\<lambda>s'. \<forall>prp. replyPrev reply' = Some prp
-                                                                       \<longrightarrow> replyNexts_of s' prev_rp = Some rp)"
-                                             in updateReply_sr_inv)
-                                       apply (clarsimp simp: reply_relation_def projectKOs obj_at'_def obj_at_def
-                                                      elim!: opt_mapE)
-                                      apply clarsimp
-                                      apply (drule_tac rp=prev_rp in sc_replies_relation_replyNext_update, simp)
-                                      apply simp
-                                     apply simp
-                                    apply clarsimp
-                                   apply wpsimp
-                                  apply wpsimp
-                                  apply (clarsimp dest!: reply_ko_at_valid_objs_valid_reply'
-                                                   simp: valid_reply'_def)
-                                 apply (wpsimp wp: sc_replies_update_takeWhile_sc_with_reply
-                                                   sc_replies_update_takeWhile_middle_sym_refs
-                                                   sc_replies_update_takeWhile_valid_replies)
-                                apply (wpsimp wp: updateReply_valid_objs' updateReply_ko_at'_other)
-                               apply (clarsimp cong: conj_cong)
-                               apply simp
-                              apply (clarsimp simp: valid_reply'_def)
-                              apply (rule context_conjI)
-                               apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-                              apply (clarsimp simp: obj_at_def del: opt_mapE)
-                              apply (frule (1) valid_sched_context_objsI)
-                              apply (clarsimp simp: valid_sched_context_def del: opt_mapE)
-                              apply (frule (4) next_reply_in_sc_replies[OF state_relation_sc_replies_relation])
-                                 apply (fastforce dest!: state_relationD pspace_aligned_cross pspace_distinct_cross)
-                                apply (fastforce dest!: state_relationD pspace_distinct_cross)
-                               apply (fastforce dest!: state_relationD pspace_relation_pspace_bounded')
-                              apply (clarsimp simp: obj_at'_def)
-                              apply (clarsimp simp: vs_heap_simps)
-                             apply clarsimp
-                             apply (rule conjI)
-                              apply (clarsimp simp: list_all_iff dest!: set_takeWhileD)
-                             apply (clarsimp simp: reply_relation_def)
-                            apply (fastforce elim!: sym_refs_replyNext_replyPrev_sym[THEN iffD2]
-                                              simp: opt_map_red obj_at'_def projectKOs)
-                           apply (wpsimp simp: get_sk_obj_ref_def wp: get_reply_exs_valid)
-                            apply (fastforce dest!: Reply_or_Receive_reply_at[rotated]
-                                              simp: obj_at_def is_reply)
-                           apply simp
-                          apply (wpsimp wp: get_simple_ko_wp)
-                          apply (clarsimp simp: obj_at_def reply_sc_reply_at_def)
-                         apply (wpsimp simp: get_sk_obj_ref_def get_simple_ko_def obj_at_def
-                                         wp: get_object_wp)
-                         apply (fastforce simp: obj_at_def is_reply partial_inv_def a_type_def)
-                        apply (wpsimp wp: get_sched_context_exs_valid)
-                         apply (drule sc_with_reply_SomeD)
-                         apply clarsimp+
-                       apply (wpsimp simp: obj_at_def)
-                      apply (wpsimp wp: get_sched_context_no_fail)
-                      apply (fastforce elim!: valid_sched_context_size_objsI simp: obj_at_def is_sc_obj_def)
-                     apply (wpsimp simp: pred_tcb_at_def obj_at_def)
-                    apply (wpsimp wp: gbsc_bound_tcb simp: obj_at_def)
-                    apply (clarsimp simp: obj_at_def reply_sc_reply_at_def is_reply)
-                    apply (case_tac "sc_replies sc"; simp)
-                    apply (intro conjI impI)
-                     apply (fastforce dest!: sym_refs_reply_sc_reply_at
-                                       simp: sc_replies_sc_at_def obj_at_def reply_sc_reply_at_def)
-                    apply (fastforce dest!: sc_replies_middle_reply_sc_None
-                                      simp: vs_heap_simps obj_at_def is_sc_obj is_reply reply_sc_reply_at_def
-                                     elim!: valid_sched_context_size_objsI opt_mapE)
-                   apply (wpsimp simp: get_tcb_obj_ref_def thread_get_def st_tcb_def2)
-                  apply (wpsimp wp: get_sched_context_exs_valid)
-                   apply (fastforce dest!: sc_with_reply_SomeD1 simp: sc_replies_sc_at_def obj_at_def)
-                  apply simp
-                 apply wpsimp
-                 apply (fastforce dest!: sc_with_reply_SomeD1 simp: sc_replies_sc_at_def obj_at_def)
-                apply (wpsimp wp: get_sched_context_no_fail)
-                apply (fastforce dest!: sc_with_reply_SomeD1 simp: sc_replies_sc_at_def is_sc_obj obj_at_def
-                                 elim!: obj_at_weakenE valid_sched_context_size_objsI)
-               apply wpsimp
-              apply wpsimp
-             apply wpsimp
-            apply simp
-           apply (fastforce dest!: st_tcb_at_valid_st2 simp: valid_tcb_state_def)
-          apply clarsimp
-          apply (wpsimp simp: op_equal)
-         apply wpsimp
-        apply wpsimp
-       apply (fastforce dest: valid_objs_valid_tcbs st_tcb_reply_state_refs
-                         simp: obj_at_def is_reply reply_tcb_reply_at_def)
-      apply clarsimp
-     apply (wpsimp wp: get_simple_ko_ko_at)
-    apply wpsimp
-   apply clarsimp
-   apply (fastforce dest!: st_tcb_at_valid_st2 simp: valid_tcb_state_def)
-  apply (fastforce dest: tcb_in_valid_state' simp: valid_tcb_state'_def)
+       apply (rule get_cap_corres [where cslot_ptr="(t, tcb_cnode_index 2)",
+                                          simplified cte_map_tcb_2 cte_index_repair_sym])
+      apply (clarsimp dest!: st_tcb_at_tcb_at
+                             tcb_at_cte_at [where ref="tcb_cnode_index 2"])
+     apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+    defer
+    apply (rule hoare_vcg_conj_lift [OF get_cap_inv get_cap_cte_wp_at, simplified])
+   apply (rule hoare_vcg_conj_lift [OF getCTE_inv getCTE_cte_wp_at, simplified])
+  apply (rename_tac cte)
+  apply (rule corres_symb_exec_l [OF _ _ gets_sp])
+    apply (rule_tac F="\<exists>r. cap = cap.ReplyCap t True r \<and>
+                       cteCap cte = capability.ReplyCap t True (AllowGrant \<in> r)" in corres_req)
+     apply (fastforce simp: cte_wp_at_caps_of_state is_cap_simps
+                     dest!: st_tcb_at_reply_cap_valid)
+    apply (rule_tac F="(descs = {}) = (mdbNext (cteMDBNode cte) = nullPointer)"
+                 in corres_req)
+     apply (fastforce simp: st_tcb_at_tcb_at cte_wp_at_ctes_of st_tcb_def2 cte_index_repair
+                     dest: reply_descendants_of_mdbNext)
+    apply (elim exE)
+    apply (case_tac "descs = {}", simp add: when_def)
+    apply (rule_tac F="\<exists>sl. descs = {sl}" in corres_req)
+     apply (fastforce intro: st_tcb_at_tcb_at dest: reply_master_one_descendant)
+    apply (erule exE, frule singleton_eqD)
+    apply (rule_tac F="mdbNext (cteMDBNode cte) = cte_map sl" in corres_req)
+     apply (clarsimp dest!: st_tcb_at_tcb_at)
+     apply (fastforce simp: cte_wp_at_ctes_of cte_level_bits_def
+                    elim!: reply_mdbNext_is_descendantD)
+    apply (simp add: when_def getSlotCap_def capHasProperty_def
+                del: split_paired_Ex)
+    apply (rule corres_guard_imp)
+      apply (rule_tac P'="\<lambda>s. \<exists>r'. cte_wp_at ((=) (cap.ReplyCap t False r')) sl s"
+                   in corres_stateAssert_implied [OF delete_one_corres])
+      apply (fastforce dest: pspace_relation_cte_wp_at
+                            state_relation_pspace_relation
+                      simp: cte_wp_at_ctes_of isCap_simps)
+     apply (fastforce simp: invs_def valid_state_def valid_mdb_def reply_mdb_def
+                           reply_masters_mdb_def cte_wp_at_caps_of_state
+                           can_fast_finalise_def)
+    apply (fastforce simp: valid_mdb'_def valid_mdb_ctes_def
+                          cte_wp_at_ctes_of nullPointer_def
+                    elim: valid_dlistEn dest: invs_mdb')
+   apply (simp add: exs_valid_def gets_def get_def return_def bind_def
+               del: split_paired_Ex split_paired_All)
+  apply (wp)
   done
+qed
 
-lemma cancel_ipc_corres:
-  "corres dc (invs and valid_ready_qs and tcb_at t) invs'
+lemma (in delete_one) cancel_ipc_corres:
+  "corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
       (cancel_ipc t) (cancelIPC t)"
-  apply add_sym_refs
-  apply add_ready_qs_runnable
-  apply (rule_tac Q="tcb_at' t" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD elim!: tcb_at_cross)
   apply (simp add: cancel_ipc_def cancelIPC_def Let_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: sym_refs_asrt_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply clarsimp
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getThreadState_corres])
-      apply (rule corres_split)
-         apply (rule threadset_corres; simp?)
-         apply (clarsimp simp: tcb_relation_def fault_rel_optionation_def)
-        apply (rule_tac P="invs and valid_ready_qs and st_tcb_at ((=) state) t" and
-                        P'="invs' and st_tcb_at' ((=) statea) t" in corres_inst)
-        apply (case_tac state, simp_all add: isTS_defs list_case_If gbep_ret')[1]
-           apply (rule corres_guard_imp)
-             apply (rename_tac epPtr reply pl)
-             apply (rule_tac st = "Structures_A.thread_state.BlockedOnReceive epPtr reply pl"
-                    in blocked_cancelIPC_corres[simplified])
-               apply simp
-              apply (clarsimp simp: thread_state_relation_def)
-             apply simp+
-            apply (clarsimp simp: invs_implies)
-           apply (clarsimp simp: invs'_implies)
-          apply (rule corres_guard_imp)
-            apply (rename_tac epPtr data)
-            apply (rule_tac st = "Structures_A.thread_state.BlockedOnSend epPtr data"
-                   in blocked_cancelIPC_corres[where reply_opt=None, simplified])
-             apply simp
-            apply (clarsimp simp: thread_state_relation_def)
-           apply simp
-           apply (clarsimp simp: invs_implies)
-          apply (clarsimp simp: invs'_implies)
+      apply (rule_tac P="einvs and st_tcb_at ((=) state) t" and
+                      P'="invs' and st_tcb_at' ((=) statea) t" in corres_inst)
+      apply (case_tac state, simp_all add: isTS_defs list_case_If)[1]
          apply (rule corres_guard_imp)
-           apply (rule replyRemoveTCB_corres)
+           apply (rule blocked_cancelIPC_corres)
+            apply fastforce
+           apply fastforce
           apply simp
-          apply (clarsimp simp: thread_state_relation_def)
-          apply (clarsimp simp: invs_implies)
-         apply (clarsimp simp: invs'_implies)
+         apply simp
+        apply (clarsimp simp add: isTS_defs list_case_If)
         apply (rule corres_guard_imp)
-          apply (rule cancelSignal_corres)
-         apply simp+
-       apply (wpsimp wp: thread_set_invs_fault_None thread_set_valid_ready_qs thread_set_no_change_tcb_state)
-      apply (wpsimp wp: threadSet_pred_tcb_no_state threadSet_invs_trivial)+
-     apply (wp gts_sp[where P="\<top>", simplified])+
+          apply (rule blocked_cancelIPC_corres)
+           apply fastforce
+          apply fastforce
+         apply simp
+        apply simp
+       apply (rule corres_guard_imp)
+         apply (rule cancelIPC_ReplyCap_corres)
+        apply (clarsimp elim!: st_tcb_weakenE)
+       apply (clarsimp elim!: pred_tcb'_weakenE)
+      apply (rule corres_guard_imp [OF cancelSignal_corres], simp+)
+     apply (wp gts_sp[where P="\<top>",simplified])+
     apply (rule hoare_strengthen_post)
      apply (rule gts_sp'[where P="\<top>"])
     apply (clarsimp elim!: pred_tcb'_weakenE)
-   apply simp
-  apply (clarsimp simp: inQ_def obj_at'_def projectKOs valid_release_queue'_def
-                 dest!: invs_valid_release_queue')
+   apply fastforce
+  apply simp
   done
 
 lemma setNotification_utr[wp]:
@@ -1743,6 +636,10 @@ lemma setNotification_utr[wp]:
   apply (simp add: o_def)
   done
 
+crunch setEndpoint
+  for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  (wp: setObject_ksPSpace_only updateObject_default_inv)
+
 lemma setEndpoint_utr[wp]:
   "\<lbrace>untyped_ranges_zero'\<rbrace> setEndpoint p ep \<lbrace>\<lambda>rv. untyped_ranges_zero'\<rbrace>"
   apply (simp add: cteCaps_of_def)
@@ -1753,10 +650,14 @@ lemma setEndpoint_utr[wp]:
 declare cart_singleton_empty [simp]
 declare cart_singleton_empty2[simp]
 
+crunch setNotification
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
+  (wp: setObject_queues_unchanged_tcb updateObject_default_inv)
+
 lemma sch_act_simple_not_t[simp]: "sch_act_simple s \<Longrightarrow> sch_act_not t s"
   by (clarsimp simp: sch_act_simple_def)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 crunch setNotification
   for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
@@ -1764,73 +665,81 @@ crunch setNotification
   (wp: valid_bitmaps_lift)
 
 lemma cancelSignal_invs':
-  "\<lbrace>invs' and st_tcb_at' (\<lambda>st. st = BlockedOnNotification ntfn) t\<rbrace>
-   cancelSignal t ntfn
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  "\<lbrace>invs' and st_tcb_at' (\<lambda>st. st = BlockedOnNotification ntfn) t and sch_act_not t\<rbrace>
+    cancelSignal t ntfn \<lbrace>\<lambda>rv. invs'\<rbrace>"
   proof -
-    have NIQ: "\<And>s. \<lbrakk> valid_queues s;
-                     \<forall>d p. \<forall>t\<in>set (ksReadyQueues s (d, p)). st_tcb_at' runnable' t s;
-                     st_tcb_at' (Not \<circ> runnable') t s \<rbrakk>
-                     \<Longrightarrow> \<forall>d p. t \<notin> set (ksReadyQueues s (d,p))"
-      apply (clarsimp simp add: pred_tcb_at'_def Invariants_H.valid_queues_def
-                                valid_queues_no_bitmap_def)
-      apply (drule spec | drule(1) bspec | clarsimp simp: obj_at'_def inQ_def)+
-      done
     have NTFNSN: "\<And>ntfn ntfn'.
                     \<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s \<rbrace> setNotification ntfn ntfn'
                     \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
       apply (rule hoare_weaken_pre)
-       apply (wps)
+       apply (wps setNotification_ksCurThread)
        apply (wp, simp)
       done
     show ?thesis
-      apply (simp add: cancelSignal_def invs'_def Let_def valid_dom_schedule'_def)
-      apply (rule bind_wp[OF _ stateAssert_sp])
+      apply (simp add: cancelSignal_def invs'_def valid_state'_def Let_def)
       apply (wp valid_irq_node_lift sts_sch_act' irqs_masked_lift
-                hoare_vcg_all_lift [OF set_ntfn'.ksReadyQueues]
-                setThreadState_ct_not_inQ NTFNSN set_ntfn'.get_wp
-                hoare_vcg_all_lift set_ntfn'.ksReadyQueues hoare_vcg_imp_lift'
+                hoare_vcg_all_lift
+                setThreadState_ct_not_inQ NTFNSN
+                hoare_vcg_all_lift
               | simp add: valid_tcb_state'_def list_case_If split del: if_split)+
-      apply (clarsimp simp: pred_tcb_at' ready_qs_runnable_def)
-      apply (frule (1) NIQ)
-       apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-      apply (case_tac "ntfnObj ko", simp_all add: isWaitingNtfn_def)
+       prefer 2
+       apply assumption
+      apply (rule hoare_strengthen_post)
+       apply (rule get_ntfn_sp')
+      apply (rename_tac rv s)
+      apply (clarsimp simp: pred_tcb_at')
       apply (rule conjI)
        apply (clarsimp simp: valid_ntfn'_def)
-       apply normalise_obj_at'
+       apply (case_tac "ntfnObj rv", simp_all add: isWaitingNtfn_def)
        apply (frule ko_at_valid_objs')
          apply (simp add: valid_pspace_valid_objs')
         apply (clarsimp simp: projectKO_opt_ntfn split: kernel_object.splits)
-       apply (simp add: valid_obj'_def valid_ntfn'_def)
-       apply (rule conjI, clarsimp simp: pred_tcb_at'_def obj_at'_def)
-       apply (rule conjI, erule_tac rfs'="list_refs_of_replies' s" in delta_sym_refs)
-         subgoal
-         by (auto simp: symreftype_inverse' list_refs_of_replies'_def
-                        get_refs_def2 opt_map_def
-                 split: option.splits)
-        subgoal
-        by (auto simp: symreftype_inverse' list_refs_of_replies'_def
-                       get_refs_def2 opt_map_def
-                split: option.splits)
-        apply (frule obj_at_valid_objs', clarsimp)
-        apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def)
-        apply (frule st_tcb_at_state_refs_ofD')
-        apply (frule ko_at_state_refs_ofD')
-        apply (fastforce simp: get_refs_def elim!: if_live_state_refsE split: option.splits)
-       apply (frule obj_at_valid_objs', clarsimp)
-       apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def)
-       apply (rule conjI, clarsimp split: option.splits)
+        apply (simp add: valid_obj'_def valid_ntfn'_def)
        apply (frule st_tcb_at_state_refs_ofD')
        apply (frule ko_at_state_refs_ofD')
-       apply (rule conjI)
-        apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-       apply (rule conjI)
+       apply (rule conjI, erule delta_sym_refs)
+         apply (clarsimp simp: ntfn_bound_refs'_def split: if_split_asm)
         apply (clarsimp split: if_split_asm)
-        apply (fastforce simp: list_refs_of_replies'_def opt_map_def o_def split: option.splits)
-       apply (fastforce simp: get_refs_def elim!: if_live_state_refsE split: option.splits)
-       done
+          subgoal
+          by (fastforce simp: symreftype_inverse' ntfn_bound_refs'_def
+                               tcb_bound_refs'_def ntfn_q_refs_of'_def obj_at'_def projectKOs
+                        split: ntfn.splits option.splits)
+         subgoal
+         by (fastforce simp: symreftype_inverse' ntfn_bound_refs'_def
+                                tcb_bound_refs'_def)
+        subgoal
+        by (fastforce simp: symreftype_inverse' ntfn_bound_refs'_def
+                               tcb_bound_refs'_def ntfn_q_refs_of'_def remove1_empty
+                        split: ntfn.splits)
+       apply (rule conjI, clarsimp elim!: if_live_state_refsE)
+       apply (fastforce simp: sym_refs_def dest!: idle'_no_refs)
+      apply (case_tac "ntfnObj rv", simp_all)
+      apply (frule obj_at_valid_objs', clarsimp)
+      apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def)
+      apply (rule conjI, clarsimp split: option.splits)
+      apply (frule st_tcb_at_state_refs_ofD')
+      apply (frule ko_at_state_refs_ofD')
+      apply (rule conjI)
+       apply (erule delta_sym_refs)
+        apply (fastforce simp: ntfn_bound_refs'_def split: if_split_asm)
+       apply (clarsimp split: if_split_asm)
+        apply (fastforce simp: symreftype_inverse' ntfn_bound_refs'_def tcb_bound_refs'_def
+                               set_eq_subset)
+       apply (fastforce simp: symreftype_inverse' ntfn_bound_refs'_def tcb_bound_refs'_def
+                              set_eq_subset)
+      apply (clarsimp simp: valid_pspace'_def)
+      apply (rule conjI, clarsimp elim!: if_live_state_refsE)
+      apply (rule conjI)
+       apply (case_tac "ntfnBoundTCB rv")
+        apply (clarsimp elim!: if_live_state_refsE)+
+            apply (rule conjI, clarsimp split: option.splits)
+      apply (clarsimp dest!: idle'_no_refs)
+      done
   qed
 
+lemmas setEndpoint_valid_arch[wp]
+    = valid_arch_state_lift' [OF setEndpoint_typ_at' set_ep_arch']
+
 lemma ep_redux_simps3:
   "ep_q_refs_of' (case xs of [] \<Rightarrow> IdleEP | y # ys \<Rightarrow> RecvEP (y # ys))
         = (set xs \<times> {EPRecv})"
@@ -1840,154 +749,189 @@ lemma ep_redux_simps3:
 
 lemma setEndpoint_pde_mappings'[wp]:
   "\<lbrace>valid_pde_mappings'\<rbrace> setEndpoint ptr val \<lbrace>\<lambda>rv. valid_pde_mappings'\<rbrace>"
-  by (wp valid_pde_mappings_lift')
+  apply (wp valid_pde_mappings_lift')
+   apply (simp add: setEndpoint_def)
+   apply (rule obj_at_setObject2)
+   apply (clarsimp dest!: updateObject_default_result)+
+  done
 
-end
+declare setEndpoint_ksMachine [wp]
+declare setEndpoint_valid_irq_states' [wp]
 
-crunch cancelIPC
+lemma setEndpoint_vms[wp]:
+  "\<lbrace>valid_machine_state'\<rbrace> setEndpoint epptr ep' \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
+  by (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
+     (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
+
+crunch setEndpoint
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
+  (wp: setObject_queues_unchanged_tcb updateObject_default_inv)
+
+crunch setEndpoint
+  for sch_act_not[wp]: "sch_act_not t"
+
+crunch setEndpoint
   for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and ksMachineState[wp]: "\<lambda>s. P (ksMachineState s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and sch_act_simple[wp]: "sch_act_simple"
-  and valid_pde_mappings'[wp]: "valid_pde_mappings'"
-  and ifunsafe'[wp]: "if_unsafe_then_cap'"
-  and global_refs'[wp]: "valid_global_refs'"
-  and valid_arch'[wp]: "valid_arch_state'"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and vms'[wp]: "valid_machine_state'"
-  and ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and ntfn_at'[wp]: "ntfn_at' t"
-  (wp: crunch_wps simp: crunch_simps)
+  (wp: setObject_ep_cur_domain)
 
-crunch blockedCancelIPC
-  for valid_queues[wp]: valid_queues
-  and replyNexts_replyPrevs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s)"
-  (wp: crunch_wps)
+lemma setEndpoint_ksDomSchedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> setEndpoint ptr ep \<lbrace>\<lambda>_ s. P (ksDomSchedule s)\<rbrace>"
+  apply (simp add: setEndpoint_def setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
 
-crunch cancelSignal, replyRemoveTCB
-  for sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  (wp: crunch_wps sts_sch_act')
-
-lemma blockedCancelIPC_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and> sch_act_not tptr s\<rbrace>
-   blockedCancelIPC st tptr rptrOpt
-   \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding blockedCancelIPC_def getBlockingObject_def epBlocked_def
-  apply (wpsimp wp: hoare_vcg_imp_lift' getEndpoint_wp haskell_assert_wp sts_sch_act')
-  done
-
-lemma nonempty_epQueue_remove1_valid_ep':
-  "\<lbrakk>valid_ep' ep s; remove1 tptr (epQueue ep) = x # xs; ep \<noteq> IdleEP\<rbrakk>
-   \<Longrightarrow> valid_ep' (epQueue_update (\<lambda>_. x # xs) ep) s"
-  apply (case_tac ep
-         ; clarsimp simp: valid_ep'_def
-         ; metis (full_types) distinct.simps(2) distinct_remove1 list.set_intros(1)
-                              list.set_intros(2) notin_set_remove1)
-  done
-
-lemma blockedCancelIPC_valid_pspace'[wp]:
-  "\<lbrace>valid_pspace' and st_tcb_at' ((=) st) tptr\<rbrace>
-   blockedCancelIPC st tptr rptrOpt
-   \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
-  supply opt_mapE[elim!]
-  unfolding valid_pspace'_def blockedCancelIPC_def getBlockingObject_def
-  apply (wpsimp wp: valid_mdb'_lift hoare_vcg_imp_lift getEndpoint_wp
-                    hoare_vcg_all_lift sts'_valid_replies' replyUnlink_st_tcb_at'
-              simp: valid_tcb_state'_def epBlocked_def)
-  apply (rule ccontr, normalise_obj_at')
-  apply (match premises in epQueue: "_ (valid_ep' ep s)" for ep s \<Rightarrow>
-         \<open>rule meta_mp[rotated, where P="valid_ep' ep s"]\<close>)
-   apply (drule(1) ep_ko_at_valid_objs_valid_ep')
-   apply (case_tac "remove1 tptr (epQueue ko)"; clarsimp)
-    apply (clarsimp simp: valid_ep'_def)
-   apply (fastforce dest: nonempty_epQueue_remove1_valid_ep'[rotated])
-  apply (case_tac "rptrOpt"; clarsimp simp: pred_tcb_at'_eq_commute)
-   apply (fastforce simp: pred_tcb_at'_def obj_at'_def projectKOs)
-  apply (rename_tac rptr reply KOreply)
-  apply (drule_tac rptr=rptr in valid_replies'D[simplified pred_tcb_at'_eq_commute])
-   apply (clarsimp simp: opt_pred_def)
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def projectKOs)
-  done
-
-lemma cancelIPC_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and> sch_act_not tptr s\<rbrace>
-   cancelIPC tptr
-   \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding cancelIPC_def
-  apply (wpsimp wp: gts_wp' hoare_vcg_imp_lift' threadSet_sch_act hoare_vcg_all_lift
-                    replyRemoveTCB_sch_act_wf)
-  done
-
-crunch getBlockingObject
-  for inv: P
-
-lemma blockedCancelIPC_if_live'[wp]:
-  "blockedCancelIPC st tptr epptr \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  unfolding blockedCancelIPC_def getBlockingObject_def
-  apply (wpsimp wp: getEndpoint_wp haskell_assert_wp)
-  apply (clarsimp simp: if_live_then_nonz_cap'_def endpoint.disc_eq_case endpoint_live')
-  done
-
-lemma blockedCancelIPC_valid_idle':
-  "\<lbrace>valid_idle' and (\<lambda>s. tptr \<noteq> ksIdleThread s)\<rbrace>
-   blockedCancelIPC st tptr epptr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  unfolding blockedCancelIPC_def getBlockingObject_def
-  apply (wpsimp wp: getEndpoint_wp)
-  done
-
-crunch blockedCancelIPC
-  for ct_not_inQ[wp]: ct_not_inQ
-  and cur_tcb'[wp]: "cur_tcb'"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and untyped_ranges_zero'[wp]: "untyped_ranges_zero'"
-  (wp: crunch_wps)
+lemma setEndpoint_ct_idle_or_in_cur_domain'[wp]:
+  "\<lbrace> ct_idle_or_in_cur_domain' \<rbrace> setEndpoint ptr ep \<lbrace> \<lambda>_. ct_idle_or_in_cur_domain' \<rbrace>"
+  apply (rule ct_idle_or_in_cur_domain'_lift)
+  apply (wp hoare_vcg_disj_lift hoare_vcg_imp_lift setObject_ep_ct
+       | rule obj_at_setObject2
+       | clarsimp simp: updateObject_default_def in_monad setEndpoint_def)+
+  done
 
-lemma blockedCancelIPC_invs':
-  "\<lbrace>invs' and st_tcb_at' ((=) st) tptr\<rbrace>
-   blockedCancelIPC st tptr rptrOpt
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (rule hoare_strengthen_pre_via_assert_backward[
-                where E="obj_at' ((\<noteq>) IdleEP) (the (epBlocked st))
-                         and K (\<exists>x. epBlocked st = Some x)"])
-   apply (simp add: blockedCancelIPC_def getBlockingObject_def)
-   apply (wpsimp wp: getEndpoint_wp)
-   apply (clarsimp simp: obj_at'_def)
-  unfolding invs'_def decompose_list_refs_of_replies' valid_dom_schedule'_def
-  apply (wpsimp wp: valid_irq_node_lift typ_at_lifts
-                    valid_irq_handlers_lift' valid_irq_states_lift' irqs_masked_lift
-              simp: cteCaps_of_def pred_tcb_at'_def)
-  done
-
-lemma threadSet_fault_invs':
-  "threadSet (tcbFault_update upd) t \<lbrace>invs'\<rbrace>"
-  apply (wpsimp wp: threadSet_invs_trivial)
-  apply (clarsimp simp: inQ_def)
-  apply (rule conjI)
-   apply clarsimp
-  apply (frule invs_valid_release_queue')
-  apply (clarsimp simp: valid_release_queue'_def obj_at'_def)
+lemma setEndpoint_ct_not_inQ[wp]:
+  "\<lbrace>ct_not_inQ\<rbrace> setEndpoint eeptr ep' \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+  apply (rule ct_not_inQ_lift [OF setEndpoint_nosch])
+  apply (simp add: setEndpoint_def)
+  apply (rule hoare_weaken_pre)
+   apply (wps setObject_ep_ct)
+   apply (wp obj_at_setObject2)
+   apply (clarsimp simp: updateObject_default_def in_monad)+
+  done
+
+lemma setEndpoint_ksDomScheduleIdx[wp]:
+  "setEndpoint ptr ep \<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace>"
+  apply (simp add: setEndpoint_def setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+end
+
+crunch setEndpoint
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and valid_bitmaps[wp]: valid_bitmaps
+  (wp: valid_bitmaps_lift simp: updateObject_default_def)
+
+lemma (in delete_one_conc) cancelIPC_invs[wp]:
+  shows "\<lbrace>tcb_at' t and invs'\<rbrace> cancelIPC t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+proof -
+  have P: "\<And>xs v f. (case xs of [] \<Rightarrow> return v | y # ys \<Rightarrow> return (f (y # ys)))
+                         = return (case xs of [] \<Rightarrow> v | y # ys \<Rightarrow> f xs)"
+    by (clarsimp split: list.split)
+  have EPSCHN: "\<And>eeptr ep'. \<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s\<rbrace>
+                             setEndpoint eeptr ep'
+                             \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
+    apply (rule hoare_weaken_pre)
+     apply (wps setEndpoint_ct')
+     apply (wp, simp)
+    done
+  have Q:
+    "\<And>epptr. \<lbrace>st_tcb_at' (\<lambda>st. \<exists>a. (st = BlockedOnReceive epptr a)
+                            \<or> (\<exists>a b c d. st = BlockedOnSend epptr a b c d)) t
+                  and invs'\<rbrace>
+      do ep \<leftarrow> getEndpoint epptr;
+         y \<leftarrow> assert (\<not> (case ep of IdleEP \<Rightarrow> True | _ \<Rightarrow> False));
+         ep' \<leftarrow> case remove1 t (epQueue ep)
+                of [] \<Rightarrow> return Structures_H.endpoint.IdleEP
+                | x # xs \<Rightarrow> return (epQueue_update (%_. x # xs) ep);
+         y \<leftarrow> setEndpoint epptr ep';
+         setThreadState Inactive t
+      od \<lbrace>\<lambda>rv. invs'\<rbrace>"
+    apply (simp add: invs'_def valid_state'_def)
+    apply (subst P)
+    apply (wp valid_irq_node_lift valid_global_refs_lift' valid_arch_state_lift'
+              irqs_masked_lift sts_sch_act'
+              hoare_vcg_all_lift [OF setEndpoint_ksQ]
+              setThreadState_ct_not_inQ EPSCHN
+              hoare_vcg_all_lift
+              | simp add: valid_tcb_state'_def split del: if_split
+              | wpc)+
+     prefer 2
+     apply assumption
+    apply (rule hoare_strengthen_post [OF get_ep_sp'])
+    apply (clarsimp simp: pred_tcb_at' fun_upd_def[symmetric] conj_comms
+               split del: if_split cong: if_cong)
+    apply (rule conjI, clarsimp simp: valid_pspace'_def)
+    apply (rule conjI, clarsimp simp: valid_pspace'_def)
+    apply (rule conjI, clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def idle_tcb'_def)
+    apply (frule obj_at_valid_objs', clarsimp)
+    apply (clarsimp simp: projectKOs valid_obj'_def)
+    apply (rule conjI)
+     apply (clarsimp simp: obj_at'_def valid_ep'_def projectKOs
+                    dest!: pred_tcb_at')
+    apply (clarsimp, rule conjI)
+     apply (auto simp: pred_tcb_at'_def obj_at'_def)[1]
+    apply (rule conjI)
+     apply (clarsimp split: Structures_H.endpoint.split_asm list.split
+                      simp: valid_ep'_def)
+      apply (rename_tac list x xs)
+      apply (frule distinct_remove1[where x=t])
+      apply (cut_tac xs=list in set_remove1_subset[where x=t])
+      apply auto[1]
+     apply (rename_tac list x xs)
+     apply (frule distinct_remove1[where x=t])
+     apply (cut_tac xs=list in set_remove1_subset[where x=t])
+     apply auto[1]
+    apply (frule(1) sym_refs_ko_atD')
+    apply (rule conjI)
+     apply (clarsimp elim!: if_live_state_refsE split: Structures_H.endpoint.split_asm)
+    apply (drule st_tcb_at_state_refs_ofD')
+    apply (clarsimp simp: ep_redux_simps3 valid_ep'_def
+                   split: Structures_H.endpoint.split_asm
+                    cong: list.case_cong)
+     apply (frule_tac x=t in distinct_remove1)
+     apply (frule_tac x=t in set_remove1_eq)
+     by (auto elim!: delta_sym_refs
+               simp: symreftype_inverse' tcb_st_refs_of'_def tcb_bound_refs'_def
+              split: thread_state.splits if_split_asm)
+  have R:
+    "\<lbrace>invs' and tcb_at' t\<rbrace>
+     do y \<leftarrow> threadSet (\<lambda>tcb. tcb \<lparr> tcbFault := None \<rparr>) t;
+        slot \<leftarrow> getThreadReplySlot t;
+        callerCap \<leftarrow> liftM (mdbNext \<circ> cteMDBNode) (getCTE slot);
+        when (callerCap \<noteq> nullPointer) (do
+            y \<leftarrow> stateAssert (capHasProperty callerCap (\<lambda>cap. isReplyCap cap
+                                                           \<and> \<not> capReplyMaster cap))
+                [];
+            cteDeleteOne callerCap
+        od)
+     od
+     \<lbrace>\<lambda>rv. invs'\<rbrace>"
+    unfolding getThreadReplySlot_def
+    by (wp valid_irq_node_lift delete_one_invs hoare_drop_imps
+           threadSet_invs_trivial irqs_masked_lift
+      | simp add: o_def if_apply_def2
+      | fastforce simp: inQ_def)+
+  show ?thesis
+    apply (simp add:   cancelIPC_def crunch_simps
+               cong:   if_cong list.case_cong)
+    apply (rule bind_wp [OF _ gts_sp'])
+    apply (case_tac state,
+           simp_all add: isTS_defs)
+           apply (safe intro!: hoare_weaken_pre[OF Q]
+                               hoare_weaken_pre[OF R]
+                               hoare_weaken_pre[OF return_wp]
+                               hoare_weaken_pre[OF cancelSignal_invs']
+                       elim!: pred_tcb'_weakenE)
+          apply (auto simp: pred_tcb_at'_def obj_at'_def
+                      dest: invs_sch_act_wf')
   done
+qed
 
-lemma cancelIPC_invs'[wp]:
-  "cancelIPC t \<lbrace>invs'\<rbrace>"
-  unfolding cancelIPC_def Let_def
-  apply (wpsimp wp: blockedCancelIPC_invs' replyRemoveTCB_invs' cancelSignal_invs'
-                    hoare_vcg_all_lift hoare_vcg_imp_lift' threadSet_fault_invs' gts_wp'
-              simp: pred_tcb_at'_def)
-  apply normalise_obj_at'
-  apply (rename_tac tcb)
-  apply (case_tac "tcbState tcb"; clarsimp)
+lemma (in delete_one_conc_pre) cancelIPC_sch_act_simple[wp]:
+  "\<lbrace>sch_act_simple\<rbrace>
+    cancelIPC t
+   \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
+  apply (simp add: cancelIPC_def cancelSignal_def Let_def
+             cong: if_cong Structures_H.thread_state.case_cong)
+  apply (wp hoare_drop_imps delete_one_sch_act_simple
+       | simp add: getThreadReplySlot_def | wpcw
+       | rule sch_act_simple_lift
+       | (rule_tac Q'="\<lambda>rv. sch_act_simple" in hoare_post_imp, simp))+
   done
 
 lemma cancelSignal_st_tcb_at:
-  assumes [simp]: "P Inactive" shows
+  assumes x[simp]: "P Inactive" shows
   "\<lbrace>st_tcb_at' P t\<rbrace>
      cancelSignal t' ntfn
    \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
@@ -1997,12 +941,19 @@ lemma cancelSignal_st_tcb_at:
    apply clarsimp+
   done
 
-lemma cancelIPC_st_tcb_at:
-  assumes [simp]: "\<And>st. simple' st \<longrightarrow> P st" shows
-  "cancelIPC t' \<lbrace>st_tcb_at' P t\<rbrace>"
-  unfolding cancelIPC_def
-  apply (wpsimp wp: blockedCancelIPC_st_tcb_at replyRemoveTCB_st_tcb_at'_cases
-                    cancelSignal_st_tcb_at threadSet_pred_tcb_no_state gts_wp')
+lemma (in delete_one_conc_pre) cancelIPC_st_tcb_at:
+  assumes x[simp]: "\<And>st. simple' st \<longrightarrow> P st" shows
+  "\<lbrace>st_tcb_at' P t\<rbrace>
+     cancelIPC t'
+   \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
+  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def
+             cong: if_cong Structures_H.thread_state.case_cong)
+  apply (rule bind_wp [OF _ gts_sp'])
+  apply (case_tac rv, simp_all add: isTS_defs list_case_If)
+         apply (wp sts_st_tcb_at'_cases delete_one_st_tcb_at
+                   threadSet_pred_tcb_no_state
+                   cancelSignal_st_tcb_at hoare_drop_imps
+                | clarsimp simp: o_def if_fun_split)+
   done
 
 lemma weak_sch_act_wf_lift_linear:
@@ -2015,6 +966,12 @@ lemma weak_sch_act_wf_lift_linear:
   apply simp_all
   done
 
+lemma sts_sch_act_not[wp]:
+  "\<lbrace>sch_act_not t\<rbrace> setThreadState st t' \<lbrace>\<lambda>rv. sch_act_not t\<rbrace>"
+  apply (simp add: setThreadState_def rescheduleRequired_def)
+  apply (wp hoare_drop_imps | simp | wpcw)+
+  done
+
 crunch cancelSignal, setBoundNotification
   for sch_act_not[wp]: "sch_act_not t"
   (wp: crunch_wps)
@@ -2025,17 +982,71 @@ lemma cancelSignal_tcb_at_runnable':
   unfolding cancelSignal_def
   by (wpsimp wp: sts_pred_tcb_neq' hoare_drop_imp)
 
-lemma setThreadState_st_tcb_at'_test_unaffected:
-  "\<lbrace>\<lambda>s. st_tcb_at' test t s \<and> test st\<rbrace>
-   setThreadState st t'
-   \<lbrace>\<lambda>_. st_tcb_at' test t\<rbrace>"
-  apply (wpsimp wp: sts_st_tcb')
-  done
+lemma cancelAllIPC_tcb_at_runnable':
+  "\<lbrace>st_tcb_at' runnable' t\<rbrace> cancelAllIPC epptr \<lbrace>\<lambda>_. st_tcb_at' runnable' t\<rbrace>"
+  unfolding cancelAllIPC_def
+  by (wpsimp wp: mapM_x_wp' sts_st_tcb' hoare_drop_imp)
+
+lemma cancelAllSignals_tcb_at_runnable':
+  "\<lbrace>st_tcb_at' runnable' t\<rbrace> cancelAllSignals ntfnptr \<lbrace>\<lambda>_. st_tcb_at' runnable' t\<rbrace>"
+  unfolding cancelAllSignals_def
+  by (wpsimp wp: mapM_x_wp' sts_st_tcb' hoare_drop_imp)
 
 crunch unbindNotification, bindNotification, unbindMaybeNotification
   for st_tcb_at'[wp]: "st_tcb_at' P p"
   (wp: threadSet_pred_tcb_no_state ignore: threadSet)
 
+lemma (in delete_one_conc_pre) finaliseCap_tcb_at_runnable':
+  "\<lbrace>st_tcb_at' runnable' t\<rbrace> finaliseCap cap final True \<lbrace>\<lambda>_. st_tcb_at' runnable' t\<rbrace>"
+  apply (clarsimp simp add: finaliseCap_def Let_def)
+  apply (rule conjI | clarsimp | wp cancelAllIPC_tcb_at_runnable' getObject_ntfn_inv
+                                    cancelAllSignals_tcb_at_runnable'
+       | wpc)+
+  done
+
+crunch isFinalCapability
+  for pred_tcb_at'[wp]: "pred_tcb_at' proj st t"
+  (simp: crunch_simps)
+
+lemma (in delete_one_conc_pre) cteDeleteOne_tcb_at_runnable':
+  "\<lbrace>st_tcb_at' runnable' t\<rbrace> cteDeleteOne callerCap \<lbrace>\<lambda>_. st_tcb_at' runnable' t\<rbrace>"
+  apply (simp add: cteDeleteOne_def unless_def)
+  apply (wp finaliseCap_tcb_at_runnable' | clarsimp | wp (once) hoare_drop_imps)+
+  done
+
+crunch getThreadReplySlot, getEndpoint
+  for pred_tcb_at'[wp]: "pred_tcb_at' proj st t"
+
+lemma (in delete_one_conc_pre) cancelIPC_tcb_at_runnable':
+  "\<lbrace>st_tcb_at' runnable' t'\<rbrace> cancelIPC t \<lbrace>\<lambda>_. st_tcb_at' runnable' t'\<rbrace>"
+  (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (clarsimp simp: cancelIPC_def Let_def)
+  apply (case_tac "t'=t")
+   apply (rule_tac Q'="\<lambda>st. st_tcb_at' runnable' t and K (runnable' st)"
+            in bind_wp)
+    apply(case_tac rv; simp)
+   apply (wpsimp wp: sts_pred_tcb_neq')+
+           apply (rule_tac Q'="\<lambda>rv. ?PRE" in hoare_post_imp, fastforce)
+           apply (wp cteDeleteOne_tcb_at_runnable'
+                    threadSet_pred_tcb_no_state
+                    cancelSignal_tcb_at_runnable'
+                    sts_pred_tcb_neq' hoare_drop_imps
+                  | wpc | simp add: o_def if_fun_split)+
+  done
+
+crunch cancelSignal
+  for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
+  (wp: crunch_wps)
+
+lemma (in delete_one_conc_pre) cancelIPC_ksCurDomain[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> cancelIPC t \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
+apply (simp add: cancelIPC_def Let_def)
+apply (wp hoare_vcg_conj_lift delete_one_ksCurDomain
+     | wpc
+     | rule hoare_drop_imps
+     | simp add: getThreadReplySlot_def o_def if_fun_split)+
+done
+
 (* FIXME move *)
 lemma setBoundNotification_not_ntfn:
   "(\<And>tcb ntfn. P (tcb\<lparr>tcbBoundNotification := ntfn\<rparr>) \<longleftrightarrow> P tcb)
@@ -2047,41 +1058,32 @@ lemma setBoundNotification_not_ntfn:
      | simp)+
   done
 
-lemma cancelSignal_tcb_obj_at':
-  "(\<And>tcb st qd. P (tcb\<lparr>tcbState := st, tcbQueued := qd\<rparr>) \<longleftrightarrow> P tcb)
-     \<Longrightarrow> cancelSignal t word \<lbrace>obj_at' P t'\<rbrace>"
-  apply (simp add: cancelSignal_def)
-  apply (wpsimp wp: setThreadState_not_st getNotification_wp)
+lemma setBoundNotification_tcb_in_cur_domain'[wp]:
+  "\<lbrace>tcb_in_cur_domain' t'\<rbrace> setBoundNotification st t \<lbrace>\<lambda>_. tcb_in_cur_domain' t'\<rbrace>"
+  apply (simp add: tcb_in_cur_domain'_def)
+  apply (rule hoare_pre)
+  apply wps
+  apply (wp setBoundNotification_not_ntfn | simp)+
   done
 
-crunch replyRemoveTCB, cancelSignal, getBlockingObject, blockedCancelIPC
-  for obj_at'_only_st_qd_ft: "\<lambda>s. P (obj_at' (Q :: tcb \<Rightarrow> bool) t s)"
-  (simp: crunch_simps pred_tcb_at'_def wp: crunch_wps)
 
-(* FIXME: Proved outside of `crunch` because without the `[where P=P]` constraint, the
-   postcondition unifies with the precondition in a wonderfully exponential way. VER-1337 *)
-lemma cancelIPC_obj_at'_only_st_qd_ft:
-  "\<lbrace>\<lambda>s. P (obj_at' Q t' s) \<and>
-        (\<forall>upd tcb. Q (tcbState_update upd tcb) = Q tcb) \<and>
-        (\<forall>upd tcb. Q (tcbQueued_update upd tcb) = Q tcb) \<and>
-        (\<forall>upd tcb. Q (tcbFault_update upd tcb) = Q tcb)\<rbrace>
-   cancelIPC t
-   \<lbrace>\<lambda>_ s. P (obj_at' Q t' s)\<rbrace>"
-  unfolding cancelIPC_def Let_def
-  apply (wpsimp wp: scheduleTCB_obj_at'_only_st_qd_ft[where P=P]
-                    threadSet_obj_at'_only_st_qd_ft[where P=P]
-                    setThreadState_obj_at'_only_st_qd_ft[where P=P]
-                    replyUnlink_obj_at'_only_st_qd_ft[where P=P]
-                    getBlockingObject_obj_at'_only_st_qd_ft[where P=P]
-                    replyRemoveTCB_obj_at'_only_st_qd_ft[where P=P]
-                    blockedCancelIPC_obj_at'_only_st_qd_ft[where P=P]
-                    cancelSignal_obj_at'_only_st_qd_ft[where P=P]
-                    hoare_drop_imp)
-  done
-
-lemma cancelIPC_tcbDomain_obj_at':
+lemma setThreadState_tcbDomain_obj_at'[wp]:
+  "setThreadState ts t \<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
+  unfolding setThreadState_def
+  by wpsimp
+
+crunch cancelSignal
+  for tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'"
+  (wp: crunch_wps)
+
+lemma (in delete_one_conc_pre) cancelIPC_tcbDomain_obj_at':
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace> cancelIPC t \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
-  apply (wpsimp wp: cancelIPC_obj_at'_only_st_qd_ft)
+  apply (simp add: cancelIPC_def Let_def)
+  apply (wp hoare_vcg_conj_lift
+            delete_one_tcbDomain_obj_at'
+       | wpc
+       | rule hoare_drop_imps
+       | simp add: getThreadReplySlot_def o_def if_fun_split)+
   done
 
 lemma (in delete_one_conc_pre) cancelIPC_tcb_in_cur_domain':
@@ -2092,21 +1094,59 @@ lemma (in delete_one_conc_pre) cancelIPC_tcb_in_cur_domain':
    apply (wp cancelIPC_tcbDomain_obj_at' | simp)+
   done
 
+lemma (in delete_one_conc_pre) cancelIPC_sch_act_not:
+  "\<lbrace>sch_act_not t'\<rbrace> cancelIPC t \<lbrace>\<lambda>_. sch_act_not t'\<rbrace>"
+  apply (simp add: cancelIPC_def Let_def)
+  apply (wp hoare_vcg_conj_lift
+            delete_one_sch_act_not
+       | wpc
+       | simp add: getThreadReplySlot_def o_def if_apply_def2
+              split del: if_split
+       | rule hoare_drop_imps)+
+  done
+
+lemma (in delete_one_conc_pre) cancelIPC_weak_sch_act_wf:
+  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
+      cancelIPC t
+   \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (rule weak_sch_act_wf_lift_linear)
+  apply (wp cancelIPC_sch_act_not cancelIPC_tcb_in_cur_domain' cancelIPC_tcb_at_runnable')+
+  done
+
 text \<open>The suspend operation, significant as called from delete\<close>
 
-lemma setBoundNotification_tcb_in_cur_domain'[wp]:
-  "setBoundNotification st t \<lbrace>tcb_in_cur_domain' t'\<rbrace>"
-  apply (simp add: tcb_in_cur_domain'_def)
-  apply (rule hoare_pre)
-   apply wps
-  apply (wp setBoundNotification_not_ntfn | simp)+
+lemma rescheduleRequired_weak_sch_act_wf:
+  "\<lbrace>\<top>\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: rescheduleRequired_def setSchedulerAction_def)
+  apply (wp hoare_TrueI | simp add: weak_sch_act_wf_def)+
   done
 
+lemma sts_weak_sch_act_wf[wp]:
+  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s
+        \<and> (ksSchedulerAction s = SwitchToThread t \<longrightarrow> runnable' st)\<rbrace>
+   setThreadState st t
+   \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  including classic_wp_pre
+  apply (simp add: setThreadState_def)
+  apply (wp rescheduleRequired_weak_sch_act_wf)
+  apply (rule_tac Q'="\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s" in hoare_post_imp, simp)
+  apply (simp add: weak_sch_act_wf_def)
+  apply (wp hoare_vcg_all_lift)
+   apply (wps threadSet_nosch)
+   apply (wp hoare_vcg_const_imp_lift threadSet_pred_tcb_at_state threadSet_tcbDomain_triv | simp)+
+  done
+
+lemma sbn_nosch[wp]:
+  "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
+  by (simp add: setBoundNotification_def, wp threadSet_nosch)
+
+
 lemma sbn_weak_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
    setBoundNotification ntfn t
    \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (wp weak_sch_act_wf_lift)
+  by (wp weak_sch_act_wf_lift sbn_st_tcb')
+
 
 lemma set_ep_weak_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
@@ -2123,14 +1163,25 @@ lemma setObject_ntfn_sa_unchanged[wp]:
   apply (wp | simp add: updateObject_default_def)+
   done
 
+lemma setObject_oa_unchanged[wp]:
+  "\<lbrace>\<lambda>s. obj_at' (\<lambda>tcb::tcb. P tcb) t s\<rbrace>
+    setObject ptr (ntfn::Structures_H.notification)
+   \<lbrace>\<lambda>rv s.  obj_at' P t s\<rbrace>"
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_type
+                            updateObject_default_def
+                            in_monad)
+  done
+
 lemma setNotification_weak_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
     setNotification ntfnptr ntfn
    \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   apply (wp hoare_vcg_all_lift hoare_convert_imp hoare_vcg_conj_lift
-         | simp add: weak_sch_act_wf_def st_tcb_at'_def tcb_in_cur_domain'_def)+
-   apply (wps )
-   apply (wp  | simp add: o_def)+
+         | simp add: setNotification_def weak_sch_act_wf_def st_tcb_at'_def tcb_in_cur_domain'_def)+
+   apply (rule hoare_pre)
+    apply (wps setObject_ntfn_cur_domain)
+    apply (wp setObject_ntfn_obj_at'_tcb | simp add: o_def)+
   done
 
 lemmas ipccancel_weak_sch_act_wfs
@@ -2142,7 +1193,9 @@ lemma updateObject_ep_inv:
 
 lemma asUser_tcbQueued_inv[wp]:
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace> asUser t m \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace>"
-  by (wpsimp wp: getObject_tcb_wp simp: obj_at'_def asUser_def tcb_in_cur_domain'_def threadGet_getObject)
+  apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def)
+  apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | wpc | simp | clarsimp simp: obj_at'_def)+
+  done
 
 context begin interpretation Arch .
 
@@ -2177,58 +1230,41 @@ lemma as_user_ready_qs_distinct[wp]:
   apply (wpsimp wp: set_object_wp)
   by (clarsimp simp: ready_qs_distinct_def)
 
-crunch ThreadDecls_H.suspend
-  (* FIXME RT: VER-1016 *)
-  for tcb_at'_better[wp]: "\<lambda>s. P (tcb_at' t s)"
-  (rule: sch_act_simple_lift
-     wp: crunch_wps
-   simp: crunch_simps if_fun_split st_tcb_at'_def)
-
 lemma (in delete_one) suspend_corres:
   "corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
-             (SchedContext_A.suspend t) (ThreadDecls_H.suspend t)"
-  apply (simp add: SchedContext_A.suspend_def Thread_H.suspend_def)
-  apply add_sym_refs
-  apply (rule corres_stateAssert_add_assertion)
-   prefer 2
-   apply (clarsimp simp: sym_refs_asrt_def)
+        (IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
+  apply (rule corres_cross_over_guard[where P'=P' and Q="tcb_at' t and P'" for P'])
+   apply (fastforce dest!: tcb_at_cross state_relation_pspace_relation)
+  apply (simp add: IpcCancel_A.suspend_def Thread_H.suspend_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split_nor[OF cancel_ipc_corres])
-      apply (rule corres_split[OF getThreadState_corres], rename_tac state state')
-        apply (simp only: when_def)
-        apply (rule corres_split[OF corres_if])
-             apply (case_tac state; clarsimp?)
-            apply (clarsimp simp: update_restart_pc_def updateRestartPC_def)
+      apply (rule corres_split[OF getThreadState_corres])
+        apply (rule corres_split_nor)
+           apply (rule corres_if)
+             apply (case_tac state; simp)
+            apply (simp add: update_restart_pc_def updateRestartPC_def)
             apply (rule asUser_corres')
             apply (simp add: ARM.nextInstructionRegister_def ARM.faultRegister_def
-                             ARM_H.nextInstructionRegister_def ARM_H.faultRegister_def
-                             ARM_H.Register_def)
+                             ARM_H.nextInstructionRegister_def ARM_H.faultRegister_def)
+            apply (simp add: ARM_H.Register_def)
+            apply (subst unit_dc_is_eq)
             apply (rule corres_underlying_trivial)
             apply (wpsimp simp: ARM.setRegister_def ARM.getRegister_def)
-           apply (rule corres_rel_imp)
-            apply (rule corres_return_trivial)
-           apply simp
-          apply (rule corres_split[OF setThreadState_corres], simp)
-            apply (rule corres_split[OF tcbSchedDequeue_corres'])
-              apply (rule corres_split[OF tcbReleaseRemove_corres], simp)
-                apply (rule schedContextCancelYieldTo_corres)
-               apply wpsimp+
-          apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)
-          apply (rule hoare_post_imp[where Q'="\<lambda>rv s. invs s \<and> tcb_at t s"], fastforce)
-          apply wp
-         apply wpsimp
-        apply (rule hoare_post_imp[where Q'="\<lambda>rv s. invs' s \<and> tcb_at' t s"])
-         apply (fastforce simp: invs'_def dest!: valid_queues_inQ_queues)
-        apply wp
-         apply (clarsimp simp: updateRestartPC_def)
-         apply wpsimp
-        apply wpsimp
-       apply (wpsimp wp: gts_wp)
-      apply (wpsimp wp: gts_wp')
-     apply (rule hoare_post_imp[where Q'="\<lambda>rv s. invs s \<and> tcb_at t s"], fastforce)
-     apply wpsimp
-    apply (rule hoare_post_imp[where Q'="\<lambda>rv s. invs' s \<and> tcb_at' t s"], fastforce)
-    apply (wpsimp wp: hoare_drop_imps)+
+           apply (rule corres_return_trivial)
+          apply (rule corres_split_nor[OF setThreadState_corres])
+             apply wpsimp
+            apply (rule tcbSchedDequeue_corres, simp)
+           apply wp
+          apply (wpsimp wp: sts_valid_objs')
+          apply (wpsimp simp: update_restart_pc_def updateRestartPC_def valid_tcb_state'_def)+
+       apply (rule hoare_post_imp[where Q'="\<lambda>rv s. einvs s \<and> tcb_at t s"])
+        apply (simp add: invs_implies invs_strgs valid_queues_in_correct_ready_q
+                         valid_queues_ready_qs_distinct valid_sched_def)
+       apply wp
+      apply (rule hoare_post_imp[where Q'="\<lambda>_ s. invs' s \<and> tcb_at' t s"])
+       apply (fastforce simp: invs'_def valid_tcb_state'_def)
+      apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
+   apply fastforce+
   done
 
 lemma (in delete_one) prepareThreadDelete_corres:
@@ -2236,59 +1272,29 @@ lemma (in delete_one) prepareThreadDelete_corres:
         (prepare_thread_delete t) (ArchRetypeDecls_H.ARM_H.prepareThreadDelete t)"
   by (simp add: ArchVSpace_A.ARM_A.prepare_thread_delete_def ArchRetype_H.ARM_H.prepareThreadDelete_def)
 
-lemma rescheduleRequired_oa_queued:
-  "\<lbrace> (\<lambda>s. P (obj_at' (\<lambda>tcb. Q (tcbQueued tcb) (tcbDomain tcb) (tcbPriority tcb)) t' s)) and sch_act_simple\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_ s. P (obj_at' (\<lambda>tcb. Q (tcbQueued tcb) (tcbDomain tcb) (tcbPriority tcb)) t' s)\<rbrace>"
-  (is "\<lbrace>?OAQ t' p and sch_act_simple\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (simp add: rescheduleRequired_def sch_act_simple_def)
-  apply (rule_tac Q'="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                       \<and> ?OAQ t' p s" in bind_wp)
-   including classic_wp_pre
-   apply (wp | clarsimp)+
-   apply (case_tac x)
-     apply (wp | clarsimp)+
-  done
-
-
-(* FIXME: rename uses of setThreadState_oa_queued; the "_queued" suffix doesn't make sense
-   any more. VER-1332 *)
-lemmas setThreadState_oa_queued = setThreadState_oa
-
-lemma setBoundNotification_oa_queued:
-  "\<lbrace>\<lambda>s. P' (obj_at' (\<lambda>tcb. P (tcbQueued tcb) (tcbDomain tcb) (tcbPriority tcb)) t' s) \<rbrace>
-    setBoundNotification ntfn t
-   \<lbrace>\<lambda>_ s. P' (obj_at' (\<lambda>tcb. P (tcbQueued tcb) (tcbDomain tcb) (tcbPriority tcb)) t' s) \<rbrace>"
-  (is "\<lbrace>\<lambda>s. P' (?Q P s)\<rbrace> _ \<lbrace>\<lambda>_ s. P' (?Q P s)\<rbrace>")
-  proof (rule P_bool_lift [where P=P'])
-    show pos:
-      "\<And>R. \<lbrace> ?Q R \<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>_. ?Q R \<rbrace>"
-      apply (simp add: setBoundNotification_def)
-      apply (wp threadSet_obj_at'_strongish)
-      apply (clarsimp)
-      done
-    show "\<lbrace>\<lambda>s. \<not> ?Q P s\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>_ s. \<not> ?Q P s\<rbrace>"
-      by (simp add: not_obj_at' comp_def, wp hoare_convert_imp pos)
-  qed
+lemma no_refs_simple_strg':
+  "st_tcb_at' simple' t s' \<and> P {} \<longrightarrow> st_tcb_at' (\<lambda>st. P (tcb_st_refs_of' st)) t s'"
+  by (fastforce elim!: pred_tcb'_weakenE)+
 
-lemma tcbSchedDequeue_t_notksQ:
-  "\<lbrace>\<lambda>s. t \<in> set (ksReadyQueues s (d, p)) \<longrightarrow>
-           obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t s\<rbrace>
-    tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. t \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
-  apply (rule_tac P'="(\<lambda>s. t \<notin> set (ksReadyQueues s (d, p)))
-                            or obj_at'(\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d \<and> tcbPriority tcb = p) t"
-               in hoare_pre_imp, clarsimp)
-  apply (rule hoare_pre_disj)
-   apply (wp tcbSchedDequeue_notksQ)[1]
-  apply (simp add: tcbSchedDequeue_def  removeFromBitmap_conceal_def[symmetric])
-  apply wp
-        apply (rule hoare_pre_post, assumption)
-        apply (clarsimp simp: bitmap_fun_defs removeFromBitmap_conceal_def, wp, clarsimp)
-       apply (wp threadGet_wp)+
-  apply (auto simp: obj_at'_real_def ko_wp_at'_def)
+crunch cancelSignal
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma (in delete_one_conc_pre) cancelIPC_it[wp]:
+  "\<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace>
+   cancelIPC t
+   \<lbrace>\<lambda>_ s. P (ksIdleThread s)\<rbrace>"
+  apply (simp add: cancelIPC_def Let_def getThreadReplySlot_def)
+  apply (wp hoare_drop_imps delete_one_it | wpc | simp add:if_apply_def2 Fun.comp_def)+
   done
 
+crunch threadGet
+  for ksQ: "\<lambda>s. P (ksReadyQueues s p)"
+
+crunch tcbSchedDequeue
+  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
+  (wp: crunch_wps)
+
 lemma asUser_sch_act_simple[wp]:
   "\<lbrace>sch_act_simple\<rbrace> asUser s t \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
   unfolding sch_act_simple_def
@@ -2296,27 +1302,40 @@ lemma asUser_sch_act_simple[wp]:
   done
 
 lemma (in delete_one_conc) suspend_invs'[wp]:
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
-   ThreadDecls_H.suspend t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>" (is "valid ?pre _ _")
-  apply (simp add: suspend_def updateRestartPC_def getThreadState_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule_tac Q'="\<lambda>_. ?pre and st_tcb_at' simple' t"
-               in bind_wp_fwd)
-   apply (wpsimp wp: cancelIPC_simple)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule bind_wp_fwd_skip)
-   apply clarsimp
-   apply (wpsimp simp: updateRestartPC_def)
-  apply (rule_tac Q'="\<lambda>_. ?pre and st_tcb_at' ((=) Inactive) t"
-               in bind_wp_fwd)
-   apply (wpsimp wp: sts_invs_minor' sts_st_tcb_at'_cases)
-   apply (fastforce elim: pred_tcb'_weakenE)
-  apply (wpsimp wp: tcbReleaseRemove_invs' schedContextCancelYieldTo_invs')
+  "\<lbrace>invs' and sch_act_simple and tcb_at' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
+   ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: suspend_def)
+  apply (wpsimp wp: sts_invs_minor' gts_wp' simp: updateRestartPC_def
+         | strengthen no_refs_simple_strg')+
+   apply (rule_tac Q'="\<lambda>_. invs' and sch_act_simple and st_tcb_at' simple' t
+                          and (\<lambda>s. t \<noteq> ksIdleThread s)"
+                in hoare_post_imp)
+    apply clarsimp
+   apply wpsimp
+  apply (fastforce elim: pred_tcb'_weakenE)
+  done
+
+lemma (in delete_one_conc_pre) suspend_tcb'[wp]:
+  "\<lbrace>tcb_at' t'\<rbrace> ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
+  apply (simp add: suspend_def unless_def)
+  apply wp
+      apply (wpsimp simp: updateRestartPC_def)
+     apply (wp hoare_drop_imps |clarsimp|rule conjI)+
+  done
+
+lemma (in delete_one_conc_pre) suspend_sch_act_simple[wp]:
+  "\<lbrace>sch_act_simple\<rbrace>
+  ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
+  apply (simp add: suspend_def when_def updateRestartPC_def)
+  apply (wp cancelIPC_sch_act_simple | simp add: unless_def
+       | rule sch_act_simple_lift)+
+      apply (simp add: updateRestartPC_def)
+      apply (rule asUser_nosch)
+     apply wpsimp+
   done
 
 lemma (in delete_one_conc) suspend_objs':
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
+  "\<lbrace>invs' and sch_act_simple and tcb_at' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
    suspend t \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post)
    apply (wp suspend_invs')
@@ -2332,7 +1351,7 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
   apply (wp sts_st_tcb_at'_cases threadSet_pred_tcb_no_state
             cancelIPC_st_tcb_at hoare_drop_imps asUser_pred_tcb_at' x
          | simp)+
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
+  apply clarsimp
   done
 
 lemmas (in delete_one_conc_pre) suspend_makes_simple' =
@@ -2345,6 +1364,9 @@ lemma suspend_makes_inactive:
   apply (wp threadSet_pred_tcb_no_state setThreadState_st_tcb | simp)+
   done
 
+declare threadSet_sch_act_sane [wp]
+declare setThreadState_sch_act_sane [wp]
+
 lemma tcbSchedEnqueue_sch_act_not_ct[wp]:
   "\<lbrace>\<lambda>s. sch_act_not (ksCurThread s) s\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_ s. sch_act_not (ksCurThread s) s\<rbrace>"
   by (rule hoare_weaken_pre, wps, wp, simp)
@@ -2356,521 +1378,154 @@ lemma sts_sch_act_not_ct[wp]:
 
 text \<open>Cancelling all IPC in an endpoint or notification object\<close>
 
-global_interpretation refillUnblockCheck: typ_at_all_props' "refillUnblockCheck scp"
-  by typ_at_props'
+lemma ep_cancel_corres_helper:
+  "corres dc ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and valid_etcbs 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
+                        y \<leftarrow> set_thread_state t Structures_A.Restart;
+                        tcb_sched_action tcb_sched_enqueue t
+                     od) list)
+          (mapM_x (\<lambda>t. do
+                        y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
+                        tcbSchedEnqueue t
+                     od) list)"
+  apply (rule_tac Q'=pspace_aligned' in corres_cross_add_guard)
+   apply (fastforce dest: pspace_aligned_cross)
+  apply (rule_tac Q'=pspace_distinct' in corres_cross_add_guard)
+   apply (fastforce dest: pspace_distinct_cross)
+  apply (rule_tac S="{t. (fst t = snd t) \<and> fst t \<in> set list}"
+                     in corres_mapM_x)
+      apply clarsimp
+      apply (rule corres_guard_imp)
+        apply (subst bind_return_unit, rule corres_split[OF _ tcbSchedEnqueue_corres])
+           apply simp
+           apply (rule corres_guard_imp [OF setThreadState_corres])
+             apply simp
+            apply (simp add: valid_tcb_state_def)
+           apply simp
+          apply simp
+         apply (wpsimp wp: sts_st_tcb_at')
+        apply (wpsimp wp: sts_valid_objs' | strengthen valid_objs'_valid_tcbs')+
+       apply fastforce
+      apply (wpsimp wp: hoare_vcg_const_Ball_lift set_thread_state_runnable_valid_queues
+                        sts_st_tcb_at' sts_valid_objs'
+                  simp: valid_tcb_state'_def)+
+  done
 
-global_interpretation ifCondRefillUnblockCheck: typ_at_all_props' "ifCondRefillUnblockCheck scp act ast"
-  by typ_at_props'
+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)
 
-lemma updateSchedContext_valid_tcbs'[wp]:
-  "updateSchedContext scp f \<lbrace> valid_tcbs' \<rbrace>"
-  unfolding updateSchedContext_def setSchedContext_def getSchedContext_def
-  apply (wpsimp wp: setObject_valid_tcbs'[where P=\<top>])
-    apply (clarsimp simp: projectKOs updateObject_default_def in_monad)
-   apply (wpsimp wp: getObject_inv)
-  by simp
-
-lemma valid_refills'_tcbQueued_update[simp]:
-  "scp \<noteq> t \<Longrightarrow>
-   valid_refills' scp
-            (s\<lparr>ksPSpace := (ksPSpace s)(t \<mapsto> KOTCB (tcbQueued_update (\<lambda>_. True) tcb))\<rparr>)
-   = valid_refills' scp s"
-  by (clarsimp simp: valid_refills'_def opt_pred_def)
-
-lemma threadSet_valid_refills'[wp]:
-  "threadSet f tp \<lbrace> valid_refills' scp \<rbrace>"
-  apply (wpsimp wp: threadSet_wp)
-  by (clarsimp simp: valid_refills'_def projectKOs obj_at'_def opt_pred_def
-              dest!: opt_predD split: kernel_object.splits option.splits
-              elim!: opt_mapE)
-
-crunch setThreadState
-  for valid_refills'[wp]: "valid_refills' scp"
-
-crunch ifCondRefillUnblockCheck
-  for valid_objs'[wp]: valid_objs'
-  and valid_tcbs'[wp]: valid_tcbs'
-  (wp: hoare_vcg_if_lift2 crunch_wps simp: crunch_simps)
-
-lemma restart_thread_if_no_fault_corres:
-  "corres dc (valid_sched_action and tcb_at t and pspace_aligned and pspace_distinct
-              and valid_tcbs and active_scs_valid and current_time_bounded)
-             (valid_queues and valid_queues' and valid_release_queue_iff and valid_objs')
-             (restart_thread_if_no_fault t)
-             (restartThreadIfNoFault t)"
-    (is "corres _ _ ?conc_guard _ _")
-  apply (rule corres_cross_over_guard[where Q="?conc_guard and tcb_at' t"])
-   apply (fastforce intro: tcb_at_cross)
-  apply (clarsimp simp: restart_thread_if_no_fault_def restartThreadIfNoFault_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split
-                  [OF threadGet_corres[where r=fault_rel_optionation] _ thread_get_wp threadGet_wp])
-     apply (clarsimp simp: tcb_relation_def)
-    apply (rule corres_if)
-      apply (clarsimp simp: fault_rel_optionation_def)
-     apply (rule corres_split[OF setThreadState_corres])
-        apply (clarsimp simp: fault_rel_optionation_def)
-       apply clarsimp
-       apply (rule corres_split_eqr[OF get_tcb_obj_ref_corres])
-          apply (clarsimp simp: tcb_relation_def)
-         apply (rule corres_split[OF ifCondRefillUnblockCheck_corres])
-           apply (rule possibleSwitchTo_corres, simp)
-          apply (wpsimp simp: if_cond_refill_unblock_check_def
-                          wp: refill_unblock_check_active_scs_valid)
-         apply wpsimp
-        apply (rule_tac Q'="\<lambda>scopt s. case_option True (\<lambda>p. sc_at p s) scopt \<and>
-                                     tcb_at t s \<and> valid_sched_action s \<and>
-                                     pspace_aligned s \<and> pspace_distinct s \<and> valid_tcbs s \<and>
-                                     active_scs_valid s \<and> current_time_bounded s"
-               in hoare_strengthen_post[rotated])
-         apply (fastforce split: option.splits simp: obj_at_def is_sc_obj opt_map_red opt_pred_def)
-        apply (wpsimp wp: thread_get_wp' simp: get_tcb_obj_ref_def)
-       apply (clarsimp simp: bool.case_eq_if option.case_eq_if)
-       apply (wpsimp wp: threadGet_wp)
-      apply (rule_tac Q'="\<lambda>scopt s. tcb_at t s \<and> valid_sched_action s \<and>
-                                   pspace_aligned s \<and> pspace_distinct s \<and> valid_tcbs s \<and>
-                                   active_scs_valid s \<and> current_time_bounded s"
-             in hoare_strengthen_post[rotated])
-       apply (fastforce split: option.split simp: valid_tcbs_def valid_tcb_def valid_bound_obj_def)
-      apply (wpsimp wp: sts_typ_ats set_thread_state_valid_sched_action)
-     apply (rule hoare_strengthen_post[where Q'="\<lambda>_ s. tcb_at' t s \<and> valid_objs' s
-                                                    \<and> valid_release_queue_iff s
-                                                    \<and> valid_queues s \<and> valid_queues' s", rotated])
-      apply (clarsimp simp: obj_at_simps)
-     apply (wpsimp wp: sts_st_tcb_at'_cases hoare_drop_imp)
-    apply (rule setThreadState_corres)
-    apply clarsimp
-   apply (clarsimp simp: obj_at_def is_tcb_def invs_def valid_state_def)
-   apply (clarsimp split: Structures_A.kernel_object.splits)
-  apply (clarsimp simp: obj_at'_def projectKOs valid_tcb_state'_def)
-  done
-
-crunch possibleSwitchTo
-  for sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-
-global_interpretation possibleSwitchTo: typ_at_all_props' "possibleSwitchTo target"
-  by typ_at_props'
-
-crunch ifCondRefillUnblockCheck
-  for pred_tcb_at'[wp]: "pred_tcb_at' proj P p"
-  and weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-  and cur_tcb'[wp]: cur_tcb'
-  (simp: crunch_simps wp: whileLoop_wp)
-
-lemma cancelAllIPC_loop_body_st_tcb_at'_other:
-  "\<lbrace>\<lambda>s. st_tcb_at' P t' s \<and> tcb_at' t' s \<and> t' \<noteq> t\<rbrace>
-   cancelAllIPC_loop_body t
-   \<lbrace>\<lambda>_. st_tcb_at' P t'\<rbrace>"
-  apply (clarsimp simp: cancelAllIPC_loop_body_def restartThreadIfNoFault_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule bind_wp_fwd_skip, wpsimp wp: replyUnlink_st_tcb_at')
-  apply (wpsimp wp: threadGet_wp)
-     apply (rule hoare_strengthen_post[where Q'="\<lambda>_. st_tcb_at' P t'", rotated])
-      apply (clarsimp simp: obj_at'_def)
-     apply (wpsimp wp: sts_st_tcb_at'_cases threadGet_wp)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma cancelAllIPC_loop_body_weak_sch_act_wf:
-  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<and> tcb_at' t s \<and> st_tcb_at' (not runnable') t s\<rbrace>
-   cancelAllIPC_loop_body t
-   \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (clarsimp simp: cancelAllIPC_loop_body_def restartThreadIfNoFault_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule bind_wp_fwd_skip, wpsimp wp: replyUnlink_st_tcb_at')
-  apply (wpsimp wp: sts_st_tcb_at'_cases hoare_drop_imps)
-  apply (clarsimp simp: weak_sch_act_wf_def pred_neg_def st_tcb_at'_def obj_at'_def)
-  done
-
-crunch cancelAllIPC_loop_body
-  for valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and valid_objs'[wp]: valid_objs'
-  and tcb_at'[wp]: "\<lambda>s. tcb_at' threadPtr s"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (simp: valid_tcb_state'_def crunch_simps wp: whileLoop_wp ignore: updateSchedContext)
-
-global_interpretation cancelAllIPC_loop_body: typ_at_all_props' "cancelAllIPC_loop_body t"
-  by typ_at_props'
-
-lemma cancelAllIPC_loop_body_valid_queues:
-  "\<lbrace>\<lambda>s. valid_queues s \<and> valid_tcbs' s\<rbrace>
-   cancelAllIPC_loop_body t
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (clarsimp simp: cancelAllIPC_loop_body_def restartThreadIfNoFault_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-   apply (clarsimp simp: weak_sch_act_wf_def pred_neg_def st_tcb_at'_def obj_at'_def)
-  apply (wpsimp wp: sts_valid_queues sts_st_tcb_at'_cases hoare_drop_imps)
-  done
-
-lemma cancelAllIPC_corres_helper:
-  "distinct list \<Longrightarrow>
-   corres dc
-          ((\<lambda>s. \<forall>t \<in> set list. blocked_on_send_recv_tcb_at t s \<and> t \<noteq> idle_thread s
-                               \<and> reply_unlink_ts_pred t s)
-            and (valid_sched and valid_tcbs and pspace_aligned and pspace_distinct
-                 and current_time_bounded and (\<lambda>s. heap_refs_inv (tcb_scps_of s) (sc_tcbs_of s))))
-          ((\<lambda>s. \<forall>t \<in> set list. tcb_at' t s)
-            and (valid_queues and valid_queues' and valid_objs' and valid_release_queue_iff))
-     (mapM_x cancel_all_ipc_loop_body list)
-     (mapM_x cancelAllIPC_loop_body list)"
-  unfolding cancel_all_ipc_loop_body_def cancelAllIPC_loop_body_def
-  apply (rule_tac S="{t. (fst t = snd t) \<and> fst t \<in> set list}" in corres_mapM_x_scheme)
-          apply clarsimp
-          apply (rename_tac t)
-          apply (rule corres_guard_imp)
-            apply (rule corres_split[OF getThreadState_corres], rename_tac st st')
-              apply (rule_tac P="\<lambda>s. blocked_on_send_recv_tcb_at t s \<and> t \<noteq> idle_thread s
-                                     \<and> reply_unlink_ts_pred t s \<and> valid_sched s \<and> valid_tcbs s
-                                     \<and> pspace_aligned s \<and> pspace_distinct s
-                                     \<and> st_tcb_at ((=) st) t s \<and> current_time_bounded s"
-                          and P'="\<lambda>s. valid_queues s \<and> valid_queues' s \<and> valid_objs' s
-                                      \<and> valid_release_queue_iff s"
-                           in corres_inst)
-              apply (case_tac "\<exists>ep r_opt pl.
-                                st = Structures_A.thread_state.BlockedOnReceive ep r_opt pl")
-               apply (clarsimp simp: when_def split: option.splits)
-               apply (intro conjI impI allI; clarsimp simp: isReceive_def)
-                apply (corresKsimp corres: restart_thread_if_no_fault_corres)
-                apply (clarsimp simp: pred_tcb_at_def obj_at_def is_tcb valid_sched_def)
-               apply (rule corres_guard_imp)
-                 apply (rule corres_split[OF replyUnlinkTcb_corres])
-                    apply (rule corres_guard_imp)
-                      apply (rule restart_thread_if_no_fault_corres)
-                     apply simp
-                    apply simp
-                  apply (wpsimp wp: reply_unlink_tcb_valid_sched_action)
-                 apply wpsimp
-                apply (fastforce simp: vs_all_heap_simps pred_tcb_at_def obj_at_def
-                                       reply_unlink_ts_pred_def)
-               apply clarsimp
-              apply (prop_tac "\<not> isReceive st'")
-               apply (case_tac st; clarsimp simp: isReceive_def)
-              apply (case_tac st
-                     ; clarsimp simp: isReceive_def
-                     ; (corresKsimp corres: restart_thread_if_no_fault_corres
-                        , fastforce simp: obj_at_def))
-             apply (wpsimp wp: gts_wp)
-            apply (wpsimp wp: gts_wp')
-           apply (clarsimp simp: vs_all_heap_simps obj_at_def is_tcb_def)
-          apply clarsimp
-         apply (fold cancel_all_ipc_loop_body_def)
-         apply (intro hoare_vcg_conj_lift_pre_fix
-                ; (solves \<open>wpsimp wp: gts_wp simp: cancel_all_ipc_loop_body_def\<close>)?)
-          apply (wpsimp wp: restart_thread_if_no_fault_tcb_sts_of_other
-                            reply_unlink_tcb_tcb_sts_of_other gts_wp
-                      simp: cancel_all_ipc_loop_body_def)
-         apply (wpsimp wp: cancel_all_ipc_loop_body_reply_unlink_ts_pred_other)
-        apply (wpsimp simp: restartThreadIfNoFault_def)
-       apply (wpsimp wp: cancel_all_ipc_loop_body_valid_sched gts_wp
-                   simp: cancel_all_ipc_loop_body_def)
-      apply (fold cancelAllIPC_loop_body_def)
-      apply (wpsimp wp: cancelAllIPC_loop_body_weak_sch_act_wf cancelAllIPC_loop_body_valid_queues)
-     apply fastforce+
-  done
-
-lemmas reply_unlink_tcb_typ_at_lifts[wp] = abs_typ_at_lifts[OF reply_unlink_tcb_typ_at]
-
-lemma in_send_ep_queue_TCBBlockedSend:
-  "\<lbrakk>kheap s epptr = Some (Endpoint (Structures_A.SendEP queue)); t \<in> set queue; invs s\<rbrakk>
-   \<Longrightarrow> (epptr, TCBBlockedSend) \<in> state_refs_of s t"
-  apply (prop_tac "valid_ep (Structures_A.SendEP queue) s")
-   apply (fastforce simp: valid_objs_def valid_obj_def dest!: invs_valid_objs)
-  apply (clarsimp simp: state_refs_of_def valid_ep_def split: option.splits)
-  apply (intro conjI impI allI; (fastforce simp: obj_at_def)?)
-  apply (prop_tac "(t, EPSend) \<in> state_refs_of s epptr", clarsimp simp: state_refs_of_def)
-  apply (clarsimp simp: sym_refs_def dest!: invs_sym_refs)
-  apply (fastforce simp: state_refs_of_def)
-  done
-
-lemma cancelAllIPC_corres:
-  "corres dc (invs and valid_sched and ep_at ep_ptr and current_time_bounded)
-             (invs' and ep_at' ep_ptr)
-             (cancel_all_ipc ep_ptr) (cancelAllIPC ep_ptr)"
+lemma ep_cancel_corres:
+  "corres dc (invs and valid_sched and ep_at ep) (invs' and ep_at' ep)
+             (cancel_all_ipc ep) (cancelAllIPC ep)"
 proof -
   have P:
-    "\<And>list. distinct list \<Longrightarrow>
-         corres dc
-          ((\<lambda>s. \<forall>t \<in> set list. blocked_on_send_recv_tcb_at t s \<and> t \<noteq> idle_thread s
-                               \<and> reply_unlink_ts_pred t s)
-            and (valid_sched and valid_tcbs and pspace_aligned and pspace_distinct and ep_at ep_ptr
-                 and current_time_bounded and (\<lambda>s. heap_refs_inv (tcb_scps_of s) (sc_tcbs_of s))))
-          ((\<lambda>s. \<forall>t \<in> set list. tcb_at' t s)
-            and (valid_queues and valid_queues' and valid_objs' and valid_release_queue_iff
-                 and ep_at' ep_ptr))
-     (do set_endpoint ep_ptr Structures_A.IdleEP;
-         mapM_x cancel_all_ipc_loop_body list;
-         reschedule_required
-      od)
-     (do setEndpoint ep_ptr IdleEP;
-         mapM_x cancelAllIPC_loop_body list;
-         rescheduleRequired
-     od)" (is "\<And>list. _ \<Longrightarrow> corres _ (?abs_guard list) (?conc_guard list) _ _")
-    apply (rule corres_guard_imp)
-      apply (rule corres_split[OF setEndpoint_corres])
-         apply (simp add: ep_relation_def)
-        apply clarsimp
-        apply (rule corres_split)
-           apply (erule cancelAllIPC_corres_helper)
-          apply (rule rescheduleRequired_corres)
-         apply (rule_tac P'="?abs_guard list" in hoare_weaken_pre)
-          apply (rule hoare_strengthen_post)
-           apply (rule ball_mapM_x_scheme)
-             apply (intro hoare_vcg_conj_lift_pre_fix
-                    ; (solves \<open>wpsimp wp: gts_wp simp: cancel_all_ipc_loop_body_def\<close>)?)
-              apply (wpsimp wp: restart_thread_if_no_fault_tcb_sts_of_other
-                                reply_unlink_tcb_tcb_sts_of_other gts_wp
-                          simp: cancel_all_ipc_loop_body_def)
-             apply (wpsimp wp: cancel_all_ipc_loop_body_reply_unlink_ts_pred_other)
-            apply (wpsimp wp: cancel_all_ipc_loop_body_valid_sched gts_wp
-                        simp: cancel_all_ipc_loop_body_def)
-           apply simp
-          apply fastforce
-         apply simp
-        apply (rule_tac P'="?conc_guard list" in hoare_weaken_pre)
-         apply (rule hoare_strengthen_post)
-          apply (rule ball_mapM_x_scheme)
-            apply (wpsimp wp: cancelAllIPC_loop_body_st_tcb_at'_other)
-           apply (wpsimp wp: cancelAllIPC_loop_body_weak_sch_act_wf
-                             cancelAllIPC_loop_body_valid_queues
-                             cancelAllIPC_loop_body_st_tcb_at'_other)
-          apply (simp add: valid_objs'_valid_tcbs')+
-       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_const_Ball_lift hoare_vcg_imp_lift'
-                   simp: reply_unlink_ts_pred_def)+
-    apply (clarsimp simp: valid_ep'_def)
+    "\<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)
+               (\<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)
+               (do x \<leftarrow> set_endpoint ep Structures_A.IdleEP;
+                   x \<leftarrow> mapM_x (\<lambda>t. do
+                        y \<leftarrow> set_thread_state t Structures_A.Restart;
+                        tcb_sched_action tcb_sched_enqueue t
+                     od) list;
+                   reschedule_required
+               od)
+               (do x \<leftarrow> setEndpoint ep IdleEP;
+                   x \<leftarrow> mapM_x (\<lambda>t. do
+                        y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
+                        tcbSchedEnqueue t
+                     od) list;
+                   rescheduleRequired
+                od)"
+    apply (rule corres_underlying_split)
+       apply (rule corres_guard_imp [OF setEndpoint_corres])
+         apply (simp add: ep_relation_def)+
+      apply (rule corres_split[OF _ rescheduleRequired_corres])
+        apply (rule ep_cancel_corres_helper)
+       apply (rule mapM_x_wp')
+       apply (wp weak_sch_act_wf_lift_linear set_thread_state_runnable_weak_valid_sched_action | simp)+
+      apply (rule_tac Q'="\<lambda>_ s. \<forall>x\<in>set list. tcb_at' x s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                   in hoare_post_add)
+      apply (rule mapM_x_wp')
+      apply ((wpsimp wp: hoare_vcg_const_Ball_lift mapM_x_wp' sts_st_tcb' sts_valid_objs'
+                   simp: valid_tcb_state'_def
+              | strengthen valid_objs'_valid_tcbs')+)[3]
+     apply fastforce
+    apply (wp hoare_vcg_const_Ball_lift set_ep_valid_objs'
+           | (clarsimp simp: valid_ep'_def)
+           | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def valid_ep'_def
+           | strengthen valid_objs'_valid_tcbs'))+
     done
 
   show ?thesis
-    apply (clarsimp simp: cancel_all_ipc_def[folded cancel_all_ipc_loop_body_def]
-                          cancelAllIPC_def[folded restartThreadIfNoFault_def
-                                           , folded cancelAllIPC_loop_body_def])
-    apply (subst forM_x_def fun_app_def)+
-    apply add_sym_refs
-    apply (rule corres_stateAssert_add_assertion[rotated])
-     apply (clarsimp simp: pred_conj_def sym_refs_asrt_def)
-    apply add_sch_act_wf
-    apply (rule corres_stateAssert_add_assertion[rotated])
-     apply (clarsimp simp: sch_act_wf_asrt_def)
-    apply (rule corres_underlying_split[OF _ _ get_simple_ko_sp get_ep_sp'])
-     apply (rule corres_guard_imp [OF getEndpoint_corres]
-            ; simp add: ep_relation_def get_ep_queue_def)
-    apply (rename_tac ep ep')
-    apply (case_tac "ep = Structures_A.IdleEP \<or> ep' = Structures_H.IdleEP")
-     apply (case_tac ep; case_tac ep'; simp add: ep_relation_def get_ep_queue_def)
-    apply (simp add: endpoint.case_eq_if Structures_A.endpoint.case_eq_if del: K_bind_def)
-    apply (simp add: get_ep_queue_def Structures_A.endpoint.case_eq_if)
-    apply (rule_tac F="epQueue ep' = ep_queue ep \<and> distinct (ep_queue ep)" in corres_req)
-     apply (rule conjI; clarsimp)
-      apply (case_tac ep; clarsimp simp: ep_relation_def)
-     apply (drule (1) valid_objs_ko_at[OF invs_valid_objs])
-     apply (case_tac ep; clarsimp simp: valid_obj_def valid_ep_def)
-    apply simp
-    apply (rule corres_guard_imp)
-      apply (rule P[simplified])
-      apply simp
-     apply (clarsimp; rule conjI; (fastforce simp: invs_def)?)
-     apply clarsimp
-     apply (prop_tac "t \<noteq> idle_thread s")
-      apply (case_tac ep;
-             fastforce simp: obj_at_def invs_def valid_state_def valid_pspace_def
-                      dest!: not_idle_tcb_in_SendEp not_idle_tcb_in_RecvEp)
-     apply (prop_tac "st_tcb_at is_blocked_on_send_recv t s")
-      apply (case_tac ep; erule_tac t=t in ep_queued_st_tcb_at; (fastforce simp: invs_def)?)
-     apply (clarsimp simp: pred_tcb_at_disj tcb_at_kh_simps[symmetric] reply_unlink_ts_pred_def
-                           conj_disj_distribR is_blocked_on_receive_def is_blocked_on_send_def)
-     apply (fastforce simp: pred_tcb_at_def obj_at_def
-                     elim!: st_tcb_recv_reply_state_refs[OF _ invs_sym_refs, simplified op_equal])
-    apply (clarsimp simp: invs'_def valid_pspace'_def valid_objs'_valid_tcbs')
-    apply (fastforce dest!: ep_ko_at_valid_objs_valid_ep' simp: valid_ep'_def split: endpoint.split_asm)
+    apply (simp add: cancel_all_ipc_def cancelAllIPC_def)
+    apply (rule corres_stateAssert_ignore)
+     apply (fastforce intro: ksReadyQueues_asrt_cross)
+    apply (rule corres_underlying_split [OF _ _ get_simple_ko_sp get_ep_sp'])
+     apply (rule corres_guard_imp [OF getEndpoint_corres], simp+)
+    apply (case_tac epa, simp_all add: ep_relation_def
+                                       get_ep_queue_def)
+     apply (rule corres_guard_imp [OF P]
+             | clarsimp simp: valid_obj_def valid_ep_def
+                              valid_obj'_def valid_ep'_def
+                              invs_valid_pspace projectKOs
+                              valid_sched_def valid_sched_action_def
+             | erule obj_at_valid_objsE
+             | drule ko_at_valid_objs'
+             | rule conjI | clarsimp simp: invs'_def valid_state'_def)+
     done
 qed
 
-lemma ntfn_cancel_corres_helper:
-  "corres dc
-          ((\<lambda>s. \<forall>t \<in> set list. tcb_at t s \<and> t \<noteq> idle_thread s
-                               \<and> blocked_on_recv_ntfn_tcb_at t s)
-           and valid_sched
-           and valid_objs
-           and pspace_aligned
-           and pspace_distinct and (\<lambda>s. heap_refs_inv (tcb_scps_of s) (sc_tcbs_of s))
-           and cur_tcb and current_time_bounded
-           and K (distinct list))
-          ((\<lambda>s. \<forall>t \<in> set list. tcb_at' t s)
-           and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
-           and Invariants_H.valid_queues
-           and valid_queues'
-           and valid_objs'
-           and valid_release_queue_iff)
-          (mapM_x (\<lambda>t. do y \<leftarrow> set_thread_state t Structures_A.Restart;
-                          sc_opt <- get_tcb_obj_ref tcb_sched_context t;
-                          y <- if_sporadic_cur_sc_assert_refill_unblock_check sc_opt;
-                          possible_switch_to t
-                       od) list)
-          (mapM_x (\<lambda>t. do y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                          scOpt <- threadGet tcbSchedContext t;
-                          y <- ifCondRefillUnblockCheck scOpt (Some False) (Some True);
-                          possibleSwitchTo t
-                       od) list)"
-  (is "corres _ _ ?conc_guard _ _")
-  apply (rule corres_gen_asm')
-  apply (rule corres_cross_over_guard[where Q="?conc_guard and cur_tcb'"])
-   apply (fastforce simp: cur_tcb_cross)
-  apply (subst pred_conj_assoc[symmetric])+
-  apply (rule_tac S="{t. (fst t = snd t) \<and> fst t \<in> set list}" in corres_mapM_x_scheme
-         ; ((subst pred_conj_assoc)+)?)
-          apply clarsimp
-          apply (rule corres_guard_imp)
-            apply (rename_tac tp)
-            apply (rule corres_split[OF setThreadState_corres])
-               apply clarsimp
-              apply (rule corres_split_eqr[OF get_tcb_obj_ref_corres])
-                 apply (clarsimp simp: tcb_relation_def)
-                apply (rule corres_split[OF ifCondRefillUnblockCheck_corres])
-                  apply (rule possibleSwitchTo_corres, simp)
-                 apply (wpsimp simp: if_cond_refill_unblock_check_def
-                                 wp: refill_unblock_check_active_scs_valid)
-                apply wpsimp
-               apply (wpsimp wp: get_tcb_obj_ref_wp)
-              apply (wpsimp wp: threadGet_wp)
-             apply (clarsimp cong: conj_cong imp_cong all_cong)
-             apply (rule_tac Q'="\<lambda>_. pspace_aligned and pspace_distinct and current_time_bounded
-                                    and active_scs_valid and valid_tcbs
-                                    and valid_sched_action and tcb_at tp"
-                    in hoare_strengthen_post[rotated])
-              apply (fastforce simp: pred_tcb_at_def is_tcb is_sc_obj obj_at_def opt_map_red
-                                     valid_tcbs_def valid_tcb_def valid_bound_obj_def opt_pred_def
-                              split: option.splits)
-             apply (wp set_thread_state_valid_sched_action)
-            apply (simp add: option.case_eq_if bool.case_eq_if)
-            apply (rule_tac Q'="\<lambda>_. valid_queues and valid_queues' and valid_release_queue_iff
-                                   and valid_objs' and tcb_at' tp"
-                   in hoare_strengthen_post[rotated])
-             apply (clarsimp simp: valid_objs'_valid_tcbs' obj_at'_def)
-            apply (wp setThreadState_st_tcb)
-           apply force
-          apply (clarsimp simp: valid_tcb_state'_def)
-         apply (wpsimp wp: set_thread_state_pred_map_tcb_sts_of)
-        apply (wpsimp wp: typ_at_lifts)
-       apply (clarsimp simp: pred_conj_def)
-       apply (rename_tac tp)
-       apply (wpsimp wp: get_tcb_obj_ref_wp possible_switch_to_valid_sched_weak hoare_vcg_imp_lift')
-        apply (rule_tac Q'="\<lambda>_ s. tcb_at tp s \<longrightarrow>
-                                   (bound (tcb_scps_of s tp) \<longrightarrow>  not_in_release_q tp s)
-                                   \<and> current_time_bounded s
-                                   \<and> heap_refs_inv (tcb_scps_of s) (sc_tcbs_of s)
-                                   \<and> (pred_map (\<lambda>a. \<exists>y. a = Some y) (tcb_scps_of s) tp
-                                       \<and> not_in_release_q tp s
-                                           \<longrightarrow> pred_map runnable (tcb_sts_of s) tp
-                                               \<and> released_sc_tcb_at tp s
-                                               \<and> active_scs_valid s
-                                               \<and> tp \<noteq> idle_thread s)
-                                   \<and> pspace_distinct s \<and>  cur_tcb s \<and> valid_objs s
-                                   \<and>  pspace_aligned s
-                                   \<and> valid_sched_except_blocked s
-                                   \<and> valid_blocked_except tp s"
-                in hoare_strengthen_post[rotated])
-         apply (clarsimp simp: obj_at_def is_tcb vs_all_heap_simps opt_map_red)
-         apply (rename_tac scp t tcb' sc n)
-         apply (clarsimp simp: heap_refs_inv_def2)
-         apply (frule_tac x=tp and y=scp in spec2)
-         apply (drule_tac x=t and y=scp in spec2)
-         apply (clarsimp simp: pred_map_eq vs_all_heap_simps opt_map_red)
-        apply (wpsimp wp: set_thread_state_pred_map_tcb_sts_of possible_switch_to_valid_sched_weak
-                          set_thread_state_break_valid_sched[simplified pred_conj_def]
-                          hoare_vcg_imp_lift')
-       apply clarsimp
-       apply (rule conjI, clarsimp simp: tcb_at_kh_simps[symmetric])
-        apply (drule valid_release_q_not_in_release_q_not_runnable[OF valid_sched_valid_release_q])
-         apply (erule pred_tcb_weakenE)
-         apply (clarsimp simp: is_blocked_thread_state_defs)
-         apply (case_tac "itcb_state tcb"; simp)
-        apply clarsimp
-       apply clarsimp
-       apply (rule conjI)
-        apply (frule valid_sched_released_ipc_queues)
-        apply (fastforce simp: released_ipc_queues_defs vs_all_heap_simps)
-       apply (erule valid_sched_active_scs_valid)
-      apply (wpsimp wp: hoare_vcg_const_Ball_lift typ_at_lifts sts_st_tcb')
-     apply (auto simp: valid_tcb_state'_def)
-  done
-
-lemma refill_unblock_check_weak_valid_sched_action[wp]:
-  "\<lbrace>weak_valid_sched_action and active_scs_valid\<rbrace>
-   refill_unblock_check sc_ptr
-   \<lbrace>\<lambda>rv. weak_valid_sched_action\<rbrace>"
-  apply (clarsimp simp: weak_valid_sched_action_def)
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift'')
+(* FIXME move *)
+lemma set_ntfn_tcb_obj_at' [wp]:
+  "\<lbrace>obj_at' (P::tcb \<Rightarrow> bool) t\<rbrace>
+     setNotification ntfn v
+   \<lbrace>\<lambda>_. obj_at' P t\<rbrace>"
+  apply (clarsimp simp: setNotification_def, wp)
   done
 
-crunch if_cond_refill_unblock_check
-  for weak_valid_sched_action[wp]: weak_valid_sched_action
-  (simp: crunch_simps)
-
 lemma cancelAllSignals_corres:
-  "corres dc (invs and valid_sched and ntfn_at ntfn and current_time_bounded)
-             (invs' and ntfn_at' ntfn)
+  "corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn)
              (cancel_all_signals ntfn) (cancelAllSignals ntfn)"
-  apply add_sch_act_wf
   apply (simp add: cancel_all_signals_def cancelAllSignals_def)
-  apply add_sym_refs
-  apply (intro corres_stateAssert_add_assertion)
-    apply (rule corres_underlying_split [OF _ _ get_simple_ko_sp get_ntfn_sp'])
-     apply (rule corres_guard_imp [OF getNotification_corres])
-      apply simp+
-    apply (case_tac "ntfn_obj ntfna", simp_all add: ntfn_relation_def)
-    apply (rule corres_guard_imp)
-      apply (rule corres_split[OF setNotification_corres])
-         apply (simp add: ntfn_relation_def)
-        apply (rule corres_split [OF ntfn_cancel_corres_helper])
-          apply (rule rescheduleRequired_corres)
-         apply (simp add: dc_def)
-         apply (rename_tac list)
-         apply (rule_tac Q'="\<lambda>_ s. (\<forall>x\<in>set list. released_if_bound_sc_tcb_at x s)
-                                  \<and> current_time_bounded s"
-                in hoare_post_add)
-         apply (rule mapM_x_wp')
-         apply wpsimp
-            apply (wpsimp wp: hoare_vcg_ball_lift hoare_vcg_imp_lift)
-           apply (wpsimp wp: get_tcb_obj_ref_wp)
-          apply (wpsimp wp: set_thread_state_weak_valid_sched_action
-                            set_thread_state_pred_map_tcb_sts_of hoare_vcg_imp_lift
-                      simp: disj_imp)
-           apply (rule hoare_pre_cont)
-          apply (wpsimp wp: set_thread_state_weak_valid_sched_action
-                            set_thread_state_pred_map_tcb_sts_of hoare_vcg_imp_lift)
-         apply clarsimp
-         apply (rule conjI; clarsimp)
-          apply fastforce
-         apply (fastforce simp: vs_all_heap_simps)
-        apply (rename_tac list)
-        apply (rule_tac Q'="\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s"
-               in hoare_post_add)
-        apply (rule mapM_x_wp')
-        apply (rule hoare_name_pre_state)
-        apply (wpsimp wp: hoare_vcg_const_Ball_lift
-                          sts_st_tcb' setThreadState_not_st
-                    simp: valid_tcb_state'_def)
-       apply (wpsimp wp: hoare_vcg_const_Ball_lift)+
-     apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-     apply (erule (1) obj_at_valid_objsE)
-     apply (frule valid_sched_active_scs_valid)
-     apply (clarsimp simp: valid_obj_def valid_ntfn_def not_idle_tcb_in_waitingntfn
-                           valid_sched_weak_valid_sched_action
-                    dest!: valid_objs_valid_tcbs)
-     apply (clarsimp simp: ball_conj_distrib[symmetric])
-     apply (rename_tac q s t)
-     apply (rule context_conjI)
-      apply (drule_tac x=ntfn and y=t and tp=TCBSignal in sym_refsE
-             ; clarsimp simp: in_state_refs_of_iff refs_of_rev vs_all_heap_simps)
-     apply (clarsimp simp: valid_sched_released_ipc_queues released_ipc_queues_blocked_on_recv_ntfn_E1)
-    apply clarsimp
-    apply (frule invs'_valid_tcbs')
-    apply (fastforce simp: invs'_def valid_ntfn'_def
-                           valid_obj'_def projectKOs sym_refs_asrt_def sch_act_wf_asrt_def
-           | drule ko_at_valid_objs')+
+  apply (rule corres_stateAssert_ignore)
+   apply (fastforce intro: ksReadyQueues_asrt_cross)
+  apply (rule corres_underlying_split [OF _ _ get_simple_ko_sp get_ntfn_sp'])
+   apply (rule corres_guard_imp [OF getNotification_corres])
+    apply simp+
+  apply (case_tac "ntfn_obj ntfna", simp_all add: ntfn_relation_def)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF setNotification_corres])
+       apply (simp add: ntfn_relation_def)
+      apply (rule corres_split[OF _ rescheduleRequired_corres])
+        apply (rule ep_cancel_corres_helper)
+       apply (wp mapM_x_wp'[where 'b="det_ext state"]
+                 weak_sch_act_wf_lift_linear
+                 set_thread_state_runnable_weak_valid_sched_action
+            | simp)+
+      apply (rename_tac list)
+      apply (rule_tac Q'="\<lambda>_ s. (\<forall>x\<in>set list. tcb_at' x s) \<and> valid_objs' s
+                               \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_objs' s
+                               \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                   in hoare_post_add)
+      apply (rule mapM_x_wp')
+      apply (rule hoare_name_pre_state)
+      apply (wpsimp wp: hoare_vcg_const_Ball_lift sts_st_tcb' sts_valid_objs'
+                  simp: valid_tcb_state'_def
+             | strengthen valid_objs'_valid_tcbs')+
+     apply (wp hoare_vcg_const_Ball_lift set_ntfn_aligned' set_ntfn_valid_objs'
+               weak_sch_act_wf_lift_linear
+          | simp)+
+   apply (clarsimp simp: invs'_def valid_state'_def invs_valid_pspace valid_obj_def valid_ntfn_def
+                         invs_weak_sch_act_wf valid_ntfn'_def valid_pspace'_def
+                         valid_sched_def valid_sched_action_def valid_obj'_def projectKOs
+          | erule obj_at_valid_objsE | drule ko_at_valid_objs' | fastforce)+
   done
 
 lemma ep'_Idle_case_helper:
@@ -2900,149 +1555,83 @@ proof -
      \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread\<rbrace>"
     by (rule hoare_strengthen_post [OF rescheduleRequired_notresume], simp)
   show ?thesis
-  apply (simp add: setThreadState_def scheduleTCB_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift [OF nrct] isSchedulable_wp hoare_vcg_if_lift2)
+  apply (simp add: setThreadState_def)
+  apply (wpsimp wp: hoare_vcg_imp_lift [OF nrct])
    apply (rule_tac Q'="\<lambda>_. ?PRE" in hoare_post_imp)
-    apply clarsimp
-   apply (rule hoare_convert_imp [OF threadSet.ksSchedulerAction threadSet.ct])
+    apply (clarsimp)
+   apply (rule hoare_convert_imp [OF threadSet_nosch threadSet_ct])
   apply assumption
   done
 qed
 
-lemma replyUnlink_valid_irq_node'[wp]:
-  "replyUnlink r t \<lbrace>\<lambda> s. valid_irq_node' (irq_node' s) s\<rbrace>"
-  unfolding replyUnlink_def
-  by (wpsimp wp: valid_irq_node_lift gts_wp')
-
-lemma replyUnlink_ksQ[wp]:
-  "\<lbrace>\<lambda>s. P (ksReadyQueues s p) t\<rbrace>
-   replyUnlink r t
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s p) t\<rbrace>"
-  unfolding replyUnlink_def
-  by (wpsimp wp: gts_wp' sts_ksQ)
-
-lemma weak_sch_act_wf_D1:
-  "weak_sch_act_wf sa s \<Longrightarrow> (\<forall>t. sa = SwitchToThread t \<longrightarrow> st_tcb_at' runnable' t s)"
-  by (simp add: weak_sch_act_wf_def)
-
-lemma updateSchedContext_valid_pspace'[wp]:
-  "\<lbrace>valid_pspace' and
-    (\<lambda>s. \<forall>sc. (valid_sched_context' sc s \<longrightarrow> valid_sched_context' (f sc) s)
-              \<and> (valid_sched_context_size' sc \<longrightarrow> valid_sched_context_size' (f sc)))\<rbrace>
-   updateSchedContext scp f
-   \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
-  unfolding updateSchedContext_def
-  apply wpsimp
-  by (fastforce simp: obj_at'_def projectKOs valid_obj'_def)
-
-lemma refillPopHead_valid_pspace'[wp]:
-  "\<lbrace>valid_pspace' and (\<lambda>s. ((\<lambda>n. 1 < n) |< (scs_of' s ||> scRefillCount)) scp)\<rbrace>
-   refillPopHead scp
-   \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
-  unfolding refillPopHead_def updateSchedContext_def
-  apply (wpsimp wp: whileLoop_valid_inv)
-  by (fastforce simp: obj_at'_def projectKOs valid_obj'_def refillNextIndex_def MIN_REFILLS_def
-                      valid_sched_context'_def valid_sched_context_size'_def scBits_simps objBits_simps
-               dest!: opt_predD
-               elim!: opt_mapE)
-
-lemma refillUnblockCheck_ko_wp_at_not_live[wp]:
-  "refillUnblockCheck scp \<lbrace>\<lambda>s. P (ko_wp_at' (Not \<circ> live') p' s)\<rbrace>"
-  unfolding refillUnblockCheck_def refillHeadOverlappingLoop_def mergeRefills_def
-  apply (wpsimp wp: whileLoop_valid_inv updateSchedContext_wp hoare_drop_imps
-              simp: updateRefillHd_def refillPopHead_def)
-        apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKOs runReaderT_def
-                              opt_map_red refillNextIndex_def
-                   split del: if_split
-                       elim!: rsubst[where P=P])
-        apply (frule refillHeadOverlapping_implies_count_greater_than_one)
-         apply (fastforce simp: obj_at'_def projectKOs)
-        apply (rule iffI; clarsimp simp: opt_map_red split: if_splits)
-            apply (fastforce simp: objBits_simps' live_sc'_def)+
-         apply (clarsimp simp: ps_clear_upd)+
-       apply (wpsimp wp: updateSchedContext_wp simp: updateRefillHd_def)
-      apply (wpsimp wp: hoare_drop_imps refillReady_wp isRoundRobin_wp simp: setReprogramTimer_def)+
-  apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKOs opt_map_red
-             split del: if_split
-                 elim!: rsubst[where P=P])
-  apply (intro iffI; clarsimp simp: opt_map_red)
-   apply (fold fun_upd_def)
-   apply (fastforce simp: objBits_simps')
-  apply (clarsimp simp: opt_map_red ps_clear_upd split: if_splits)
-  done
-
-lemma refillUnblockCheck_refs_of'[wp]:
-  "refillUnblockCheck sc_ptr \<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>"
-  unfolding refillUnblockCheck_def refillHeadOverlappingLoop_def mergeRefills_def
-  apply (wpsimp simp: updateRefillHd_def refillPopHead_def
-                  wp: hoare_drop_imp whileLoop_valid_inv isRoundRobin_wp updateSchedContext_wp)
-        apply (clarsimp simp: runReaderT_def elim!: rsubst[where P=P])
-        apply (clarsimp simp: obj_at'_def projectKOs opt_map_red refillNextIndex_def)
-        apply (fastforce simp: state_refs_of'_def get_refs_def2 ps_clear_upd objBits_simps option.case_eq_if
-                        split: if_splits)
-       apply (wpsimp wp: updateSchedContext_wp refillReady_wp isRoundRobin_wp
-                   simp: updateRefillHd_def setReprogramTimer_def)+
-  apply (fold fun_upd_def)
-  apply (clarsimp simp: obj_at'_def projectKOs opt_map_red
-                intro!: ext elim!: rsubst[where P=P])
-  apply (fastforce simp: state_refs_of'_def get_refs_def2 ps_clear_upd objBits_simps option.case_eq_if
-                  split: if_splits)
-  done
-
-crunch ifCondRefillUnblockCheck
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' t"
-  and valid_pspace'[wp]: valid_pspace'
-  and list_refs_of_replies'[wp]: "\<lambda>s. P (list_refs_of_replies' s)"
-  and if_live_then_nonz_cap'[wp]: if_live_then_nonz_cap'
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  and valid_machine_state'[wp]: valid_machine_state'
-  and ksInterrupt[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and unlive[wp]: "ko_wp_at' (Not \<circ> live') p"
-  and refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
-  (wp: crunch_wps simp: crunch_simps valid_pspace'_def ignore: threadSet)
+lemma tcbSchedEnqueue_valid_pspace'[wp]:
+  "tcbSchedEnqueue tcbPtr \<lbrace>valid_pspace'\<rbrace>"
+  unfolding valid_pspace'_def
+  by wpsimp
 
 lemma cancel_all_invs'_helper:
-  "\<lbrace>invs' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-    and (\<lambda>s. (\<forall>x \<in> set q.
-                tcb_at' x s \<and> ex_nonz_cap_to' x s \<and> sch_act_not x s \<and>
-                st_tcb_at' (\<lambda>st. (\<exists>obj grant reply. st = BlockedOnReceive obj grant reply) \<or>
-                           (\<exists>obj badge grant grantreply iscall.
-                            st = BlockedOnSend obj badge grant grantreply iscall)) x s)
-         \<and> distinct q)\<rbrace>
-   mapM_x (\<lambda>t. do st <- getThreadState t;
-                  y <- case if isReceive st then replyObject st else None of None \<Rightarrow> return () | Some x \<Rightarrow> replyUnlink x t;
-                  fault <- threadGet tcbFault t;
-                  if fault = None then do y <- setThreadState Structures_H.thread_state.Restart t;
-                                          scOpt <- threadGet tcbSchedContext t;
-                                          y \<leftarrow> ifCondRefillUnblockCheck scOpt (Some False) (Some True);
-                                          possibleSwitchTo t
-                                       od
-                  else setThreadState Structures_H.thread_state.Inactive t
-               od) q
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  supply if_split[split del] comp_apply[simp del]
-  unfolding valid_dom_schedule'_def invs'_def
+  "\<lbrace>all_invs_but_sym_refs_ct_not_inQ' and (\<lambda>s. \<forall>x \<in> set q. tcb_at' x s)
+         and (\<lambda>s. sym_refs (\<lambda>x. if x \<in> set q then {r \<in> state_refs_of' s x. snd r = TCBBound}
+                                else state_refs_of' s x)
+                \<and>  (\<forall>x \<in> set q. ex_nonz_cap_to' x s))\<rbrace>
+     mapM_x (\<lambda>t. do
+                   y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
+                   tcbSchedEnqueue t
+                 od) q
+   \<lbrace>\<lambda>rv. all_invs_but_ct_not_inQ'\<rbrace>"
   apply (rule mapM_x_inv_wp2)
    apply clarsimp
-  apply (wpsimp wp: valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift
-                    hoare_vcg_const_Ball_lift sts_st_tcb' setThreadState_not_st
-                    possibleSwitchTo_sch_act_not_other)
-       apply (strengthen weak_sch_act_wf_D1)
-       apply (wpsimp wp: valid_irq_node_lift hoare_vcg_const_Ball_lift
-                         sts_valid_queues sts_st_tcb' setThreadState_not_st sts_sch_act'
-                  split: if_splits)+
-     apply (wp hoare_drop_imp)
-    apply (wpsimp wp: hoare_vcg_const_Ball_lift hoare_vcg_all_lift gts_wp' hoare_vcg_imp_lift
-                      replyUnlink_valid_objs' replyUnlink_st_tcb_at'
-                simp: valid_tcb_state'_def)+
-  apply (rule conjI)
-   apply (fastforce simp: global'_no_ex_cap pred_tcb_at'_def obj_at'_def)
+  apply (rule hoare_pre)
+   apply (wp valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift
+             hoare_vcg_const_Ball_lift untyped_ranges_zero_lift sts_st_tcb' sts_valid_objs'
+        | simp add: cteCaps_of_def o_def)+
+  apply (unfold fun_upd_apply Invariants_H.tcb_st_refs_of'_simps)
   apply clarsimp
-  apply (apply_conjunct \<open>intro impI\<close>,
-         (frule (1) valid_replies'_other_state; clarsimp))+
-  apply (fastforce simp: global'_no_ex_cap)
+  apply (intro conjI)
+  apply (clarsimp simp: valid_tcb_state'_def global'_no_ex_cap
+                 elim!: rsubst[where P=sym_refs]
+                 dest!: set_mono_suffix
+                intro!: ext
+       | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def))+
+  done
+
+lemma ep_q_refs_max:
+  "\<lbrakk> ko_at' r p s; sym_refs (state_refs_of' s); r \<noteq> IdleEP \<rbrakk>
+      \<Longrightarrow> (state_refs_of' s p \<subseteq> (set (epQueue r) \<times> {EPSend, EPRecv}))
+       \<and> (\<forall>x\<in>set (epQueue r). \<exists>ntfnptr. state_refs_of' s x \<subseteq>
+                                  {(p, TCBBlockedSend), (p, TCBBlockedRecv), (ntfnptr, TCBBound)})"
+  apply (frule(1) sym_refs_ko_atD')
+  apply (drule ko_at_state_refs_ofD')
+  apply (case_tac r)
+    apply (clarsimp simp: st_tcb_at_refs_of_rev' tcb_bound_refs'_def
+             | rule conjI | drule(1) bspec | drule st_tcb_at_state_refs_ofD'
+             | case_tac ntfnptr)+
+  done
+
+crunch setEndpoint
+  for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
+  (wp: setObject_ep_ct)
+
+crunch setNotification
+  for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
+  (wp: setObject_ntfn_ct)
+
+lemma tcbSchedEnqueue_cur_tcb'[wp]:
+  "\<lbrace>cur_tcb'\<rbrace> tcbSchedEnqueue t \<lbrace>\<lambda>_. cur_tcb'\<rbrace>"
+  by (simp add: tcbSchedEnqueue_def unless_def)
+     (wp threadSet_cur setQueue_cur | simp)+
+
+lemma rescheduleRequired_invs'[wp]:
+  "\<lbrace>invs'\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: rescheduleRequired_def)
+  apply (wp ssa_invs' | simp | wpc)+
   done
 
+lemma invs_rct_ct_activatable':
+  "\<lbrakk> invs' s; ksSchedulerAction s = ResumeCurrentThread \<rbrakk>
+   \<Longrightarrow> st_tcb_at' activatable' (ksCurThread s) s"
+  by (simp add: invs'_def valid_state'_def ct_in_state'_def)
+
 lemma not_in_epQueue:
   assumes ko_at:  "ko_at' r ep_ptr s" and
           srefs:  "sym_refs (state_refs_of' s)" and
@@ -3074,11 +1663,11 @@ lemma not_in_epQueue:
        apply (drule state_refs_of'_elemD)
        apply (simp add: st_tcb_at_refs_of_rev')
        apply (erule pred_tcb'_weakenE)
-       apply (clarsimp simp: isBlockedOnReply_def)
+       apply (clarsimp)
       apply (drule state_refs_of'_elemD)
       apply (simp add: st_tcb_at_refs_of_rev')
       apply (erule pred_tcb'_weakenE)
-      apply (clarsimp simp: isBlockedOnReply_def)
+      apply (clarsimp)
       done
 
     with st_act show False
@@ -3113,11 +1702,9 @@ lemma not_in_ntfnQueue:
       apply (drule ko_at_state_refs_ofD')
       apply (case_tac "ntfnObj r")
         apply (clarsimp simp: st_tcb_at_refs_of_rev' ntfn_bound_refs'_def
-               | drule st_tcb_at_state_refs_ofD')+
-        apply (drule_tac x="(t, NTFNSignal)" in bspec, clarsimp)
-        apply (clarsimp simp: st_tcb_at_refs_of_rev' sym_refs_def dest!: st_tcb_at_state_refs_ofD')
-       apply (fastforce simp: st_tcb_at_refs_of_rev' sym_refs_def dest!: st_tcb_at_state_refs_ofD')
-      apply (metis (full_types, opaque_lifting) sym_refs_simp symreftype.simps(3))
+             | drule st_tcb_at_state_refs_ofD')+
+      apply (drule_tac x="(t, NTFNSignal)" in bspec, clarsimp)
+      apply (clarsimp simp: st_tcb_at_refs_of_rev' dest!: st_tcb_at_state_refs_ofD')
       done
 
     with ko_at have "st_tcb_at' (Not \<circ> simple') t s"
@@ -3125,7 +1712,7 @@ lemma not_in_ntfnQueue:
       apply (drule state_refs_of'_elemD)
       apply (simp add: st_tcb_at_refs_of_rev')
       apply (erule pred_tcb'_weakenE)
-      apply (clarsimp simp: isBlockedOnReply_def)
+      apply (clarsimp)
       done
 
     with st_act show False
@@ -3141,414 +1728,341 @@ lemma ct_not_in_ntfnQueue:
   using assms unfolding ct_in_state'_def
   by (rule not_in_ntfnQueue)
 
+crunch rescheduleRequired
+  for valid_pspace'[wp]: "valid_pspace'"
+crunch rescheduleRequired
+  for valid_global_refs'[wp]: "valid_global_refs'"
+crunch rescheduleRequired
+  for valid_machine_state'[wp]: "valid_machine_state'"
+
 lemma sch_act_wf_weak[elim!]:
   "sch_act_wf sa s \<Longrightarrow> weak_sch_act_wf sa s"
   by (case_tac sa, (simp add: weak_sch_act_wf_def)+)
 
+lemma rescheduleRequired_all_invs_but_ct_not_inQ:
+  "\<lbrace>all_invs_but_ct_not_inQ'\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def)
+  apply (rule hoare_pre)
+   apply (wp rescheduleRequired_ct_not_inQ
+             valid_irq_node_lift valid_irq_handlers_lift''
+             irqs_masked_lift cur_tcb_lift
+             untyped_ranges_zero_lift
+             | simp add: cteCaps_of_def o_def)+
+  apply (auto simp: sch_act_wf_weak)
+  done
+
 lemma cancelAllIPC_invs'[wp]:
-  "cancelAllIPC ep_ptr \<lbrace>invs'\<rbrace>"
-  supply valid_dom_schedule'_def[simp]
-  unfolding cancelAllIPC_def cancelAllIPC_loop_body_def restartThreadIfNoFault_def
-  apply (simp add: ep'_Idle_case_helper cong del: if_cong)
-  apply (intro bind_wp[OF _ stateAssert_sp])
-  apply (wpsimp wp: rescheduleRequired_invs' cancel_all_invs'_helper
-                    hoare_vcg_const_Ball_lift
-                    valid_global_refs_lift' valid_arch_state_lift'
-                    valid_irq_node_lift ssa_invs' sts_sch_act' getEndpoint_wp
-                    irqs_masked_lift)
-    apply (clarsimp simp: invs'_def valid_ep'_def)
-    apply (wpsimp wp: hoare_vcg_const_Ball_lift)
-   apply (wpsimp wp: getEndpoint_wp)
-  apply (clarsimp simp: invs'_def valid_ep'_def)
+  "\<lbrace>invs'\<rbrace> cancelAllIPC ep_ptr \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper cong del: if_cong)
+  apply (rule bind_wp[OF _ stateAssert_sp])
+  apply (wp rescheduleRequired_all_invs_but_ct_not_inQ
+            cancel_all_invs'_helper hoare_vcg_const_Ball_lift
+            valid_global_refs_lift' valid_arch_state_lift'
+            valid_irq_node_lift ssa_invs' sts_sch_act'
+            irqs_masked_lift
+         | simp only: sch_act_wf.simps forM_x_def | simp)+
+   prefer 2
+   apply assumption
+  apply (rule hoare_strengthen_post [OF get_ep_sp'])
+  apply (rename_tac rv s)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_ep'_def)
   apply (frule obj_at_valid_objs', fastforce)
   apply (clarsimp simp: projectKOs valid_obj'_def)
   apply (rule conjI)
-   apply (metis fold_list_refs_of_replies')
-  apply (clarsimp simp: sym_refs_asrt_def sch_act_wf_asrt_def)
-  apply (rule conjI)
+   apply (case_tac rv, simp_all add: valid_ep'_def)[1]
+  apply (rule conjI[rotated])
    apply (drule(1) sym_refs_ko_atD')
-   apply (clarsimp simp: valid_ep'_def st_tcb_at_refs_of_rev' split: endpoint.splits)
-     apply (intro conjI)
-      apply ((drule(1) bspec | drule st_tcb_at_state_refs_ofD'
-              | clarsimp elim!: if_live_state_refsE split: if_splits)+)[1]
-     apply (fastforce simp: runnable'_def st_tcb_at'_def obj_at'_def)
-    apply (fastforce elim!: pred_tcb'_weakenE)
-   apply (intro conjI)
-     apply ((drule(1) bspec | drule st_tcb_at_state_refs_ofD'
-             | clarsimp elim!: if_live_state_refsE split: if_splits)+)[1]
-    apply (fastforce simp: runnable'_def st_tcb_at'_def obj_at'_def)
-   apply (fastforce elim!: pred_tcb'_weakenE)
-  apply (clarsimp simp: valid_ep'_def split: endpoint.splits)
-  done
-
-lemma ex_nonz_cap_to'_tcb_in_WaitingNtfn'_q:
-  "\<lbrakk>ko_at' ntfn ntfnPtr s; ntfnObj ntfn = Structures_H.ntfn.WaitingNtfn q; valid_objs' s;
-    sym_refs (state_refs_of' s); if_live_then_nonz_cap' s; t \<in> set q\<rbrakk>
-   \<Longrightarrow> ex_nonz_cap_to' t s"
-  apply (clarsimp simp: sym_refs_def)
-  apply (erule_tac x = ntfnPtr in allE)
-  apply (drule_tac x = "(t, NTFNSignal)" in bspec)
-   apply (clarsimp simp: state_refs_of'_def obj_at'_def refs_of'_def projectKOs)
-  apply (fastforce intro: if_live_state_refsE)
-  done
-
-lemma cancelAllSignals_invs'_helper:
-  "\<lbrace>invs' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-    and (\<lambda>s. (\<forall>x \<in> set q. st_tcb_at' (\<lambda>st. \<exists>ref. st = BlockedOnNotification ref) x s
-                          \<and> ex_nonz_cap_to' x s))
-    and K (distinct q)\<rbrace>
-    mapM_x (\<lambda>t. do y <- setThreadState Structures_H.thread_state.Restart t;
-                        scOpt <- threadGet tcbSchedContext t;
-                        y \<leftarrow> ifCondRefillUnblockCheck scOpt (Some False) (Some True);
-                        possibleSwitchTo t
-                od) q
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  unfolding valid_dom_schedule'_def invs'_def
-  apply (rule hoare_gen_asm)
-  apply (rule mapM_x_inv_wp2)
-   apply clarsimp
-  apply (wpsimp wp: sts_st_tcb_at'_cases valid_irq_node_lift irqs_masked_lift
-                    hoare_vcg_const_Ball_lift hoare_vcg_all_lift hoare_vcg_imp_lift'
-              simp: cteCaps_of_def o_def)
-  apply (fastforce simp: valid_tcb_state'_def global'_no_ex_cap
-                         pred_tcb_at'_def obj_at'_def distinct_imply_not_in_tail)
-  done
-
-lemma ntfn_queued_st_tcb_at':
-  "\<And>P. \<lbrakk>ko_at' ntfn ptr s; (t, rt) \<in> ntfn_q_refs_of' (ntfnObj ntfn);
-         valid_objs' s; sym_refs (state_refs_of' s);
-         \<And>ref. P (BlockedOnNotification ref) \<rbrakk>
-   \<Longrightarrow> st_tcb_at' P t s"
-  apply (case_tac "ntfnObj ntfn", simp_all)
-  apply (frule(1) sym_refs_ko_atD')
-  apply (clarsimp)
-  apply (erule_tac y="(t,NTFNSignal)" in my_BallE)
-   apply (clarsimp simp: refs_of_rev' pred_tcb_at'_def obj_at'_def ko_wp_at'_def projectKOs)+
+   apply (case_tac rv, simp_all add: st_tcb_at_refs_of_rev')[1]
+    apply (clarsimp elim!: if_live_state_refsE
+           | drule(1) bspec | drule st_tcb_at_state_refs_ofD')+
+  apply (drule(2) ep_q_refs_max)
+  apply (erule delta_sym_refs)
+   apply (clarsimp dest!: symreftype_inverse' split: if_split_asm | drule(1) bspec subsetD)+
   done
 
 lemma cancelAllSignals_invs'[wp]:
-  "cancelAllSignals ntfnPtr \<lbrace>invs'\<rbrace>"
+  "\<lbrace>invs'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
-  apply (intro bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (case_tac "ntfnObj ntfn"; simp)
-    apply wpsimp
-   apply wpsimp
-  apply (wpsimp wp: rescheduleRequired_invs' sts_st_tcb_at'_cases
-                    cancelAllSignals_invs'_helper hoare_vcg_const_Ball_lift
-                    hoare_drop_imps hoare_vcg_all_lift
-              simp: valid_dom_schedule'_def)
-   apply (clarsimp simp: invs'_def valid_dom_schedule'_def)
-   apply (wpsimp wp: hoare_vcg_const_Ball_lift)
-  apply (clarsimp simp: invs'_def valid_pspace'_def valid_ntfn'_def
-                        valid_dom_schedule'_def)
-  apply (prop_tac "valid_ntfn' ntfn s")
-   apply (frule (2) ntfn_ko_at_valid_objs_valid_ntfn')
-  apply (clarsimp simp: valid_ntfn'_def)
-  apply (intro conjI impI)
-    apply (clarsimp simp: list_refs_of_replies'_def opt_map_def o_def split: option.splits)
-    apply (fastforce intro: if_live_then_nonz_capE'
-                      simp: ko_wp_at'_def live'_def obj_at'_def projectKOs live_ntfn'_def)
-   apply (fastforce elim!: ex_nonz_cap_to'_tcb_in_WaitingNtfn'_q ntfn_queued_st_tcb_at'
-                    simp: sym_refs_asrt_def sch_act_wf_asrt_def)+
-  done
-
-lemma setQueue_valid_ep'[wp]:
-  "setQueue domain prio q \<lbrace>valid_ep' ep\<rbrace>"
-  apply (clarsimp simp: setQueue_def)
-  apply wpsimp
-  apply (clarsimp simp: valid_ep'_def split: endpoint.splits)
+  apply (rule bind_wp[OF _ stateAssert_sp])
+  apply (rule bind_wp [OF _ get_ntfn_sp'])
+  apply (case_tac "ntfnObj ntfna", simp_all)
+    apply (wp, simp)
+   apply (wp, simp)
+  apply (rule hoare_pre)
+   apply (wp rescheduleRequired_all_invs_but_ct_not_inQ
+             cancel_all_invs'_helper hoare_vcg_const_Ball_lift
+             valid_irq_node_lift ssa_invs' irqs_masked_lift
+          | simp only: sch_act_wf.simps)+
+  apply (clarsimp simp: invs'_def valid_state'_def valid_ntfn'_def)
+  apply (frule obj_at_valid_objs', clarsimp)
+  apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def)
+  apply (drule(1) sym_refs_ko_atD')
+  apply (rule conjI, clarsimp elim!: if_live_state_refsE)
+  apply (rule conjI[rotated])
+   apply (clarsimp elim!: if_live_state_refsE)
+   apply (drule_tac x="(x, NTFNSignal)" in bspec)
+    apply (clarsimp simp: st_tcb_at_refs_of_rev')+
+   apply (drule st_tcb_at_state_refs_ofD')
+   apply clarsimp
+  apply (erule delta_sym_refs)
+   apply (clarsimp split: if_split_asm)
+  apply (clarsimp split: if_split_asm)
+   apply (fastforce simp: symreftype_inverse' ntfn_bound_refs'_def)
+  apply (drule_tac x="(x, NTFNSignal)" in bspec)
+   apply (clarsimp simp: st_tcb_at_refs_of_rev')+
+  apply (drule st_tcb_at_state_refs_ofD')
+  apply (fastforce simp: symreftype_inverse' ntfn_bound_refs'_def tcb_bound_refs'_def)
   done
 
-lemma tcbSchedEnqueue_valid_ep'[wp]:
-  "tcbSchedEnqueue thread \<lbrace>valid_ep' ep\<rbrace>"
-  apply (clarsimp simp: tcbSchedEnqueue_def unless_def when_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply clarsimp
-  apply (rule bind_wp_fwd_skip, wpsimp wp: hoare_if)+
-  apply (wpsimp wp: threadSet_wp)
-  apply (fastforce simp: valid_ep'_def obj_at'_def projectKOs objBitsKO_def split: endpoint.splits)
-  done
+crunch tcbSchedEnqueue
+  for valid_objs'[wp]: valid_objs'
+  (simp: unless_def valid_tcb'_def tcb_cte_cases_def)
 
 lemma cancelAllIPC_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> cancelAllIPC ep \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
-  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper cong del: if_cong)
-  apply (repeat_unless \<open>rule bind_wp[OF _ get_ep_sp']\<close>
-                       \<open>rule bind_wp_fwd_skip, wpsimp\<close>)
-  apply (rule hoare_if; (solves \<open>wpsimp\<close>)?)
-  apply (rule_tac Q'="\<lambda>_ s. valid_objs' s \<and> valid_ep' epa s" in bind_wp_fwd)
-   apply (wpsimp wp: set_ep_valid_objs')
-   apply (frule (1) ep_ko_at_valid_objs_valid_ep')
-   apply (fastforce simp: valid_ep'_def obj_at'_def projectKOs objBitsKO_def split: endpoint.splits)
-  apply (rule bind_wp)
-   apply wpsimp
-  apply (rule_tac Q'="\<lambda>_ s. valid_objs' s \<and> valid_ep' ep s" in hoare_strengthen_post; clarsimp)
-  apply (rule mapM_x_wp')
-  by wpsimp
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace> cancelAllIPC ep \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper  cong del: if_cong)
+  apply (rule bind_wp[OF _ stateAssert_sp])
+  apply (rule bind_wp [OF _ get_ep_sp'])
+  apply (rule hoare_pre)
+   apply (wp set_ep_valid_objs' setSchedulerAction_valid_objs')
+    apply (rule_tac Q'="\<lambda>_ s. valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s
+                             \<and> (\<forall>x\<in>set (epQueue ep). tcb_at' x s)"
+                    in hoare_post_imp)
+     apply simp
+    apply (simp add: Ball_def)
+    apply (wp mapM_x_wp' sts_valid_objs'
+              hoare_vcg_all_lift hoare_vcg_const_imp_lift)+
+     apply simp
+    apply (simp add: valid_tcb_state'_def)
+   apply (wp set_ep_valid_objs' hoare_vcg_all_lift hoare_vcg_const_imp_lift)
+  apply (clarsimp)
+  apply (frule(1) ko_at_valid_objs')
+   apply (simp add: projectKOs)
+  apply (clarsimp simp: valid_obj'_def valid_ep'_def)
+  apply (case_tac epa, simp_all)
+  done
 
 lemma cancelAllSignals_valid_objs'[wp]:
   "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace> cancelAllSignals ntfn \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
   apply (simp add: cancelAllSignals_def)
-  apply (repeat_unless \<open>rule bind_wp[OF _ get_ntfn_sp']\<close>
-                       \<open>rule bind_wp_fwd_skip, wpsimp\<close>)
+  apply (rule bind_wp[OF _ stateAssert_sp])
+  apply (rule bind_wp [OF _ get_ntfn_sp'])
   apply (case_tac "ntfnObj ntfna", simp_all)
     apply (wp, simp)
    apply (wp, simp)
   apply (rename_tac list)
   apply (rule_tac Q'="\<lambda>rv s. valid_objs' s \<and> (\<forall>x\<in>set list. tcb_at' x s)"
                   in hoare_post_imp)
-   apply simp
-  apply (wpsimp wp: setSchedulerAction_valid_objs' mapM_x_wp' sts_valid_objs'
-                    hoare_vcg_ball_lift typ_at_lifts)
-  apply (auto simp: projectKOs valid_obj'_def valid_ntfn'_def
-              dest: ko_at_valid_objs')
+   apply (simp add: valid_ntfn'_def)
+  apply (simp add: Ball_def)
+  apply (wp setSchedulerAction_valid_objs' mapM_x_wp'
+            sts_valid_objs' hoare_vcg_all_lift hoare_vcg_const_imp_lift
+       | simp)+
+   apply (simp add: valid_tcb_state'_def)
+  apply (wp set_ntfn_valid_objs' hoare_vcg_all_lift hoare_vcg_const_imp_lift)
+  apply clarsimp
+  apply (frule(1) ko_at_valid_objs')
+   apply (simp add: projectKOs)
+  apply (clarsimp simp: valid_obj'_def valid_ntfn'_def)
   done
 
 lemma cancelAllIPC_st_tcb_at:
-  "\<lbrace>st_tcb_at' P t and K (P Inactive \<and> P Restart)\<rbrace>
-   cancelAllIPC epptr
-   \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
-  unfolding cancelAllIPC_def cancelAllIPC_loop_body_def restartThreadIfNoFault_def
-  apply (rule hoare_gen_asm)
-  apply simp
-  apply (intro bind_wp[OF _ stateAssert_sp])
-  apply (intro bind_wp[OF _ get_ep_sp'])
-  apply (clarsimp simp: endpoint.case_eq_if)
-  apply (rule conjI)
-   apply wpsimp
-  apply (wpsimp wp: mapM_x_wp' sts_st_tcb_at'_cases threadGet_wp hoare_vcg_imp_lift
-              simp: obj_at_ko_at'_eq[where P=\<top>, simplified])
-     apply (rule_tac Q'="\<lambda>_. tcb_at' x and st_tcb_at' P t" in hoare_strengthen_post)
-      apply (wpsimp wp: replyUnlink_st_tcb_at')
-     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-    apply (wpsimp wp: gts_wp')
-    apply (fastforce simp: obj_at_ko_at'_eq[where P=\<top>, simplified])
-   apply wpsimp
-  by clarsimp
+  assumes x[simp]: "P Restart" shows
+  "\<lbrace>st_tcb_at' P t\<rbrace> cancelAllIPC epptr \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
+  unfolding cancelAllIPC_def
+  by (wp ep'_cases_weak_wp mapM_x_wp' sts_st_tcb_at'_cases | clarsimp)+
 
 lemmas cancelAllIPC_makes_simple[wp] =
        cancelAllIPC_st_tcb_at [where P=simple', simplified]
 
 lemma cancelAllSignals_st_tcb_at:
-  "\<lbrace>st_tcb_at' P t and K (P Restart)\<rbrace>
-   cancelAllSignals epptr
-   \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
+  assumes x[simp]: "P Restart" shows
+  "\<lbrace>st_tcb_at' P t\<rbrace> cancelAllSignals epptr \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
   unfolding cancelAllSignals_def
-  apply (rule hoare_gen_asm)
-  apply (wpsimp wp: mapM_x_wp' sts_st_tcb_at'_cases getNotification_wp)
-  done
+  by (wp ntfn'_cases_weak_wp mapM_x_wp' sts_st_tcb_at'_cases | clarsimp)+
 
 lemmas cancelAllSignals_makes_simple[wp] =
        cancelAllSignals_st_tcb_at [where P=simple', simplified]
 
+lemma threadSet_not_tcb[wp]:
+  "\<lbrace>ko_wp_at' (\<lambda>x. P x \<and> (projectKO_opt x = (None :: tcb option))) p\<rbrace>
+     threadSet f t
+   \<lbrace>\<lambda>rv. ko_wp_at' (\<lambda>x. P x \<and> (projectKO_opt x = (None :: tcb option))) p\<rbrace>"
+  by (clarsimp simp: threadSet_def valid_def getObject_def
+                     setObject_def in_monad loadObject_default_def
+                     ko_wp_at'_def projectKOs split_def in_magnitude_check
+                     objBits_simps' updateObject_default_def
+                     ps_clear_upd projectKO_opt_tcb)
+
+lemma setThreadState_not_tcb[wp]:
+  "\<lbrace>ko_wp_at' (\<lambda>x. P x \<and> (projectKO_opt x = (None :: tcb option))) p\<rbrace>
+     setThreadState st t
+   \<lbrace>\<lambda>rv. ko_wp_at' (\<lambda>x. P x \<and> (projectKO_opt x = (None :: tcb option))) p\<rbrace>"
+  by (wpsimp wp: isRunnable_inv threadGet_wp hoare_drop_imps
+           simp: setThreadState_def setQueue_def
+                 rescheduleRequired_def tcbSchedEnqueue_def tcbQueuePrepend_def
+                 unless_def bitmap_fun_defs)+
+
+lemma tcbSchedEnqueue_unlive:
+  "\<lbrace>ko_wp_at' (\<lambda>x. \<not> live' x \<and> (projectKO_opt x = (None :: tcb option))) p
+    and tcb_at' t\<rbrace>
+    tcbSchedEnqueue t
+   \<lbrace>\<lambda>_. ko_wp_at' (\<lambda>x. \<not> live' x \<and> (projectKO_opt x = (None :: tcb option))) p\<rbrace>"
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def)
+  apply (wp | simp add: setQueue_def bitmap_fun_defs)+
+  done
+
+lemma cancelAll_unlive_helper:
+  "\<lbrace>\<lambda>s. (\<forall>x\<in>set xs. tcb_at' x s) \<and>
+     ko_wp_at' (\<lambda>x. \<not> live' x \<and> (projectKO_opt x = (None :: tcb option))) p s\<rbrace>
+     mapM_x (\<lambda>t. do
+                   y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
+                   tcbSchedEnqueue t
+                 od) xs
+   \<lbrace>\<lambda>rv. ko_wp_at' (Not \<circ> live') p\<rbrace>"
+  apply (rule hoare_strengthen_post)
+   apply (rule mapM_x_wp')
+   apply (rule hoare_pre)
+    apply (wp tcbSchedEnqueue_unlive hoare_vcg_const_Ball_lift)
+   apply clarsimp
+  apply (clarsimp elim!: ko_wp_at'_weakenE)
+  done
+
+context begin interpretation Arch . (*FIXME: arch-split*)
+lemma setObject_ko_wp_at':
+  fixes v :: "'a :: pspace_storable"
+  assumes x: "\<And>v :: 'a. updateObject v = updateObject_default v"
+  assumes n: "\<And>v :: 'a. objBits v = n"
+  assumes v: "(1 :: word32) < 2 ^ n"
+  shows
+  "\<lbrace>\<lambda>s. P (injectKO v)\<rbrace> setObject p v \<lbrace>\<lambda>rv. ko_wp_at' P p\<rbrace>"
+  by (clarsimp simp: setObject_def valid_def in_monad
+                     ko_wp_at'_def x split_def n
+                     updateObject_default_def
+                     objBits_def[symmetric] ps_clear_upd
+                     in_magnitude_check v projectKOs)
+
 lemma threadSet_unlive_other:
   "\<lbrace>ko_wp_at' (Not \<circ> live') p and K (p \<noteq> t)\<rbrace>
    threadSet f t
    \<lbrace>\<lambda>rv. ko_wp_at' (Not \<circ> live') p\<rbrace>"
   by (clarsimp simp: threadSet_def valid_def getObject_def
                      setObject_def in_monad loadObject_default_def
-                     ko_wp_at'_def projectKOs split_def in_magnitude_check
-                     objBits_simps' updateObject_default_def
+                     ko_wp_at'_def  split_def in_magnitude_check
+                     objBits_simps' updateObject_default_def projectKOs
                      ps_clear_upd ARM_H.fromPPtr_def)
 
-lemma rescheduleRequired_unlive[wp]:
-  "\<lbrace>\<lambda>s. ko_wp_at' (Not \<circ> live') p s \<and> sch_act_not p s\<rbrace>
-   rescheduleRequired
-   \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') p\<rbrace>"
-  unfolding rescheduleRequired_def
-  apply (wpsimp wp: setObject_ko_wp_at getObject_tcb_wp isSchedulable_wp
-              simp: objBits_simps' bitmap_fun_defs tcbSchedEnqueue_def unless_def
-                    threadSet_def setQueue_def threadGet_getObject)+
-  by (fastforce simp: o_def dest!: obj_at_ko_at'[where P=\<top>])
-
 lemma tcbSchedEnqueue_unlive_other:
   "\<lbrace>ko_wp_at' (Not \<circ> live') p and K (p \<noteq> t)\<rbrace>
    tcbSchedEnqueue t
    \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') p\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def)
-  apply (wpsimp wp: threadGet_wp threadSet_unlive_other)
-  apply (fastforce simp: obj_at'_def projectKOs ko_wp_at'_def)
-  done
-
-crunch scheduleTCB
-  for unlive[wp]: "ko_wp_at' (Not \<circ> live') p"
-  (wp: crunch_wps isSchedulable_inv simp: crunch_simps)
-
-lemma setThreadState_unlive_other:
-  "\<lbrace>ko_wp_at' (Not \<circ> live') p and sch_act_not p and K (p \<noteq> t)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>rv. ko_wp_at' (Not \<circ> live') p\<rbrace>"
-  unfolding setThreadState_def
-  apply (wpsimp wp: threadSet_wp)
-  apply (fastforce simp: ko_wp_at'_def obj_at'_def)
+  apply (simp add: tcbSchedEnqueue_def tcbQueuePrepend_def setQueue_def)
+  apply (wpsimp wp: threadGet_wp threadSet_unlive_other simp:  bitmap_fun_defs)
+  apply (normalise_obj_at', rename_tac tcb)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def)
+  apply (drule_tac x="tcbDomain tcb" in spec)
+  apply (drule_tac x="tcbPriority tcb" in spec)
+  apply (clarsimp simp: tcbQueueEmpty_def)
+  apply (frule (1) tcbQueueHead_ksReadyQueues)
+  apply (drule_tac x=p in spec)
+  apply (fastforce dest!: inQ_implies_tcbQueueds_of
+                    simp: tcbQueueEmpty_def ko_wp_at'_def opt_pred_def opt_map_def projectKOs
+                   split: option.splits)
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemma possibleSwitchTo_unlive_other:
-  "\<lbrace>ko_wp_at' (Not \<circ> live') p and sch_act_not p and K (p \<noteq> t)\<rbrace>
-   possibleSwitchTo t
+lemma rescheduleRequired_unlive[wp]:
+  "\<lbrace>\<lambda>s. ko_wp_at' (Not \<circ> live') p s \<and> ksSchedulerAction s \<noteq> SwitchToThread p\<rbrace>
+   rescheduleRequired
    \<lbrace>\<lambda>_. ko_wp_at' (Not \<circ> live') p\<rbrace>"
-  apply (simp add: possibleSwitchTo_def inReleaseQueue_def)
-  apply (wpsimp wp: tcbSchedEnqueue_unlive_other threadGet_wp rescheduleRequired_unlive)+
-  apply (auto simp: obj_at'_def ko_wp_at'_def)
-  done
-
-lemma setThreadState_Inactive_unlive:
-  "\<lbrace>ko_wp_at' (Not \<circ> live') p and sch_act_not p\<rbrace>
-   setThreadState Inactive tptr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not o live') p\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  apply (wpsimp wp: threadSet_wp)
-  apply (fastforce simp: ko_wp_at'_def obj_at'_def projectKOs is_aligned_def ps_clear_def objBitsKO_def)
+  supply comp_apply[simp del]
+  unfolding rescheduleRequired_def
+  apply (wpsimp wp: tcbSchedEnqueue_unlive_other)
   done
 
-lemma replyUnlink_unlive:
-  "\<lbrace>ko_wp_at' (Not \<circ> live') p and sch_act_not p\<rbrace>
-   replyUnlink replyPtr tcbPtr
-   \<lbrace>\<lambda>_. ko_wp_at' (Not o live') p\<rbrace>"
-  apply (clarsimp simp: replyUnlink_def updateReply_def)
-  apply (wpsimp wp: setThreadState_Inactive_unlive set_reply'.set_wp gts_wp')
-  apply (fastforce simp: ko_wp_at'_def obj_at'_def projectKOs is_aligned_def ps_clear_def
-                         objBitsKO_def live'_def live_reply'_def)
-  done
+lemmas setEndpoint_ko_wp_at'
+    = setObject_ko_wp_at'[where 'a=endpoint, folded setEndpoint_def, simplified]
 
 lemma cancelAllIPC_unlive:
   "\<lbrace>valid_objs' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   cancelAllIPC ep
-   \<lbrace>\<lambda>rv. ko_wp_at' (Not \<circ> live') ep\<rbrace>"
-  unfolding cancelAllIPC_def cancelAllIPC_loop_body_def restartThreadIfNoFault_def
-  apply (simp add: ep'_Idle_case_helper)
-  apply (repeat_unless \<open>rule bind_wp[OF _ get_ep_sp']\<close>
-                       \<open>rule bind_wp_fwd_skip, wpsimp\<close>)
-  apply (rename_tac endpoint)
-  apply (rule hoare_if)
-   apply (wpsimp simp: ko_wp_at'_def live'_def obj_at'_def projectKOs)
-
-  apply (rule_tac Q'="\<lambda>_ s. valid_objs' s
-                           \<and> sch_act_wf (ksSchedulerAction s) s
-                           \<and> ko_wp_at' (Not \<circ> live') ep s
-                           \<and> ep_at' ep s
-                           \<and> valid_ep' endpoint s"
-               in bind_wp_fwd)
-   apply (wpsimp wp: set_ep_valid_objs' set_ep'.sch_act_wf)
-    apply (wpsimp wp: set_ep'.set_wp)
-   apply (clarsimp simp del: fun_upd_apply)
-   apply (frule (1) ep_ko_at_valid_objs_valid_ep')
-   apply (clarsimp simp: valid_ep'_def ko_wp_at'_def obj_at'_def projectKOs objBitsKO_def
-                         ps_clear_def)
-   apply (fastforce simp: valid_ep'_def obj_at'_def projectKOs objBitsKO_def split: endpoint.splits)
-
-  apply clarsimp
-  apply (rule_tac P'="\<lambda>s. valid_objs' s
-                         \<and> sch_act_not ep s
-                         \<and> ko_wp_at' (Not \<circ> live') ep s
-                         \<and> ep_at' ep s
-                         \<and> valid_ep' endpoint s"
-               in hoare_weaken_pre[rotated])
-   apply (clarsimp simp: st_tcb_at'_def obj_at'_def projectKOs)
-  apply (rule bind_wp)
-   apply (wpsimp wp: rescheduleRequired_unlive)
-  apply (rule hoare_strengthen_post)
-   apply (rule mapM_x_wp')
-   apply (rule bind_wp_fwd_skip, wpsimp)
-   apply (rule bind_wp_fwd_skip, wpsimp wp: replyUnlink_valid_objs' replyUnlink_unlive)
-   apply (wpsimp wp: possibleSwitchTo_unlive_other setThreadState_unlive_other hoare_drop_imps
-                     possibleSwitchTo_sch_act_not_other)
-   apply (clarsimp simp: valid_tcb_state'_def obj_at'_def projectKOs)
-   apply (fastforce simp: valid_ep'_def obj_at'_def projectKOs split: endpoint.splits)
-  apply clarsimp
-  done
-
-lemma cancelAllSignals_unlive_helper:
-  "\<lbrace>\<lambda>s. (\<forall>x\<in>set xs. tcb_at' x s) \<and> ko_wp_at' (Not \<circ> live') p s
-         \<and> sch_act_not p s \<and> p \<notin> set xs\<rbrace>
-   mapM_x (\<lambda>t. do
-                 y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
-                 scOpt <- threadGet tcbSchedContext t;
-                 y <- ifCondRefillUnblockCheck scOpt (Some False) (Some True);
-                 possibleSwitchTo t
-               od) xs
-   \<lbrace>\<lambda>rv s. (\<forall>x\<in>set xs. tcb_at' x s) \<and> ko_wp_at' (Not \<circ> live') p s
-           \<and>sch_act_not p s\<rbrace>"
-  apply (rule hoare_strengthen_post)
-   apply (rule mapM_x_wp')
-   apply (rule hoare_pre)
-    apply (wpsimp wp: hoare_vcg_const_Ball_lift setThreadState_unlive_other
-                      possibleSwitchTo_unlive_other possibleSwitchTo_sch_act_not_other)
-   apply clarsimp
-  apply clarsimp
+      cancelAllIPC ep \<lbrace>\<lambda>rv. ko_wp_at' (Not \<circ> live') ep\<rbrace>"
+  apply (simp add: cancelAllIPC_def ep'_Idle_case_helper)
+  apply (rule bind_wp[OF _ stateAssert_sp])
+  apply (rule bind_wp [OF _ get_ep_sp'])
+  apply (rule hoare_pre)
+   apply (wp cancelAll_unlive_helper setEndpoint_ko_wp_at'
+             hoare_vcg_const_Ball_lift rescheduleRequired_unlive
+             mapM_x_wp'
+        | simp add: objBits_simps')+
+  apply (clarsimp simp: projectKO_opt_tcb)
+  apply (frule(1) obj_at_valid_objs')
+  apply (intro conjI impI)
+  apply (clarsimp simp: valid_obj'_def valid_ep'_def projectKOs
+                        obj_at'_def pred_tcb_at'_def ko_wp_at'_def
+                 split: endpoint.split_asm)+
   done
 
 lemma cancelAllSignals_unlive:
   "\<lbrace>\<lambda>s. valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s
-      \<and> obj_at' (\<lambda>ko. ntfnBoundTCB ko = None) ntfnptr s
-      \<and> obj_at' (\<lambda>ko. ntfnSc ko = None) ntfnptr s\<rbrace>
-   cancelAllSignals ntfnptr
-   \<lbrace>\<lambda>rv. ko_wp_at' (Not \<circ> live') ntfnptr\<rbrace>"
+      \<and> obj_at' (\<lambda>ko. ntfnBoundTCB ko = None) ntfnptr s\<rbrace>
+      cancelAllSignals ntfnptr \<lbrace>\<lambda>rv. ko_wp_at' (Not \<circ> live') ntfnptr\<rbrace>"
   apply (simp add: cancelAllSignals_def)
-  apply (repeat_unless \<open>rule bind_wp[OF _ get_ntfn_sp']\<close>
-                       \<open>rule bind_wp_fwd_skip, wpsimp\<close>)
-  apply (case_tac "ntfnObj ntfn"; simp)
+  apply (rule bind_wp[OF _ stateAssert_sp])
+  apply (rule bind_wp [OF _ get_ntfn_sp'])
+  apply (case_tac "ntfnObj ntfn", simp_all add: setNotification_def)
     apply wp
-    apply (fastforce simp: obj_at'_real_def projectKOs live_ntfn'_def ko_wp_at'_def)
+    apply (fastforce simp: obj_at'_real_def projectKOs
+                     dest: obj_at_conj'
+                     elim: ko_wp_at'_weakenE)
    apply wp
-   apply (fastforce simp: obj_at'_real_def projectKOs live_ntfn'_def ko_wp_at'_def)
+   apply (fastforce simp: obj_at'_real_def projectKOs
+                    dest: obj_at_conj'
+                    elim: ko_wp_at'_weakenE)
   apply (wp rescheduleRequired_unlive)
-    apply (rule cancelAllSignals_unlive_helper[THEN hoare_strengthen_post])
-    apply fastforce
-   apply (wpsimp wp: hoare_vcg_const_Ball_lift set_ntfn'.ko_wp_at
-               simp: objBits_simps')
-  apply (clarsimp, frule (1) ko_at_valid_objs'_pre,
-         clarsimp simp: valid_obj'_def valid_ntfn'_def)
-  apply (intro conjI[rotated]; clarsimp)
-    apply (fastforce simp: obj_at'_def projectKOs)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-  apply (clarsimp simp: live_ntfn'_def ko_wp_at'_def obj_at'_def)
+   apply (wp cancelAll_unlive_helper)
+   apply ((wp mapM_x_wp' setObject_ko_wp_at' hoare_vcg_const_Ball_lift)+,
+          simp_all add: objBits_simps', simp_all)
+   apply (fold setNotification_def, wp)
+  apply (intro conjI[rotated])
+     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
+    apply (clarsimp simp: projectKOs projectKO_opt_tcb)
+   apply (fastforce simp: ko_wp_at'_def valid_obj'_def valid_ntfn'_def
+                         obj_at'_def projectKOs)+
   done
 
+crunch tcbSchedEnqueue
+  for ep_at'[wp]: "ep_at' epptr"
+  (simp: unless_def)
+
 declare if_cong[cong]
 
 lemma insert_eqD:
   "A = insert a B \<Longrightarrow> a \<in> A"
   by blast
 
-crunch setSchedulerAction
-  for tcb_in_cur_domain'[wp]: "tcb_in_cur_domain' p"
-  (simp: tcb_in_cur_domain'_def wp_del: ssa_wp)
-
-crunch possibleSwitchTo
-  for tcb_in_cur_domain'[wp]: "tcb_in_cur_domain' p"
-  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps)
-
 lemma cancelBadgedSends_filterM_helper':
   notes if_cong[cong del]
   shows
   "\<forall>ys.
-   \<lbrace>\<lambda>s. invs' s \<and> sch_act_wf (ksSchedulerAction s) s
+   \<lbrace>\<lambda>s. all_invs_but_sym_refs_ct_not_inQ' s
            \<and> ex_nonz_cap_to' epptr s \<and> ep_at' epptr s
            \<and> sym_refs ((state_refs_of' s) (epptr := set (xs @ ys) \<times> {EPSend}))
            \<and> (\<forall>y \<in> set (xs @ ys). state_refs_of' s y = {(epptr, TCBBlockedSend)}
-                                                        \<union> tcb_non_st_state_refs_of' s y)
+                                       \<union> {r \<in> state_refs_of' s y. snd r = TCBBound})
            \<and> distinct (xs @ ys)\<rbrace>
       filterM (\<lambda>t. do st \<leftarrow> getThreadState t;
-                      if blockingIPCBadge st = badge
-                      then
-                        do restartThreadIfNoFault t;
+                      if blockingIPCBadge st = badge then
+                        do y \<leftarrow> setThreadState Structures_H.thread_state.Restart t;
+                           y \<leftarrow> tcbSchedEnqueue t;
                            return False
                         od
                       else return True
                    od) xs
-   \<lbrace>\<lambda>rv s. invs' s \<and> sch_act_wf (ksSchedulerAction s) s
+   \<lbrace>\<lambda>rv s. all_invs_but_sym_refs_ct_not_inQ' s
            \<and> ex_nonz_cap_to' epptr s \<and> ep_at' epptr s
            \<and> sym_refs ((state_refs_of' s) (epptr := (set rv \<union> set ys) \<times> {EPSend}))
            \<and> (\<forall>y \<in> set ys. state_refs_of' s y = {(epptr, TCBBlockedSend)}
-                                                 \<union> tcb_non_st_state_refs_of' s y)
+                                   \<union> {r \<in> state_refs_of' s y. snd r = TCBBound})
            \<and> distinct rv \<and> distinct (xs @ ys) \<and> set rv \<subseteq> set xs \<and> (\<forall>x \<in> set xs. tcb_at' x s)\<rbrace>"
-  supply valid_dom_schedule'_def[simp]
-  unfolding restartThreadIfNoFault_def
-  apply (simp only: invs'_def)
   apply (rule_tac xs=xs in rev_induct)
    apply clarsimp
    apply wp
@@ -3556,102 +2070,66 @@ lemma cancelBadgedSends_filterM_helper':
   apply (clarsimp simp: filterM_append bind_assoc simp del: set_append distinct_append)
   apply (drule spec, erule bind_wp_fwd)
   apply (rule bind_wp [OF _ gts_inv'])
-  apply (simp add: opt_map_Some_eta_fold split del: if_split)
   apply (rule hoare_pre)
-   apply (wpsimp wp: valid_irq_node_lift hoare_vcg_const_Ball_lift
-                     valid_irq_handlers_lift'' irqs_masked_lift sts_st_tcb'
-                     hoare_vcg_all_lift sts_sch_act'
-                     threadGet_inv[THEN hoare_drop_imp] hoare_vcg_imp_lift'
-               simp: cteCaps_of_def o_def)
-  apply (clarsimp simp: opt_map_Some_eta_fold)
+   apply (wp valid_irq_node_lift hoare_vcg_const_Ball_lift sts_sch_act'
+             sch_act_wf_lift valid_irq_handlers_lift'' cur_tcb_lift irqs_masked_lift
+             sts_st_tcb' untyped_ranges_zero_lift
+        | clarsimp simp: cteCaps_of_def o_def)+
   apply (frule insert_eqD, frule state_refs_of'_elemD)
   apply (clarsimp simp: valid_tcb_state'_def st_tcb_at_refs_of_rev')
   apply (frule pred_tcb_at')
   apply (rule conjI[rotated], blast)
-  apply (clarsimp cong: conj_cong)
-  apply (thin_tac "sym_refs _") \<comment> \<open>this removes the list_refs_of_reply' sym_refs premise\<close>
+  apply (clarsimp simp: valid_pspace'_def cong: conj_cong)
   apply (intro conjI)
-          apply (find_goal \<open>match conclusion in "sym_refs _" \<Rightarrow> \<open>-\<close>\<close>)
-          apply (erule delta_sym_refs)
-           apply (fastforce split: if_split_asm)
-          subgoal (* this takes approximately 15s *)
-          by (auto simp: state_refs_of'_def symreftype_inverse' projectKOs
-                         tcb_bound_refs'_def obj_at'_def get_refs_def2 tcb_st_refs_of'_def
-                  split: option.splits if_splits thread_state.splits)
-         by (fastforce simp: valid_pspace'_def valid_tcb'_def pred_tcb_at'_def obj_at'_def subsetD
-                      elim!: valid_objs_valid_tcbE' st_tcb_ex_cap'')+
+     apply (fastforce simp: valid_tcb'_def dest!: st_tcb_ex_cap'')
+    apply (clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def idle_tcb'_def)
+   apply (erule delta_sym_refs)
+    by (fastforce elim!: obj_atE'
+                   simp: state_refs_of'_def tcb_bound_refs'_def subsetD symreftype_inverse' projectKOs
+                  split: if_split_asm)+
 
 lemmas cancelBadgedSends_filterM_helper
     = spec [where x=Nil, OF cancelBadgedSends_filterM_helper', simplified]
 
-lemma cancelBadgedSends_invs'[wp]:
+lemma cancelBadgedSends_invs[wp]:
   notes if_cong[cong del]
   shows
-  "cancelBadgedSends epptr badge \<lbrace>invs'\<rbrace>"
+  "\<lbrace>invs'\<rbrace> cancelBadgedSends epptr badge \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: cancelBadgedSends_def)
-  apply (intro bind_wp[OF _ stateAssert_sp])
+  apply (rule bind_wp[OF _ stateAssert_sp])
   apply (rule bind_wp [OF _ get_ep_sp'], rename_tac ep)
   apply (case_tac ep, simp_all)
     apply ((wp | simp)+)[2]
   apply (subst bind_assoc [where g="\<lambda>_. rescheduleRequired",
                            symmetric])+
   apply (rule bind_wp
-                [OF rescheduleRequired_invs'])
-  apply (simp add: list_case_return invs'_def valid_dom_schedule'_def cong: list.case_cong)
+                [OF rescheduleRequired_all_invs_but_ct_not_inQ])
+  apply (simp add: list_case_return cong: list.case_cong)
   apply (rule hoare_pre, wp valid_irq_node_lift irqs_masked_lift)
+    apply simp
     apply (rule hoare_strengthen_post,
            rule cancelBadgedSends_filterM_helper[where epptr=epptr])
-    apply (clarsimp simp: ep_redux_simps3 fun_upd_def[symmetric] o_def)
-    apply (clarsimp simp add: valid_ep'_def invs'_def valid_dom_schedule'_def comp_def
-                       split: list.split)
+    apply (clarsimp simp: ep_redux_simps3 fun_upd_def[symmetric])
+    apply (clarsimp simp add: valid_ep'_def split: list.split)
     apply blast
-   apply (simp add: list_case_return invs'_def valid_dom_schedule'_def)
    apply (wp valid_irq_node_lift irqs_masked_lift | wp (once) sch_act_sane_lift)+
-  apply (clarsimp simp: valid_ep'_def fun_upd_def[symmetric]
+  apply (clarsimp simp: invs'_def valid_state'_def
+                        valid_ep'_def fun_upd_def[symmetric]
                         obj_at'_weakenE[OF _ TrueI])
   apply (frule obj_at_valid_objs', clarsimp)
   apply (clarsimp simp: valid_obj'_def valid_ep'_def projectKOs)
   apply (frule if_live_then_nonz_capD', simp add: obj_at'_real_def)
    apply (clarsimp simp: projectKOs)
-  apply (clarsimp simp: sym_refs_asrt_def)
   apply (frule(1) sym_refs_ko_atD')
-  apply (clarsimp simp add: fun_upd_idem st_tcb_at_refs_of_rev' o_def sch_act_wf_asrt_def)
+  apply (clarsimp simp add: fun_upd_idem
+                            st_tcb_at_refs_of_rev')
   apply (drule (1) bspec, drule st_tcb_at_state_refs_ofD', clarsimp)
-  apply (auto simp: tcb_bound_refs'_def get_refs_def
-             split: option.splits)
-  done
-
-lemma restart_thread_if_no_fault_valid_sched_blocked_on_send:
-  "\<lbrace>\<lambda>s. valid_sched s \<and> tcb_at t s \<and> heap_refs_inv (tcb_scps_of s) (sc_tcbs_of s)
-        \<and> current_time_bounded s
-        \<and> (epptr, TCBBlockedSend) \<in> state_refs_of s t \<and> t \<noteq> idle_thread s\<rbrace>
-   restart_thread_if_no_fault t
-   \<lbrace>\<lambda>_. valid_sched\<rbrace>"
-  apply (wpsimp wp: restart_thread_if_no_fault_valid_sched gts_wp)
-  apply (frule valid_sched_released_ipc_queues)
-  apply (frule TCBBlockedSend_in_state_refs_of)
-  apply (prop_tac "blocked_on_send_tcb_at t s")
-   apply (fastforce simp: is_blocked_thread_state_defs vs_all_heap_simps obj_at_def pred_tcb_at_def)
-  apply (drule (1) released_ipc_queues_blocked_on_send_E1)
-  apply (intro conjI)
-   apply (clarsimp simp: pred_tcb_at_def obj_at_def vs_all_heap_simps)
-   apply (metis runnable.simps)
-  apply (clarsimp simp: is_timeout_fault_opt_def vs_all_heap_simps obj_at_def pred_tcb_at_def)
+  apply (fastforce simp: set_eq_subset tcb_bound_refs'_def)
   done
 
-lemma in_send_ep_queue_TCBBlockedSend':
-  "\<lbrakk>ko_at' (Structures_H.SendEP queue) epptr s; x \<in> set queue;
-    sym_refs (state_refs_of' s); valid_objs' s\<rbrakk>
-   \<Longrightarrow> ko_wp_at' (\<lambda>ko. (epptr, TCBBlockedSend) \<in> refs_of' ko) x s"
-  apply (prop_tac "valid_ep' (Structures_H.SendEP queue) s")
-   apply (fastforce simp: valid_objs'_def valid_obj'_def obj_at'_def projectKOs
-                   split: kernel_object.splits)
-  apply (clarsimp simp: valid_ep'_def)
-  apply (prop_tac "(x, EPSend) \<in> state_refs_of' s epptr")
-   apply (clarsimp simp: state_refs_of'_def obj_at'_def projectKOs)
-  apply (clarsimp simp: sym_refs_def)
-  apply (fastforce simp: ko_wp_at'_def obj_at'_def projectKOs state_refs_of'_def)
-  done
+crunch tcb_sched_action
+  for state_refs_of[wp]: "\<lambda>s. P (state_refs_of s)"
+  (ignore_del: tcb_sched_action)
 
 lemma setEndpoint_valid_tcbs'[wp]:
   "setEndpoint ePtr val \<lbrace>valid_tcbs'\<rbrace>"
@@ -3662,145 +2140,87 @@ lemma setEndpoint_valid_tcbs'[wp]:
   done
 
 lemma cancelBadgedSends_corres:
-  "corres dc (invs and valid_sched and ep_at epptr and current_time_bounded)
-             (invs' and ep_at' epptr)
+  "corres dc (invs and valid_sched and ep_at epptr) (invs' and ep_at' epptr)
          (cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)"
-  apply add_sym_refs
-  apply add_sch_act_wf
-  apply (clarsimp simp: cancel_badged_sends_def cancelBadgedSends_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: sym_refs_asrt_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: sch_act_wf_asrt_def)
+  apply (simp add: cancel_badged_sends_def cancelBadgedSends_def)
+  apply (rule corres_stateAssert_ignore)
+   apply (fastforce intro: ksReadyQueues_asrt_cross)
   apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getEndpoint_corres _ get_simple_ko_sp get_ep_sp'
-                             , where Q="invs and valid_sched and current_time_bounded"
-                                 and Q'="invs' and (\<lambda>s. sym_refs (state_refs_of' s))
-                                         and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"])
+    apply (rule corres_split[OF getEndpoint_corres _ get_simple_ko_sp get_ep_sp',
+                                 where Q="invs and valid_sched" and Q'=invs'])
     apply simp_all
-  apply (case_tac ep; simp add: ep_relation_def)
-  apply (rename_tac queue)
+  apply (case_tac ep, simp_all add: ep_relation_def)
   apply (simp add: filterM_mapM list_case_return cong: list.case_cong)
   apply (rule corres_guard_imp)
     apply (rule corres_split_nor[OF setEndpoint_corres])
-       apply (clarsimp simp: ep_relation_def)
-      apply (rule_tac F="distinct queue" in corres_gen_asm)
-      apply (rule corres_split_eqr)
-         apply (rule_tac P="\<lambda>s. valid_sched s \<and> pspace_aligned s \<and> pspace_distinct s \<and> valid_tcbs s
-                                \<and> heap_refs_inv (tcb_scps_of s) (sc_tcbs_of s) \<and> current_time_bounded s"
-                     and Q="\<lambda>t s. tcb_at t s \<and> (epptr, TCBBlockedSend) \<in> state_refs_of s t
-                                  \<and> t \<noteq> idle_thread s"
-                     and P'="\<lambda>s. valid_objs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> valid_queues s
-                                 \<and> valid_queues' s \<and> valid_tcbs' s \<and> valid_release_queue_iff s"
-                     and Q'="\<lambda>t s. tcb_at' t s \<and> st_tcb_at' (not runnable') t s"
-                     and S="{t. (fst t = snd t) \<and> fst t \<in> set queue}"
-                     and r="(=)"
-                     and r'="(=)"
-                  in corres_mapM_scheme
-                ; (solves fastforce)?)
-             apply (clarsimp simp: liftM_def[symmetric])
-             apply (rule corres_guard_imp)
-               apply (rule corres_split[OF getThreadState_corres])
-                 apply (rule_tac F="\<exists>pl. st = Structures_A.BlockedOnSend epptr pl"
-                              in corres_gen_asm)
-                 apply (rule corres_if2[where Q=\<top> and Q'=\<top>])
-                   apply (clarsimp simp: blocking_ipc_badge_def blockingIPCBadge_def
-                                  split: thread_state.splits)
-                  apply (clarsimp simp: o_def dc_def[symmetric] liftM_def)
-                  apply (rule corres_guard_imp)
-                    apply (rule corres_split[OF restart_thread_if_no_fault_corres])
-                      unfolding restartThreadIfNoFault_def
-                      apply (rule corres_return_eq_same, simp)
-                     apply (rule wp_post_taut)
-                    apply (rule wp_post_taut)
-                   apply simp+
-                apply (wpsimp wp: gts_wp)
-               apply (wpsimp wp: gts_wp')
-              apply (clarsimp simp: st_tcb_def2 st_tcb_at_refs_of_rev valid_sched_def
-                              dest!: state_refs_of_elemD)
-             apply (clarsimp simp: st_tcb_def2 st_tcb_at_refs_of_rev)
-            apply (wpsimp wp: gts_wp)
-           apply (wpsimp wp: sts_st_tcb_at'_cases threadGet_wp gts_wp' hoare_vcg_imp_lift
-                       simp: obj_at_ko_at'_eq[where P=\<top>, simplified])
-           apply (clarsimp simp: obj_at'_def pred_neg_def)
-          apply (wpsimp wp: restart_thread_if_no_fault_valid_sched_blocked_on_send[where epptr=epptr]
-                            gts_wp)
-         apply (wpsimp wp: sts_weak_sch_act_wf sts_st_tcb_at'_cases hoare_vcg_imp_lift
-                           setThreadState_valid_queues' threadGet_wp gts_wp'
-                     simp: obj_at_ko_at'_eq[where P=\<top>, simplified])
-         apply (fastforce simp: valid_tcb_state'_def obj_at'_def projectKOs st_tcb_at'_def
-                                pred_neg_def weak_sch_act_wf_def)
-        apply (rule corres_split[OF ])
-           apply (rule setEndpoint_corres)
-           apply (simp split: list.split add: ep_relation_def)
-          apply (rule rescheduleRequired_corres)
+       apply (simp add: ep_relation_def)
+      apply (rule corres_split_eqr[OF _ _ _ hoare_post_add
+                                             [where Q'="\<lambda>_. valid_objs' and pspace_aligned'
+                                                           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>
+                                   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
+                                  \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                     in corres_mapM_list_all2[where r'="(=)"],
+                simp_all add: list_all2_refl)[1]
+           apply (clarsimp simp: liftM_def[symmetric] o_def)
+           apply (rule corres_guard_imp)
+             apply (rule corres_split[OF getThreadState_corres])
+               apply (rule_tac F="\<exists>pl. st = Structures_A.BlockedOnSend epptr pl"
+                            in corres_gen_asm)
+               apply (clarsimp simp: o_def dc_def[symmetric] liftM_def)
+               apply (rule corres_split[OF setThreadState_corres])
+                  apply simp
+                 apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
+                   apply (rule corres_trivial)
+                   apply simp
+                  apply wp+
+               apply simp
+               apply (wp sts_st_tcb_at' gts_st_tcb_at sts_valid_objs'
+                      | 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])
+            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'
+                      | clarsimp simp: valid_tcb_state'_def)+
+        apply (rule corres_split[OF _ rescheduleRequired_corres])
+          apply (rule setEndpoint_corres)
+          apply (simp split: list.split add: ep_relation_def)
          apply (wp weak_sch_act_wf_lift_linear)+
-       apply (rule_tac Q'="\<lambda>_ s. valid_tcbs s \<and> pspace_aligned s \<and> pspace_distinct s
-                                \<and> ep_at epptr s \<and> valid_sched s
-                                \<and> heap_refs_inv (tcb_scps_of s) (sc_tcbs_of s)
-                                \<and> current_time_bounded s"
-                    in hoare_strengthen_post)
-        apply (rule_tac Q="\<lambda>t s. tcb_at t s \<and> (epptr, TCBBlockedSend) \<in> state_refs_of s t
-                                 \<and> t \<noteq> idle_thread s"
-                     in ball_mapM_scheme)
-          apply (wpsimp wp: restart_thread_if_no_fault_tcb_sts_of_other gts_wp)
-         apply (wpsimp wp: restart_thread_if_no_fault_valid_sched_blocked_on_send[where epptr=epptr]
-                           gts_wp)
-        apply simp
-       apply fastforce
-      apply (rule_tac P'="(\<lambda>s. \<forall>t\<in>set queue. tcb_at' t s \<and> st_tcb_at' (not runnable') t s)
-                         and (\<lambda>s. valid_tcbs' s \<and> weak_sch_act_wf (ksSchedulerAction s) s
-                                  \<and> valid_queues s \<and> valid_queues' s \<and> valid_release_queue_iff s
-                                  \<and> ep_at' epptr s)"
-                   in hoare_weaken_pre[rotated], clarsimp)
-       apply simp
-      apply (rule hoare_strengthen_post)
-       apply (rule_tac Q="\<lambda>t s. tcb_at' t s \<and> st_tcb_at' (not runnable') t s"
-                    in ball_mapM_scheme)
-         apply (wpsimp wp: sts_st_tcb_at'_cases threadGet_wp gts_wp' hoare_vcg_imp_lift
-                     simp: obj_at_ko_at'_eq[where P=\<top>, simplified])
-         apply (clarsimp simp: obj_at'_def pred_neg_def)
-        apply (wpsimp wp: sts_st_tcb_at'_cases threadGet_wp gts_wp' hoare_vcg_imp_lift
-                    simp: obj_at_ko_at'_eq[where P=\<top>, simplified])
-        apply (fastforce simp: valid_tcb_state'_def obj_at'_def projectKOs st_tcb_at'_def
-                               pred_neg_def weak_sch_act_wf_def)
-       apply simp
-      apply simp
-     apply (wpsimp wp: hoare_vcg_ball_lift)
-    apply (wpsimp wp: hoare_vcg_ball_lift)
-   apply (clarsimp simp: obj_at_def is_ep_def cong: conj_cong)
-   apply (prop_tac "valid_ep (Structures_A.SendEP queue) s")
-    apply (fastforce simp: valid_objs_def valid_obj_def
-                     dest: invs_valid_objs)
-   apply (intro conjI impI allI ballI
-          ; (fastforce simp: valid_ep_def obj_at_def is_tcb_def)?)
-    apply (fastforce intro: in_send_ep_queue_TCBBlockedSend)
-   apply (rule not_idle_tcb_in_SendEp; fastforce)
-  apply (clarsimp cong: conj_cong)
-  apply (prop_tac "valid_ep' (Structures_H.SendEP queue) s")
-   apply (fastforce simp: valid_objs'_def valid_obj'_def obj_at'_def projectKOs
-                    dest: invs_valid_objs')
-  apply (intro conjI impI ballI
-         ; (fastforce simp: valid_ep'_def obj_at'_def projectKOs)?)
-  apply (frule (2) in_send_ep_queue_TCBBlockedSend')
-   apply fastforce
-  apply (fastforce simp: st_tcb_at_refs_of_rev' st_tcb_at'_def obj_at'_def pred_neg_def)
-  done
-
-crunch schedContextCancelYieldTo, tcbReleaseRemove
-  for tcbQueued[wp]: "obj_at' (\<lambda>obj. \<not> tcbQueued obj) t"
-  (wp: crunch_wps simp: crunch_simps setReleaseQueue_def setReprogramTimer_def getReleaseQueue_def)
+       apply (wpsimp wp: mapM_wp' set_thread_state_runnable_weak_valid_sched_action
+                    simp: valid_tcb_state'_def)
+       apply ((wpsimp wp: hoare_vcg_imp_lift mapM_wp' sts_valid_objs' simp: valid_tcb_state'_def
+               | strengthen valid_objs'_valid_tcbs')+)[1]
+    apply (wpsimp wp: set_ep_valid_objs')+
+   apply (clarsimp simp: conj_comms)
+   apply (frule sym_refs_ko_atD, clarsimp+)
+   apply (rule obj_at_valid_objsE, assumption+, clarsimp+)
+   apply (clarsimp simp: valid_obj_def valid_ep_def valid_sched_def valid_sched_action_def)
+   apply (rule conjI, fastforce)
+   apply (rule conjI, fastforce)
+   apply (rule conjI, fastforce)
+   apply (rule conjI, erule obj_at_weakenE, clarsimp simp: is_ep)
+   apply (rule conjI, fastforce)
+   apply (clarsimp simp: st_tcb_at_refs_of_rev)
+   apply (drule(1) bspec, drule st_tcb_at_state_refs_ofD, clarsimp)
+   apply (simp add: set_eq_subset)
+  apply (clarsimp simp: obj_at'_weakenE[OF _ TrueI])
+  apply (fastforce simp: valid_ep'_def)
+  done
+
+crunch updateRestartPC
+  for tcb_at'[wp]: "tcb_at' t"
+  (simp: crunch_simps)
 
 lemma suspend_unqueued:
   "\<lbrace>\<top>\<rbrace> suspend t \<lbrace>\<lambda>rv. obj_at' (Not \<circ> tcbQueued) t\<rbrace>"
-  apply (simp add: suspend_def unless_def tcbSchedDequeue_def)
-  apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)
-          apply (wpsimp simp: threadGet_getObject comp_def wp: getObject_tcb_wp)+
-      apply (rule hoare_strengthen_post, rule hoare_TrueI)
-      apply (fastforce simp: obj_at'_def projectKOs)
-     apply (rule hoare_TrueI)
-    apply wpsimp+
-  done
+  unfolding suspend_def
+  by (wpsimp simp: comp_def wp: tcbSchedDequeue_not_tcbQueued)
 
 crunch prepareThreadDelete
   for unqueued: "obj_at' (Not \<circ> tcbQueued) t"
diff --git a/proof/refine/ARM/Ipc_R.thy b/proof/refine/ARM/Ipc_R.thy
index ba0494f88c..e47d7cf621 100644
--- a/proof/refine/ARM/Ipc_R.thy
+++ b/proof/refine/ARM/Ipc_R.thy
@@ -5,10 +5,10 @@
  *)
 
 theory Ipc_R
-imports Finalise_R Reply_R
+imports Finalise_R
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemmas lookup_slot_wrapper_defs'[simp] =
    lookupSourceSlot_def lookupTargetSlot_def lookupPivotSlot_def
@@ -250,17 +250,15 @@ lemma corres_set_extra_badge:
                    add.commute add.left_commute)
   done
 
-end
-
 crunch setExtraBadge
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and valid_pspace'[wp]: valid_pspace'
-  and cte_wp_at'[wp]: "cte_wp_at' P p"
-  and ipc_buffer'[wp]: "valid_ipc_buffer_ptr' buffer"
-
-global_interpretation setExtraBadge: typ_at_all_props' "setExtraBadge buffer badge n"
-  by typ_at_props'
+  for typ_at': "\<lambda>s. P (typ_at' T p s)"
+lemmas setExtraBadge_typ_ats' [wp] = typ_at_lifts [OF setExtraBadge_typ_at']
+crunch setExtraBadge
+  for valid_pspace'[wp]: valid_pspace'
+crunch setExtraBadge
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+crunch setExtraBadge
+  for ipc_buffer'[wp]: "valid_ipc_buffer_ptr' buffer"
 
 crunch getExtraCPtr
   for inv'[wp]: P (wp: dmo_inv' loadWord_inv)
@@ -363,8 +361,6 @@ lemma maskedAsFull_null_cap[simp]:
   "(capability.NullCap  = maskedAsFull x y) = (x = capability.NullCap)"
   by (case_tac x, auto simp:maskedAsFull_def isCap_simps )
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 lemma maskCapRights_eq_null:
   "(RetypeDecls_H.maskCapRights r xa = capability.NullCap) =
    (xa = capability.NullCap)"
@@ -381,6 +377,7 @@ lemma cte_refs'_maskedAsFull[simp]:
    apply (clarsimp simp:maskedAsFull_def isCap_simps)+
  done
 
+
 lemma transferCapsToSlots_corres:
   "\<lbrakk> list_all2 (\<lambda>(cap, slot) (cap', slot'). cap_relation cap cap'
              \<and> slot' = cte_map slot) caps caps';
@@ -423,7 +420,7 @@ next
     apply (rule corres_const_on_failure)
     apply (simp add: dc_def[symmetric] split del: if_split)
     apply (rule corres_guard_imp)
-      apply (rule corres_if3)
+      apply (rule corres_if2)
         apply (case_tac "fst x", auto simp add: isCap_simps)[1]
        apply (rule corres_split[OF corres_set_extra_badge])
           apply (clarsimp simp: is_cap_simps)
@@ -734,12 +731,6 @@ lemma transferCapsToSlots_no_0_obj' [wp]:
   "\<lbrace>no_0_obj'\<rbrace> transferCapsToSlots ep buffer n caps slots mi \<lbrace>\<lambda>rv. no_0_obj'\<rbrace>"
   by (wp transferCapsToSlots_pres1)
 
-crunch transferCapsToSlots
-  for reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and pred_tcb_at'[wp]: "pred_tcb_at' proj P p"
-  and valid_replies' [wp]: valid_replies'
-  and pspace_bounded'[wp]: pspace_bounded'
-
 lemma transferCapsToSlots_vp[wp]:
   "\<lbrace>\<lambda>s. valid_pspace' s \<and> distinct slots
           \<and> length slots \<le> 1
@@ -748,16 +739,17 @@ lemma transferCapsToSlots_vp[wp]:
           \<and> transferCaps_srcs caps s\<rbrace>
     transferCapsToSlots ep buffer n caps slots mi
    \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
-  apply (simp add: valid_pspace'_def | wp)+
+  apply (rule hoare_pre)
+   apply (simp add: valid_pspace'_def | wp)+
   apply (fastforce simp: cte_wp_at_ctes_of dest: ctes_of_valid')
   done
 
 crunch setExtraBadge, doIPCTransfer
   for sch_act [wp]: "\<lambda>s. P (ksSchedulerAction s)"
   (wp: crunch_wps mapME_wp' simp: zipWithM_x_mapM)
-
 crunch setExtraBadge
-  for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
+  for pred_tcb_at' [wp]: "\<lambda>s. pred_tcb_at' proj P p s"
+  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
   and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
   and obj_at' [wp]: "\<lambda>s. P' (obj_at' P p s)"
   and queues [wp]: "\<lambda>s. P (ksReadyQueues s)"
@@ -791,8 +783,7 @@ lemma tcts_iflive[wp]:
   by (wp transferCapsToSlots_pres2 | simp)+
 
 crunch setExtraBadge
-  for valid_idle'[wp]: valid_idle'
-  and if_unsafe'[wp]: if_unsafe_then_cap'
+  for if_unsafe'[wp]: if_unsafe_then_cap'
 
 lemma tcts_ifunsafe[wp]:
   "\<lbrace>\<lambda>s. if_unsafe_then_cap' s \<and> distinct slots \<and>
@@ -801,6 +792,15 @@ lemma tcts_ifunsafe[wp]:
    \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
   by (wp transferCapsToSlots_pres2 | simp)+
 
+crunch ensureNoChildren
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+
+crunch deriveCap
+  for idle'[wp]: "valid_idle'"
+
+crunch setExtraBadge
+  for valid_idle'[wp]: valid_idle'
+
 lemma tcts_idle'[wp]:
   "\<lbrace>\<lambda>s. valid_idle' s\<rbrace> transferCapsToSlots ep buffer n caps slots mi
    \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
@@ -982,12 +982,20 @@ lemma tcts_zero_ranges[wp]:
   apply auto[1]
   done
 
-crunch setExtraBadge, transferCapsToSlots
+crunch setExtraBadge
   for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
+crunch transferCapsToSlots
+  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
+crunch transferCapsToSlots
+  for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
+crunch setExtraBadge
+  for ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
+crunch setExtraBadge
+  for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+crunch transferCapsToSlots
+  for ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
+crunch transferCapsToSlots
+  for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
 
 crunch transferCapsToSlots
   for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
@@ -997,14 +1005,14 @@ crunch transferCapsToSlots
 
 lemma transferCapsToSlots_invs[wp]:
   "\<lbrace>\<lambda>s. invs' s \<and> distinct slots
-        \<and> (\<forall>x \<in> set slots. cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) x s)
-        \<and> (\<forall>x \<in> set slots. ex_cte_cap_to' x s)
-        \<and> (\<forall>x \<in> set slots. real_cte_at' x s)
-        \<and> length slots \<le> 1
-        \<and> transferCaps_srcs caps s\<rbrace>
-   transferCapsToSlots ep buffer n caps slots mi
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
+          \<and> (\<forall>x \<in> set slots. cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) x s)
+          \<and> (\<forall>x \<in> set slots. ex_cte_cap_to' x s)
+          \<and> (\<forall>x \<in> set slots. real_cte_at' x s)
+          \<and> length slots \<le> 1
+          \<and> transferCaps_srcs caps s\<rbrace>
+    transferCapsToSlots ep buffer n caps slots mi
+   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def)
   apply (wp valid_irq_node_lift)
   apply fastforce
   done
@@ -1031,8 +1039,8 @@ lemma transferCaps_corres:
     and case_option \<top> in_user_frame recv_buf
     and (\<lambda>s. valid_message_info info)
     and transfer_caps_srcs caps)
-   (tcb_at' receiver and valid_objs' and valid_replies' and
-    pspace_aligned' and pspace_distinct' and pspace_bounded' and no_0_obj' and valid_mdb'
+   (tcb_at' receiver and valid_objs' and
+    pspace_aligned' and pspace_distinct' and no_0_obj' and valid_mdb'
     and (\<lambda>s. case ep of Some x \<Rightarrow> ep_at' x s | _ \<Rightarrow> True)
     and case_option \<top> valid_ipc_buffer_ptr' recv_buf
     and transferCaps_srcs caps'
@@ -1073,16 +1081,10 @@ lemma transferCaps_corres:
   apply (fastforce simp:valid_cap'_def)
   done
 
-end
-
 crunch transferCaps
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
 
-global_interpretation transferCaps: typ_at_all_props' "transferCaps info caps endpoint receiver receiveBuffer"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas transferCaps_typ_ats[wp] = typ_at_lifts [OF transferCaps_typ_at']
 
 lemma isIRQControlCap_mask [simp]:
   "isIRQControlCap (maskCapRights R c) = isIRQControlCap c"
@@ -1095,12 +1097,16 @@ lemma isIRQControlCap_mask [simp]:
   done
 
 lemma isPageCap_maskCapRights[simp]:
-  "isArchCap isPageCap (RetypeDecls_H.maskCapRights R c) = isArchCap isPageCap c"
+" isArchCap isPageCap (RetypeDecls_H.maskCapRights R c) = isArchCap isPageCap c"
   apply (case_tac c; simp add: isCap_simps isArchCap_def maskCapRights_def)
   apply (rename_tac arch_capability)
   apply (case_tac arch_capability; simp add: isCap_simps ARM_H.maskCapRights_def)
   done
 
+lemma capReplyMaster_mask[simp]:
+  "isReplyCap c \<Longrightarrow> capReplyMaster (maskCapRights R c) = capReplyMaster c"
+  by (clarsimp simp: isCap_simps maskCapRights_def)
+
 lemma is_derived_mask' [simp]:
   "is_derived' m p (maskCapRights R c) = is_derived' m p c"
   apply (rule ext)
@@ -1149,17 +1155,12 @@ lemma get_mrs_inv'[wp]:
           | wp dmo_inv' loadWord_inv mapM_wp'
             asUser_inv det_mapM[where S=UNIV] | wpc)+
 
-end
-
-crunch copyMRs
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: crunch_wps)
 
-global_interpretation copyMRs: typ_at_all_props' "copyMRs s sb r rb n"
-  by typ_at_props'
+lemma copyMRs_typ_at':
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
+  by (simp add: copyMRs_def | wp mapM_wp [where S=UNIV, simplified] | wpc)+
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas copyMRs_typ_at_lifts[wp] = typ_at_lifts [OF copyMRs_typ_at']
 
 lemma copy_mrs_invs'[wp]:
   "\<lbrace> invs' and tcb_at' s and tcb_at' r \<rbrace> copyMRs s sb r rb n \<lbrace>\<lambda>rv. invs' \<rbrace>"
@@ -1184,12 +1185,29 @@ crunch transferCaps
   for distinct'[wp]: pspace_distinct'
   (wp: crunch_wps simp: zipWithM_x_mapM)
 
+crunch setMRs
+  for aligned'[wp]: pspace_aligned'
+  (wp: crunch_wps simp: crunch_simps)
+crunch setMRs
+  for distinct'[wp]: pspace_distinct'
+  (wp: crunch_wps simp: crunch_simps)
 crunch copyMRs
- for aligned'[wp]: pspace_aligned'
+  for aligned'[wp]: pspace_aligned'
   (wp: crunch_wps simp: crunch_simps wp: crunch_wps)
 crunch copyMRs
   for distinct'[wp]: pspace_distinct'
   (wp: crunch_wps simp: crunch_simps wp: crunch_wps)
+crunch setMessageInfo
+  for aligned'[wp]: pspace_aligned'
+  (wp: crunch_wps simp: crunch_simps)
+crunch setMessageInfo
+  for distinct'[wp]: pspace_distinct'
+  (wp: crunch_wps simp: crunch_simps)
+
+crunch storeWordUser
+  for valid_objs'[wp]: valid_objs'
+crunch storeWordUser
+  for valid_pspace'[wp]: valid_pspace'
 
 lemma set_mrs_valid_objs' [wp]:
   "\<lbrace>valid_objs'\<rbrace> setMRs t a msgs \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
@@ -1371,9 +1389,6 @@ lemma lookupExtraCaps_corres:
 
 crunch copyMRs
   for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and valid_replies' [wp]: valid_replies'
-  and pspace_bounded'[wp]: pspace_bounded'
   (wp: threadSet_ctes_of crunch_wps)
 
 lemma copyMRs_valid_mdb[wp]:
@@ -1387,8 +1402,8 @@ lemma doNormalTransfer_corres:
    and (\<lambda>s. case ep of Some x \<Rightarrow> ep_at x s | _ \<Rightarrow> True)
    and case_option \<top> in_user_frame send_buf
    and case_option \<top> in_user_frame recv_buf)
-  (tcb_at' sender and tcb_at' receiver and valid_objs' and valid_replies'
-   and pspace_aligned' and pspace_distinct' and pspace_bounded' and cur_tcb'
+  (tcb_at' sender and tcb_at' receiver and valid_objs'
+   and pspace_aligned' and pspace_distinct' and cur_tcb'
    and valid_mdb' and no_0_obj'
    and (\<lambda>s. case ep of Some x \<Rightarrow> ep_at' x s | _ \<Rightarrow> True)
    and case_option \<top> valid_ipc_buffer_ptr' send_buf
@@ -1443,15 +1458,10 @@ lemmas corres_ipc_info_helper =
   corres_split_maprE [where f = message_info_map, OF _
                                 corres_liftE_lift [OF getMessageInfo_corres]]
 
-end
-
 crunch doNormalTransfer
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: crunch_wps)
 
-global_interpretation doNormalTransfer: typ_at_all_props' "doNormalTransfer s sb e b g r rb"
-  by typ_at_props'
+lemmas doNormal_lifts[wp] = typ_at_lifts [OF doNormalTransfer_typ_at']
 
 lemma doNormal_invs'[wp]:
   "\<lbrace>tcb_at' sender and tcb_at' receiver and invs'\<rbrace>
@@ -1496,8 +1506,6 @@ lemma msgFromLookupFailure_map[simp]:
      = msg_from_lookup_failure lf"
   by (cases lf, simp_all add: lookup_failure_map_def msgFromLookupFailure_def)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 lemma asUser_getRestartPC_corres:
   "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
      (as_user t getRestartPC) (asUser t getRestartPC)"
@@ -1546,65 +1554,35 @@ lemma makeFaultMessage_corres:
      apply (rule corres_split_eqr[OF asUser_mapM_getRegister_corres])
        apply (rule corres_trivial, simp)
       apply (wp | simp)+
-   apply (clarsimp simp: threadGet_getObject)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF getObject_TCB_corres])
-       apply (rename_tac tcb tcb')
-       apply (rule_tac P="\<lambda>s. (bound (tcb_sched_context tcb) \<longrightarrow> sc_at (the (tcb_sched_context tcb)) s)
-                              \<and> pspace_aligned s \<and> pspace_distinct s"
-                    in corres_inst)
-       apply (case_tac "tcb_sched_context tcb"
-              ; case_tac "tcbSchedContext tcb'"
-              ; clarsimp simp: tcb_relation_def)
-       apply (rule corres_underlying_split)
-          apply (rule_tac Q="sc_at' (the (tcbSchedContext tcb'))" and P'=\<top> in corres_cross_add_guard)
-           apply (fastforce dest!: state_relationD intro!: sc_at_cross simp: obj_at'_def)[1]
-          apply (rule corres_guard_imp)
-            apply (rule schedContextUpdateConsumed_corres)
-           apply (wpsimp simp: sched_context_update_consumed_def setTimeArg_def)+
-    apply (fastforce dest!: valid_tcb_objs simp: valid_tcb_def valid_bound_obj_def obj_at_def)
-   apply clarsimp
-  apply (corresKsimp corres: makeArchFaultMessage_corres)
+  apply (rule makeArchFaultMessage_corres)
   done
 
-crunch makeFaultMessage
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-
-end
-
-global_interpretation makeFaultMessage: typ_at_all_props' "makeFaultMessage x t"
-  by typ_at_props'
+lemma makeFaultMessage_inv[wp]:
+  "\<lbrace>P\<rbrace> makeFaultMessage ft t \<lbrace>\<lambda>rv. P\<rbrace>"
+  apply (cases ft, simp_all add: makeFaultMessage_def)
+     apply (wp asUser_inv mapM_wp' det_mapM[where S=UNIV]
+               det_getRestartPC getRestartPC_inv
+             | clarsimp simp: getRegister_def makeArchFaultMessage_def
+                        split: arch_fault.split)+
+  done
 
 lemmas threadget_fault_corres =
           threadGet_corres [where r = fault_rel_optionation
                               and f = tcb_fault and f' = tcbFault,
                             simplified tcb_relation_def, simplified]
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-crunch make_fault_msg
-  for in_user_Frame[wp]: "in_user_frame buffer"
-
-lemma makeFaultMessage_valid_ipc_buffer_ptr'[wp]:
-  "makeFaultMessage x thread \<lbrace>valid_ipc_buffer_ptr' p\<rbrace>"
-  unfolding valid_ipc_buffer_ptr'_def2
-  apply (wpsimp wp: hoare_vcg_all_lift)
-  done
-
 lemma doFaultTransfer_corres:
   "corres dc
-    (valid_objs and pspace_distinct and pspace_aligned
-     and obj_at (\<lambda>ko. \<exists>tcb ft. ko = TCB tcb \<and> tcb_fault tcb = Some ft) sender
-     and tcb_at receiver and case_option \<top> in_user_frame recv_buf)
+    (obj_at (\<lambda>ko. \<exists>tcb ft. ko = TCB tcb \<and> tcb_fault tcb = Some ft) sender
+     and tcb_at receiver and case_option \<top> in_user_frame recv_buf
+     and pspace_aligned and pspace_distinct)
     (tcb_at' sender and tcb_at' receiver and
      case_option \<top> valid_ipc_buffer_ptr' recv_buf)
     (do_fault_transfer badge sender receiver recv_buf)
     (doFaultTransfer badge sender receiver recv_buf)"
   apply (clarsimp simp: do_fault_transfer_def doFaultTransfer_def split_def
                         ARM_H.badgeRegister_def badge_register_def)
-  apply (rule_tac Q="\<lambda>fault. valid_objs and pspace_distinct and pspace_aligned and
-                             K (\<exists>f. fault = Some f) and
+  apply (rule_tac Q="\<lambda>fault. K (\<exists>f. fault = Some f) and
                              tcb_at sender and tcb_at receiver and
                              case_option \<top> in_user_frame recv_buf and
                              pspace_aligned and pspace_distinct"
@@ -1642,18 +1620,51 @@ lemma doFaultTransfer_corres:
          apply (wp | simp)+
   done
 
-crunch makeFaultMessage
-  for iflive[wp]: if_live_then_nonz_cap'
-  and idle'[wp]: valid_idle'
-
-crunch makeFaultMessage
-  for invs'[wp]: invs'
-
 lemma doFaultTransfer_invs[wp]:
-  "\<lbrace>invs' and tcb_at' receiver and tcb_at' sender\<rbrace>
-   doFaultTransfer badge sender receiver recv_buf
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (wpsimp simp: doFaultTransfer_def split_def split: option.split)
+  "\<lbrace>invs' and tcb_at' receiver\<rbrace>
+      doFaultTransfer badge sender receiver recv_buf
+   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  by (simp add: doFaultTransfer_def split_def | wp
+    | clarsimp split: option.split)+
+
+lemma lookupIPCBuffer_valid_ipc_buffer [wp]:
+  "\<lbrace>valid_objs'\<rbrace> VSpace_H.lookupIPCBuffer b s \<lbrace>case_option \<top> valid_ipc_buffer_ptr'\<rbrace>"
+  unfolding lookupIPCBuffer_def ARM_H.lookupIPCBuffer_def
+  apply (simp add: Let_def getSlotCap_def getThreadBufferSlot_def
+                   locateSlot_conv threadGet_def comp_def)
+  apply (wp getCTE_wp getObject_tcb_wp | wpc)+
+  apply (clarsimp simp del: imp_disjL)
+  apply (drule obj_at_ko_at')
+  apply (clarsimp simp del: imp_disjL)
+  apply (rule_tac x = ko in exI)
+  apply (frule ko_at_cte_ipcbuffer)
+  apply (clarsimp simp: cte_wp_at_ctes_of simp del: imp_disjL)
+  apply (clarsimp simp: valid_ipc_buffer_ptr'_def)
+  apply (frule (1) ko_at_valid_objs')
+   apply (clarsimp simp: projectKO_opts_defs split: kernel_object.split_asm)
+  apply (clarsimp simp add: valid_obj'_def valid_tcb'_def
+                            isCap_simps cte_level_bits_def field_simps)
+  apply (drule bspec [OF _ ranI [where a = "0x40"]])
+   apply simp
+  apply (clarsimp simp add: valid_cap'_def)
+  apply (rule conjI)
+   apply (rule aligned_add_aligned)
+     apply (clarsimp simp add: capAligned_def)
+     apply assumption
+    apply (erule is_aligned_andI1)
+   apply (case_tac xd, simp_all add: msg_align_bits)[1]
+  apply (clarsimp simp: capAligned_def)
+  apply (drule_tac x =
+    "(tcbIPCBuffer ko && mask (pageBitsForSize xd))  >> pageBits" in spec)
+  apply (subst(asm) mult.commute mult.left_commute, subst(asm) shiftl_t2n[symmetric])
+  apply (simp add: shiftr_shiftl1)
+  apply (subst (asm) mask_out_add_aligned)
+   apply (erule is_aligned_weaken [OF _ pbfs_atleast_pageBits])
+  apply (erule mp)
+  apply (rule shiftr_less_t2n)
+  apply (clarsimp simp: pbfs_atleast_pageBits)
+  apply (rule and_mask_less')
+  apply (simp add: word_bits_conv)
   done
 
 lemma doIPCTransfer_corres:
@@ -1685,7 +1696,7 @@ lemma doIPCTransfer_corres:
      defer
      apply (rule corres_guard_imp)
        apply (subst case_option_If)+
-       apply (rule corres_if3)
+       apply (rule corres_if2)
          apply (simp add: fault_rel_optionation_def)
         apply (rule corres_split_eqr[OF lookupIPCBuffer_corres'])
           apply (simp add: dc_def[symmetric])
@@ -1698,32 +1709,51 @@ lemma doIPCTransfer_corres:
     apply (wp|simp add: obj_at_def is_tcb valid_pspace'_def)+
   done
 
+
 crunch doIPCTransfer
   for ifunsafe[wp]: "if_unsafe_then_cap'"
-  and iflive[wp]: "if_live_then_nonz_cap'"
-  and sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  and vq[wp]: "valid_queues"
-  and vq'[wp]: "valid_queues'"
-  and state_refs_of[wp]: "\<lambda>s. P (state_refs_of' s)"
-  and ct[wp]: "cur_tcb'"
-  and idle'[wp]: "valid_idle'"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  and valid_arch_state'[wp]: "valid_arch_state'"
-  and vrq[wp]: valid_release_queue
-  (wp: crunch_wps
-   simp: zipWithM_x_mapM ball_conj_distrib)
+  (wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' ignore: transferCapsToSlots
+    simp: zipWithM_x_mapM ball_conj_distrib )
+crunch doIPCTransfer
+  for iflive[wp]: "if_live_then_nonz_cap'"
+  (wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' ignore: transferCapsToSlots
+    simp: zipWithM_x_mapM ball_conj_distrib )
+lemma valid_pspace_valid_objs'[elim!]:
+  "valid_pspace' s \<Longrightarrow> valid_objs' s"
+  by (simp add: valid_pspace'_def)
+crunch doIPCTransfer
+  for vp[wp]: "valid_pspace'"
+  (wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' wp: transferCapsToSlots_vp simp:ball_conj_distrib )
+crunch doIPCTransfer
+  for sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
+  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
+crunch doIPCTransfer
+  for state_refs_of[wp]: "\<lambda>s. P (state_refs_of' s)"
+  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
+crunch doIPCTransfer
+  for ct[wp]: "cur_tcb'"
+  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
+crunch doIPCTransfer
+  for idle'[wp]: "valid_idle'"
+  (wp: crunch_wps get_rs_cte_at' ignore: transferCapsToSlots  simp: zipWithM_x_mapM)
 
-end
+crunch doIPCTransfer
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps  simp: zipWithM_x_mapM)
+lemmas dit'_typ_ats[wp] = typ_at_lifts [OF doIPCTransfer_typ_at']
 
-global_interpretation doIPCTransfer: typ_at_all_props' "doIPCTransfer s e b g r"
-  by typ_at_props'
+crunch doIPCTransfer
+  for irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+  (wp: crunch_wps simp: crunch_simps)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas dit_irq_node'[wp]
+    = valid_irq_node_lift [OF doIPCTransfer_irq_node' doIPCTransfer_typ_at']
 
-lemmas dit_irq_node'[wp] = valid_irq_node_lift [OF doIPCTransfer_irq_node' doIPCTransfer_typ_at']
+crunch doIPCTransfer
+  for valid_arch_state'[wp]: "valid_arch_state'"
+  (wp: crunch_wps simp: crunch_simps)
 
+(* Levity: added (20090126 19:32:26) *)
 declare asUser_global_refs' [wp]
 
 lemma lec_valid_cap' [wp]:
@@ -1733,22 +1763,42 @@ lemma lec_valid_cap' [wp]:
      apply (rule lookupExtraCaps_srcs)
     apply wp
    apply (clarsimp simp: cte_wp_at_ctes_of)
-   apply (fastforce)
+   apply (fastforce elim: ctes_of_valid')
   apply simp
   done
 
-declare asUser_irq_handlers'[wp]
-
 crunch doIPCTransfer
   for objs'[wp]: "valid_objs'"
-  and global_refs'[wp]: "valid_global_refs'"
-  and irq_handlers'[wp]: "valid_irq_handlers'"
-  and irq_states'[wp]: "valid_irq_states'"
-  and pde_mappings'[wp]: "valid_pde_mappings'"
-  and irqs_masked'[wp]: "irqs_masked'"
-  (wp: crunch_wps hoare_vcg_const_Ball_lift
-   simp: zipWithM_x_mapM ball_conj_distrib
-   rule: irqs_masked_lift)
+   (    wp: crunch_wps hoare_vcg_const_Ball_lift
+            transferCapsToSlots_valid_objs
+      simp: zipWithM_x_mapM ball_conj_distrib )
+
+crunch doIPCTransfer
+  for global_refs'[wp]: "valid_global_refs'"
+  (wp: crunch_wps hoare_vcg_const_Ball_lift threadSet_global_refsT
+       transferCapsToSlots_valid_globals
+      simp: zipWithM_x_mapM ball_conj_distrib)
+
+declare asUser_irq_handlers' [wp]
+
+crunch doIPCTransfer
+  for irq_handlers'[wp]: "valid_irq_handlers'"
+  (wp: crunch_wps hoare_vcg_const_Ball_lift threadSet_irq_handlers'
+       transferCapsToSlots_irq_handlers
+       simp: zipWithM_x_mapM ball_conj_distrib )
+
+crunch doIPCTransfer
+  for irq_states'[wp]: "valid_irq_states'"
+  (wp: crunch_wps no_irq no_irq_mapM no_irq_storeWord no_irq_loadWord
+       no_irq_case_option simp: crunch_simps zipWithM_x_mapM)
+
+crunch doIPCTransfer
+  for pde_mappings'[wp]: "valid_pde_mappings'"
+  (wp: crunch_wps simp: crunch_simps)
+
+crunch doIPCTransfer
+  for irqs_masked'[wp]: "irqs_masked'"
+  (wp: crunch_wps simp: crunch_simps rule: irqs_masked_lift)
 
 lemma doIPCTransfer_invs[wp]:
   "\<lbrace>invs' and tcb_at' s and tcb_at' r\<rbrace>
@@ -1758,6 +1808,11 @@ lemma doIPCTransfer_invs[wp]:
   apply (wpsimp wp: hoare_drop_imp)
   done
 
+crunch doIPCTransfer
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  (wp: hoare_drop_imps hoare_vcg_split_case_option mapM_wp'
+   simp: split_def zipWithM_x_mapM)
+
 lemma handle_fault_reply_registers_corres:
   "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
            (do t' \<leftarrow> arch_get_sanitise_register_info t;
@@ -1788,46 +1843,71 @@ lemma handle_fault_reply_registers_corres:
 
 lemma handleFaultReply_corres:
   "ft' = fault_map ft \<Longrightarrow>
-   corres (=) (tcb_at t) (tcb_at' t)
-          (handle_fault_reply ft t label msg)
-          (handleFaultReply ft' t label msg)"
-  apply (cases ft; simp add: handleFaultReply_def handle_arch_fault_reply_def
-                             handleArchFaultReply_def syscallMessage_def exceptionMessage_def
-                        split: arch_fault.split)
-  by (rule handle_fault_reply_registers_corres)+
+   corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+     (handle_fault_reply ft t label msg)
+     (handleFaultReply ft' t label msg)"
+  apply (cases ft)
+     apply(simp_all add: handleFaultReply_def
+                         handle_arch_fault_reply_def handleArchFaultReply_def
+                         syscallMessage_def exceptionMessage_def
+                    split: arch_fault.split)
+   by (rule handle_fault_reply_registers_corres)+
 
 crunch handleFaultReply
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and ct'[wp]: "\<lambda>s. P (ksCurThread s)"
-  and nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
 
-end
+lemmas hfr_typ_ats[wp] = typ_at_lifts [OF handleFaultReply_typ_at']
 
-global_interpretation handleFaultReply: typ_at_all_props' "handleFaultReply x t l m"
-  by typ_at_props'
+crunch handleFaultReply
+  for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
 
 lemma doIPCTransfer_sch_act_simple [wp]:
   "\<lbrace>sch_act_simple\<rbrace> doIPCTransfer sender endpoint badge grant receiver \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
   by (simp add: sch_act_simple_def, wp)
 
+lemma possibleSwitchTo_invs'[wp]:
+  "\<lbrace>invs' and st_tcb_at' runnable' t
+          and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
+   possibleSwitchTo t \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (simp add: possibleSwitchTo_def curDomain_def)
+  apply (wp tcbSchedEnqueue_invs' ssa_invs')
+       apply (rule hoare_post_imp[OF _ rescheduleRequired_sa_cnt])
+      apply (wpsimp wp: ssa_invs' threadGet_wp)+
+  apply (clarsimp dest!: obj_at_ko_at' simp: tcb_in_cur_domain'_def obj_at'_def)
+  done
+
 crunch isFinalCapability
-  for cur' [wp]: "\<lambda>s. P (cur_tcb' s)"
+  for cur'[wp]: "\<lambda>s. P (cur_tcb' s)"
   (simp: crunch_simps unless_when
-     wp: crunch_wps getObject_inv)
+     wp: crunch_wps getObject_inv loadObject_default_inv)
+
+crunch deleteCallerCap
+  for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
+  (simp: crunch_simps unless_when
+     wp: crunch_wps getObject_inv loadObject_default_inv)
+
+lemma getThreadCallerSlot_inv:
+  "\<lbrace>P\<rbrace> getThreadCallerSlot t \<lbrace>\<lambda>_. P\<rbrace>"
+  by (simp add: getThreadCallerSlot_def, wp)
+
+crunch unbindNotification
+  for tcb_at'[wp]: "tcb_at' x"
 
 lemma finaliseCapTrue_standin_tcb_at' [wp]:
   "\<lbrace>tcb_at' x\<rbrace> finaliseCapTrue_standin cap v2 \<lbrace>\<lambda>_. tcb_at' x\<rbrace>"
-  by (rule finaliseCapTrue_standin_tcbDomain_obj_at')
-
-crunch finaliseCapTrue_standin
-  for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps simp: crunch_simps)
+  apply (simp add: finaliseCapTrue_standin_def Let_def)
+  apply (safe)
+       apply (wp getObject_ntfn_inv
+            | wpc
+            | simp)+
+  done
 
 lemma finaliseCapTrue_standin_cur':
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> finaliseCapTrue_standin cap v2 \<lbrace>\<lambda>_ s'. cur_tcb' s'\<rbrace>"
-  unfolding cur_tcb'_def
-  by (wp_pre, wps, wp, assumption)
+  apply (simp add: cur_tcb'_def)
+  apply (rule hoare_lift_Pf2 [OF _ finaliseCapTrue_standin_ct'])
+  apply (wp)
+  done
 
 lemma cteDeleteOne_cur' [wp]:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> cteDeleteOne slot \<lbrace>\<lambda>_ s'. cur_tcb' s'\<rbrace>"
@@ -1843,12 +1923,89 @@ lemma handleFaultReply_cur' [wp]:
   apply (wp)
   done
 
-lemma replyRemove_valid_objs'[wp]:
-  "replyRemove replyPtr tcbPtr \<lbrace>valid_objs'\<rbrace>"
-  unfolding replyRemove_def
-  by (wpsimp wp: updateReply_valid_objs' replyUnlink_valid_objs'
-                 hoare_vcg_if_lift hoare_drop_imps
-           simp: valid_reply'_def split_del: if_split)
+lemma capClass_Reply:
+  "capClass cap = ReplyClass tcb \<Longrightarrow> isReplyCap cap \<and> capTCBPtr cap = tcb"
+  apply (cases cap, simp_all add: isCap_simps)
+  apply (rename_tac arch_capability)
+  apply (case_tac arch_capability, simp_all)
+  done
+
+lemma reply_cap_end_mdb_chain:
+  "\<lbrakk> cte_wp_at (is_reply_cap_to t) slot s; invs s;
+     invs' s';
+     (s, s') \<in> state_relation; ctes_of s' (cte_map slot) = Some cte \<rbrakk>
+      \<Longrightarrow> (mdbPrev (cteMDBNode cte) \<noteq> nullPointer
+            \<and> mdbNext (cteMDBNode cte) = nullPointer)
+           \<and> cte_wp_at' (\<lambda>cte. isReplyCap (cteCap cte) \<and> capReplyMaster (cteCap cte))
+                    (mdbPrev (cteMDBNode cte)) s'"
+  apply (clarsimp simp only: cte_wp_at_reply_cap_to_ex_rights)
+  apply (frule(1) pspace_relation_ctes_ofI[OF state_relation_pspace_relation],
+         clarsimp+)
+  apply (subgoal_tac "\<exists>slot' rights'. caps_of_state s slot' = Some (cap.ReplyCap t True rights')
+                          \<and> descendants_of slot' (cdt s) = {slot}")
+   apply (elim state_relationE exE)
+   apply (clarsimp simp: cdt_relation_def
+               simp del: split_paired_All)
+   apply (drule spec, drule(1) mp[OF _ caps_of_state_cte_at])
+   apply (frule(1) pspace_relation_cte_wp_at[OF _ caps_of_state_cteD],
+          clarsimp+)
+   apply (clarsimp simp: descendants_of'_def cte_wp_at_ctes_of)
+   apply (frule_tac f="\<lambda>S. cte_map slot \<in> S" in arg_cong, simp(no_asm_use))
+   apply (frule invs_mdb'[unfolded valid_mdb'_def])
+   apply (rule context_conjI)
+    apply (clarsimp simp: nullPointer_def valid_mdb_ctes_def)
+    apply (erule(4) subtree_prev_0)
+   apply (rule conjI)
+    apply (rule ccontr)
+    apply (frule valid_mdb_no_loops, simp add: no_loops_def)
+    apply (drule_tac x="cte_map slot" in spec)
+    apply (erule notE, rule r_into_trancl, rule ccontr)
+    apply (clarsimp simp: mdb_next_unfold valid_mdb_ctes_def nullPointer_def)
+    apply (rule valid_dlistEn, assumption+)
+    apply (subgoal_tac "ctes_of s' \<turnstile> cte_map slot \<leadsto> mdbNext (cteMDBNode cte)")
+     apply (frule(3) class_linksD)
+     apply (clarsimp simp: isCap_simps dest!: capClass_Reply[OF sym])
+     apply (drule_tac f="\<lambda>S. mdbNext (cteMDBNode cte) \<in> S" in arg_cong)
+     apply (simp, erule notE, rule subtree.trans_parent, assumption+)
+     apply (case_tac ctea, case_tac cte')
+     apply (clarsimp simp add: parentOf_def isMDBParentOf_CTE)
+     apply (simp add: sameRegionAs_def2 isCap_simps)
+     apply (erule subtree.cases)
+      apply (clarsimp simp: parentOf_def isMDBParentOf_CTE)
+     apply (clarsimp simp: parentOf_def isMDBParentOf_CTE)
+    apply (simp add: mdb_next_unfold)
+   apply (erule subtree.cases)
+    apply (clarsimp simp: valid_mdb_ctes_def)
+    apply (erule_tac cte=ctea in valid_dlistEn, assumption)
+     apply (simp add: mdb_next_unfold)
+    apply (clarsimp simp: mdb_next_unfold isCap_simps)
+   apply (drule_tac f="\<lambda>S. c' \<in> S" in arg_cong)
+   apply (clarsimp simp: no_loops_direct_simp valid_mdb_no_loops)
+  apply (frule invs_mdb)
+  apply (drule invs_valid_reply_caps)
+  apply (clarsimp simp: valid_mdb_def reply_mdb_def
+                        valid_reply_caps_def reply_caps_mdb_def
+                        cte_wp_at_caps_of_state
+              simp del: split_paired_All)
+
+  apply (erule_tac x=slot in allE, erule_tac x=t in allE, erule impE, fast)
+  apply (elim exEI)
+  apply clarsimp
+  apply (subgoal_tac "P" for P, rule sym, rule equalityI, assumption)
+   apply clarsimp
+   apply (erule(4) unique_reply_capsD)
+  apply (simp add: descendants_of_def)
+  apply (rule r_into_trancl)
+  apply (simp add: cdt_parent_rel_def is_cdt_parent_def)
+  done
+
+crunch cteDeleteOne
+  for valid_objs'[wp]: "valid_objs'"
+  (simp: crunch_simps unless_def
+   wp: crunch_wps getObject_inv loadObject_default_inv)
+
+crunch handleFaultReply
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma emptySlot_weak_sch_act[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
@@ -1872,340 +2029,333 @@ lemma cancelAllSignals_weak_sch_act_wf[wp]:
   apply (wp rescheduleRequired_weak_sch_act_wf hoare_drop_imp | wpc | simp)+
   done
 
-lemma setSchedContext_weak_sch_act_wf:
-  "setSchedContext p sc \<lbrace> \<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>"
-  apply (wp weak_sch_act_wf_lift)
-  done
-
-lemma setReply_weak_sch_act_wf:
-  "setReply p r \<lbrace> \<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<rbrace>"
-  apply (wp weak_sch_act_wf_lift)
-  done
-
-crunch replyUnlink
-  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  (simp: crunch_simps wp: crunch_wps)
-
-crunch unbindMaybeNotification, schedContextMaybeUnbindNtfn, isFinalCapability,
-         cleanReply
-  for sch_act_not[wp]: "sch_act_not t"
-  (wp: crunch_wps simp: crunch_simps)
-
-crunch replyRemove, replyRemoveTCB
+crunch finaliseCapTrue_standin
   for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-  (simp: crunch_simps wp: crunch_wps)
-
-lemma cancelSignal_weak_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<and> sch_act_not threadPtr s\<rbrace>
-   cancelSignal threadPtr ntfnPtr
-   \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding cancelSignal_def Let_def
-  by (wpsimp wp: gts_wp' | wp (once) hoare_drop_imp)+
+  (ignore: setThreadState
+     simp: crunch_simps
+       wp: crunch_wps getObject_inv loadObject_default_inv)
 
-lemma cancelIPC_weak_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<and> sch_act_not tptr s\<rbrace>
-   cancelIPC tptr
-   \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding cancelIPC_def blockedCancelIPC_def Let_def getBlockingObject_def
-  apply (wpsimp wp: gts_wp' threadSet_weak_sch_act_wf hoare_vcg_all_lift
-         | wp (once) hoare_drop_imps)+
-  done
-
-lemma replyClear_weak_sch_act_wf[wp]:
+lemma cteDeleteOne_weak_sch_act[wp]:
   "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-   replyClear rptr tptr
+   cteDeleteOne sl
    \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding replyClear_def
-  apply (wpsimp wp: gts_wp' simp: pred_tcb_at'_eq_commute)
-  apply (auto simp: pred_tcb_at'_def obj_at'_def weak_sch_act_wf_def)
+  apply (simp add: cteDeleteOne_def unless_def)
+  apply (wp hoare_drop_imps finaliseCapTrue_standin_cur' isFinalCapability_cur'
+         | simp add: split_def)+
   done
 
+crunch emptySlot
+  for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
+
 crunch handleFaultReply
   for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
 crunch handleFaultReply
   for tcb_in_cur_domain'[wp]: "tcb_in_cur_domain' t"
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-crunch handleFaultReply
-  for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
-  and valid_queues[wp]: "Invariants_H.valid_queues"
-  and valid_queues'[wp]: "valid_queues'"
-  and tcb_in_cur_domain'[wp]: "tcb_in_cur_domain' t"
-
 crunch unbindNotification
   for sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  (wp: sbn_sch_act')
+(wp: sbn_sch_act')
 
-lemma possibleSwitchTo_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues and valid_objs' and
-    (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and st_tcb_at' runnable' t\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  by (wpsimp wp: hoare_drop_imps hoare_vcg_if_lift2
-           simp: inReleaseQueue_def possibleSwitchTo_def curDomain_def bitmap_fun_defs)
-
-lemma cancelAllIPC_valid_queues':
-  "cancelAllIPC t \<lbrace> valid_queues' \<rbrace>"
-  apply (clarsimp simp: cancelAllIPC_def)
-  apply (wpsimp wp: mapM_x_wp' get_ep_inv' getEndpoint_wp)
-  done
+crunch handleFaultReply
+  for valid_objs'[wp]: valid_objs'
 
-lemma cancelAllSignals_valid_queues':
-  "cancelAllSignals t \<lbrace> valid_queues' \<rbrace>"
-  apply (clarsimp simp: cancelAllSignals_def)
-  apply (wpsimp wp: mapM_x_wp' getNotification_wp)
-  done
+lemma cte_wp_at_is_reply_cap_toI:
+  "cte_wp_at ((=) (cap.ReplyCap t False rights)) ptr s
+   \<Longrightarrow> cte_wp_at (is_reply_cap_to t) ptr s"
+  by (fastforce simp: cte_wp_at_reply_cap_to_ex_rights)
 
-crunch cteDeleteOne
-  for valid_queues'[wp]: valid_queues'
-  (simp: crunch_simps inQ_def
-     wp: crunch_wps sts_st_tcb' getObject_inv threadSet_valid_queues')
+crunch handle_fault_reply
+  for pspace_alignedp[wp]: pspace_aligned
+  and pspace_distinct[wp]: pspace_distinct
 
-crunch handleFaultReply
-  for valid_objs'[wp]: valid_objs'
+crunch cteDeleteOne, doIPCTransfer, handleFaultReply
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and pspace_aligned'[wp]: pspace_aligned'
+  and pspace_distinct'[wp]: pspace_distinct'
+  (rule: sym_heap_sched_pointers_lift wp: crunch_wps simp: crunch_simps)
 
-lemma bind_sc_reply_weak_valid_sched_action[wp]:
-  "bind_sc_reply a b \<lbrace>weak_valid_sched_action\<rbrace>"
-  unfolding bind_sc_reply_def by wpsimp
-
-lemma bind_sc_reply_invs[wp]:
-  "\<lbrace> \<lambda>s. invs s
-         \<and> reply_at reply_ptr s
-         \<and> sc_at sc_ptr s
-         \<and> ex_nonz_cap_to reply_ptr s
-         \<and> ex_nonz_cap_to sc_ptr s
-         \<and> reply_sc_reply_at (\<lambda>sc_ptr'. sc_ptr' = None) reply_ptr s
-         \<and> reply_ptr \<in> fst ` replies_blocked s
-         \<and> reply_ptr \<notin> fst ` replies_with_sc s \<rbrace>
-    bind_sc_reply sc_ptr reply_ptr
-   \<lbrace> \<lambda>rv. invs \<rbrace>"
-  unfolding bind_sc_reply_def
-  supply if_weak_cong[cong del] if_split[split del]
-  apply (rule bind_wp[OF _ gscrpls_sp])
-  apply (rename_tac sc_replies')
-  apply (case_tac sc_replies'; simp)
-   apply (wpsimp wp: sched_context_donate_invs)
-     apply (wpsimp simp: invs_def valid_state_def valid_pspace_def
-                     wp: valid_irq_node_typ set_reply_sc_valid_replies_already_BlockedOnReply
-                         valid_ioports_lift)
-    apply (wpsimp wp: set_sc_replies_valid_replies update_sched_context_valid_idle)
+lemma doReplyTransfer_corres:
+  "corres dc
+     (einvs and tcb_at receiver and tcb_at sender
+           and cte_wp_at ((=) (cap.ReplyCap receiver False rights)) slot)
+     (invs' and tcb_at' sender and tcb_at' receiver
+            and valid_pspace' and cte_at' (cte_map slot))
+     (do_reply_transfer sender receiver slot grant)
+     (doReplyTransfer sender receiver (cte_map slot) grant)"
+  apply (simp add: do_reply_transfer_def doReplyTransfer_def cong: option.case_cong)
+  apply (rule corres_underlying_split [OF _ _ gts_sp gts_sp'])
+   apply (rule corres_guard_imp)
+     apply (rule getThreadState_corres, (clarsimp simp add: st_tcb_at_tcb_at invs_distinct invs_psp_aligned)+)
+  apply (rule_tac F = "awaiting_reply state" in corres_req)
+   apply (clarsimp simp add: st_tcb_at_def obj_at_def is_tcb)
+   apply (fastforce simp: invs_def valid_state_def intro: has_reply_cap_cte_wpD
+                   dest: has_reply_cap_cte_wpD
+                  dest!: valid_reply_caps_awaiting_reply cte_wp_at_is_reply_cap_toI)
+  apply (case_tac state, simp_all add: bind_assoc)
+  apply (simp add: isReply_def liftM_def)
+  apply (rule corres_symb_exec_r[OF _ getCTE_sp getCTE_inv, rotated])
+   apply (rule no_fail_pre, wp)
    apply clarsimp
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
-                          reply_sc_reply_at_def obj_at_def state_refs_of_def get_refs_def2
-                          sc_replies_sc_at_def pred_tcb_at_def is_tcb is_reply is_sc_obj_def
-                  split: if_splits
-                  elim!: delta_sym_refs)
-   apply safe
-        apply fastforce
-       apply fastforce
-      apply (clarsimp simp: valid_idle_def)
-     apply (rule replies_with_sc_upd_replies_new_valid_replies)
-       apply fastforce
-      apply (clarsimp simp: image_def)
-      apply (rule_tac x="(reply_ptr, b)" in bexI; fastforce)
-     apply (clarsimp simp: image_def)
-    apply (fastforce simp: invs_def valid_state_def valid_pspace_def
-                           reply_sc_reply_at_def obj_at_def state_refs_of_def get_refs_def2
-                           sc_replies_sc_at_def pred_tcb_at_def is_tcb is_reply is_sc_obj_def
-                    split: if_splits
-                    elim!: delta_sym_refs)
-   apply (clarsimp simp: idle_sc_no_ex_cap)
-  apply wpsimp
-     apply (wpsimp simp: invs_def valid_state_def valid_pspace_def
-                     wp: valid_irq_node_typ set_reply_sc_valid_replies_already_BlockedOnReply
-                         valid_ioports_lift valid_sc_typ_list_all_reply)
-    apply (wpsimp wp: set_sc_replies_valid_replies update_sched_context_valid_idle)
-   apply (wpsimp simp: get_simple_ko_def get_object_def
-                   wp: valid_sc_typ_list_all_reply valid_ioports_lift)
-  apply (subgoal_tac "list_all (\<lambda>r. reply_at r s) (a # list) \<and> reply_ptr \<notin> set (a # list) \<and> distinct (a # list)")
-   apply (clarsimp simp: invs_def valid_pspace_def valid_state_def)
-   apply (intro conjI)
-     apply (rule replies_with_sc_upd_replies_valid_replies_add_one, simp)
-       apply (clarsimp simp:replies_blocked_def image_def, fastforce)
-      apply simp
-     apply (clarsimp simp:sc_replies_sc_at_def obj_at_def)
-    apply (erule delta_sym_refs)
-     apply (clarsimp split: if_splits
-                     elim!: delta_sym_refs)
-    apply (clarsimp simp: reply_sc_reply_at_def obj_at_def state_refs_of_def get_refs_def2
-                          pred_tcb_at_def is_tcb is_reply is_sc_obj sc_at_pred_n_def
-                   split: if_splits
-                   elim!: delta_sym_refs)
-    apply (safe; clarsimp?)
-    apply (rename_tac rp1 tl s tptr scp sc r1 r2 n1)
-    apply (subgoal_tac "(rp1,scp) \<in> replies_with_sc s \<and> (rp1,sc_ptr) \<in> replies_with_sc s")
-     apply (clarsimp dest!: valid_replies_2_inj_onD )
-    apply (intro conjI)
-     apply (subgoal_tac "valid_reply r1 s")
-      apply (clarsimp simp: valid_reply_def refs_of_def obj_at_def is_sc_obj_def
-                     split: option.splits)
-      apply (rename_tac ko n2)
-      apply (case_tac ko; clarsimp simp: get_refs_def)
-      apply (erule disjE, clarsimp split: option.splits)+
-      apply (clarsimp simp: replies_with_sc_def sc_replies_sc_at_def obj_at_def split: option.splits)
-     apply (erule valid_objs_valid_reply, assumption)
-    apply(clarsimp simp: replies_with_sc_def sc_replies_sc_at_def obj_at_def)
-    apply (metis cons_set_intro)
-   apply (fastforce simp: idle_sc_no_ex_cap tcb_at_def is_tcb_def
-                    dest: pred_tcb_at_tcb_at get_tcb_SomeD)
-  apply (clarsimp simp del: distinct.simps list.pred_inject insert_iff)
-  apply (frule sc_replies_sc_at_subset_fst_replies_with_sc)
-  apply (frule invs_valid_objs)
-  apply (intro conjI)
-    apply (erule replies_blocked_list_all_reply_at)
-    apply (meson dual_order.trans invs_valid_replies valid_replies_defs(1))
-   apply fastforce
-  apply (erule (1) valid_objs_sc_replies_distinct)
-  done
-
-lemma replyPush_corres:
-  "can_donate = can_donate' \<Longrightarrow>
-   corres dc (valid_replies and pspace_aligned and pspace_distinct and valid_objs
-              and K (caller \<noteq> idle_thread_ptr) and tcb_at callee and active_scs_valid
-              and st_tcb_at (\<lambda>st. reply_object st = None) caller and ex_nonz_cap_to reply_ptr
-              and reply_sc_reply_at (\<lambda>tptr. tptr = None) reply_ptr
-              and reply_tcb_reply_at (\<lambda>tptr. tptr = None) reply_ptr
-              and weak_valid_sched_action and scheduler_act_not caller
-              and (\<lambda>s. reply_ptr \<notin> fst ` replies_with_sc s)
-              and (\<lambda>s. sym_refs (\<lambda>p. if p = caller
-                                     then tcb_non_st_state_refs_of s caller
-                                     else state_refs_of s p))
-              and valid_idle)
-   (valid_release_queue_iff and valid_objs' and valid_queues and valid_queues'
-    and valid_replies'_sc_asrt reply_ptr)
-   (reply_push caller callee reply_ptr can_donate)
-   (replyPush caller callee reply_ptr can_donate')"
-  apply add_valid_idle'
-  unfolding reply_push_def replyPush_def
-  apply clarsimp
-  apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-   apply (rule corres_stateAssert_implied[where P'=\<top>, simplified, rotated])
-    apply (clarsimp simp: valid_idle'_asrt_def)
-   apply (rule stronger_corres_guard_imp)
-     apply (simp add: get_tcb_obj_ref_def)
-     apply (rule corres_split_eqr[OF threadGet_corres])
-        apply (clarsimp simp: tcb_relation_def)
-       apply (rule corres_split_eqr[OF threadGet_corres])
-          apply (clarsimp simp: tcb_relation_def)
-         apply (rule corres_split [OF replyTCB_update_corres])
-           apply (rule corres_split [OF setThreadState_corres])
+  apply (rename_tac mdbnode)
+  apply (rule_tac P="Q" and Q="Q" and P'="Q'" and Q'="(\<lambda>s. Q' s \<and> R' s)" for Q Q' R'
+            in stronger_corres_guard_imp[rotated])
+    apply assumption
+   apply (rule conjI, assumption)
+   apply (clarsimp simp: cte_wp_at_ctes_of)
+   apply (drule cte_wp_at_is_reply_cap_toI)
+   apply (erule(4) reply_cap_end_mdb_chain)
+  apply (rule corres_assert_assume[rotated], simp)
+  apply (simp add: getSlotCap_def)
+  apply (rule corres_symb_exec_r[OF _ getCTE_sp getCTE_inv, rotated])
+   apply (rule no_fail_pre, wp)
+   apply (clarsimp simp: cte_wp_at_ctes_of)
+  apply (rule corres_assert_assume[rotated])
+   apply (clarsimp simp: cte_wp_at_ctes_of)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF threadget_fault_corres])
+      apply (case_tac rv, simp_all add: fault_rel_optionation_def bind_assoc)[1]
+       apply (rule corres_split[OF doIPCTransfer_corres])
+         apply (rule corres_split[OF cap_delete_one_corres])
+           apply (rule corres_split[OF setThreadState_corres])
               apply simp
-             apply (rule corres_when2, clarsimp)
-             apply (rule corres_split [OF bindScReply_corres schedContextDonate_corres])
-              apply (wpsimp wp: sc_at_typ_at)
-             apply wpsimp
-            apply simp
-            apply (wpsimp wp: sts_valid_replies hoare_vcg_imp_lift'
-                              hoare_vcg_all_lift sts_in_replies_blocked
-                              set_thread_state_weak_valid_sched_action)
-           apply (wpsimp wp: hoare_vcg_imp_lift' sts_invs_minor')
-          apply clarsimp
-          apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-         apply (clarsimp simp: valid_tcb_state'_def cong: conj_cong)
-         apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift updateReply_valid_objs')
-        apply (wpsimp wp: thread_get_wp)
-       apply (wpsimp wp: threadGet_wp)
-      apply (wpsimp wp: thread_get_wp')
-     apply (wpsimp wp: threadGet_wp)
-    apply clarsimp
-    apply (frule reply_tcb_reply_at)
-    apply (subgoal_tac "caller \<noteq> reply_ptr")
-     apply (subgoal_tac "caller \<noteq> idle_thread_ptr")
-      apply (clarsimp simp: st_tcb_at_tcb_at cong: conj_cong)
-      apply (erule obj_at_weakenE)
-      apply (frule valid_objs_valid_tcbs, clarsimp)
-      apply (clarsimp simp: is_tcb)
-      apply (frule (1) valid_objs_ko_at[where ptr=caller])
-      apply (clarsimp simp: valid_obj_def valid_tcb_def)
-      apply (subst sc_at_ppred_exm; clarsimp)
-      apply (clarsimp simp: replies_with_sc_def image_def obj_at_def is_sc_obj)
-      apply (rule conjI)
-       apply (erule replies_blocked_upd_tcb_st_valid_replies_not_blocked;
-              fastforce intro!: not_BlockedOnReply_not_in_replies_blocked
-                         elim!: st_tcb_weakenE)
-      subgoal for s s' tcb
-        by (erule delta_sym_refs; clarsimp split: if_splits
-            ; fastforce dest: reply_tcb_reply_at_ReplyTCB_in_state_refs_of
-                              st_tcb_at_TCBReply_in_state_refs_of)
-     apply (clarsimp simp: valid_obj_def valid_tcb_def)
-    apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def)
-    apply (clarsimp simp: obj_at_def is_tcb is_reply)
+             apply (rule possibleSwitchTo_corres)
+            apply (wp set_thread_state_runnable_valid_sched
+                      set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' sts_st_tcb'
+                      sts_valid_objs' delete_one_tcbDomain_obj_at'
+                   | simp add: valid_tcb_state'_def
+                   | strengthen valid_queues_in_correct_ready_q valid_sched_valid_queues
+                                valid_queues_ready_qs_distinct)+
+        apply (strengthen cte_wp_at_reply_cap_can_fast_finalise)
+        apply (wp hoare_vcg_conj_lift)
+         apply (rule hoare_strengthen_post [OF do_ipc_transfer_non_null_cte_wp_at])
+          prefer 2
+          apply (erule cte_wp_at_weakenE)
+          apply (fastforce)
+         apply (clarsimp simp:is_cap_simps)
+        apply (wp weak_valid_sched_action_lift)+
+       apply (rule_tac Q'="\<lambda>_ s. valid_objs' s \<and> cur_tcb' s \<and> tcb_at' receiver s
+                                \<and> sch_act_wf (ksSchedulerAction s) s
+                                \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s
+                                \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                    in hoare_post_imp, simp add: sch_act_wf_weak)
+       apply (wp tcb_in_cur_domain'_lift)
+      defer
+      apply (simp)
+      apply (wp)+
+    apply (clarsimp simp: invs_psp_aligned invs_distinct)
+    apply (rule conjI, erule invs_valid_objs)
+    apply (rule conjI, clarsimp)+
+    apply (rule conjI)
+     apply (erule cte_wp_at_weakenE)
+     apply (clarsimp)
+     apply (rule conjI, rule refl)
+     apply (fastforce)
+    apply (clarsimp simp: invs_def valid_sched_def valid_sched_action_def)
+   apply (simp)
+   apply (auto simp: invs'_def valid_state'_def)[1]
+
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF cap_delete_one_corres])
+      apply (rule corres_split_mapr[OF getMessageInfo_corres])
+        apply (rule corres_split_eqr[OF lookupIPCBuffer_corres'])
+          apply (rule corres_split_eqr[OF getMRs_corres])
+            apply (simp(no_asm) del: dc_simp)
+            apply (rule corres_split_eqr[OF handleFaultReply_corres])
+               apply simp
+              apply (rule corres_split)
+                 apply (rule threadset_corresT;
+                        clarsimp simp add: tcb_relation_def fault_rel_optionation_def
+                                           tcb_cap_cases_def tcb_cte_cases_def exst_same_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)
+                                      and valid_objs'
+                                      and sym_heap_sched_pointers and valid_sched_pointers
+                                      and pspace_aligned' and pspace_distinct'"
+                              in corres_guard_imp)
+                apply (case_tac rvb, simp_all)[1]
+                 apply (rule corres_guard_imp)
+                   apply (rule corres_split[OF setThreadState_corres])
+                      apply simp
+                     apply (fold dc_def, rule possibleSwitchTo_corres)
+                    apply simp
+                    apply (wp hoare_weak_lift_imp hoare_weak_lift_imp_conj set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
+                              sts_st_tcb' sts_valid_objs'
+                           | force simp: valid_sched_def valid_sched_action_def valid_tcb_state'_def)+
+                apply (rule corres_guard_imp)
+                  apply (rule setThreadState_corres)
+                  apply clarsimp+
+               apply (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
+                         thread_set_not_state_valid_sched
+                         threadSet_tcbDomain_triv threadSet_valid_objs'
+                         threadSet_sched_pointers threadSet_valid_sched_pointers
+                    | simp add: valid_tcb_state'_def)+
+     apply (rule_tac Q'="\<lambda>_. valid_sched and cur_tcb and tcb_at sender and tcb_at receiver and
+                            valid_objs and pspace_aligned and pspace_distinct"
+                     in hoare_strengthen_post [rotated], clarsimp)
+     apply (wp)
+     apply (rule hoare_chain [OF cap_delete_one_invs])
+      apply (assumption)
+     apply (rule conjI, clarsimp)
+     apply (clarsimp simp add: invs_def valid_state_def valid_pspace_def)
+    apply (rule_tac Q'="\<lambda>_. tcb_at' sender and tcb_at' receiver and invs'"
+                    in hoare_strengthen_post [rotated])
+     apply (solves\<open>auto simp: invs'_def valid_state'_def\<close>)
+    apply wp
    apply clarsimp
-   apply (frule reply_tcb_reply_at)
-   apply (frule valid_objs'_valid_tcbs')
-   apply (frule cross_relF[OF _ tcb_at'_cross_rel[where t=caller]], fastforce, clarsimp)
-   apply (frule cross_relF[OF _ tcb_at'_cross_rel[where t=callee]], fastforce, clarsimp)
-   apply (frule cross_relF[OF _ reply_at'_cross_rel[where t=reply_ptr]], fastforce, clarsimp)
-   apply (prop_tac "obj_at' (\<lambda>t. valid_bound_sc' (tcbSchedContext t) s') caller s'")
-    apply (erule valid_tcbs'_obj_at'[rotated])
-     apply (clarsimp simp: valid_tcb'_def)
-    apply clarsimp
-   apply (clarsimp simp: valid_reply'_def obj_at'_def)
-  apply (clarsimp simp: sym_refs_asrt_def)
+   apply (rule conjI)
+    apply (erule cte_wp_at_weakenE)
+    apply (clarsimp simp add: can_fast_finalise_def)
+   apply (erule(1) emptyable_cte_wp_atD)
+   apply (rule allI, rule impI)
+   apply (clarsimp simp add: is_master_reply_cap_def)
+  apply (clarsimp)
   done
 
-crunch handle_fault_reply
-  for pspace_aligned[wp]: pspace_aligned
-  and pspace_distinct[wp]: pspace_distinct
-
-lemma setReleaseQueue_corres:
-   "corres dc \<top> (\<lambda>s. g (ksReleaseQueue s) = qs)
-      (modify (release_queue_update g))
-      (setReleaseQueue qs)"
-  unfolding setReleaseQueue_def
-  apply (rule corres_modify)
-  by (auto simp: state_relation_def release_queue_relation_def cdt_relation_def)
-
-lemma threadSet_valid_release_queue_inv:
-  "\<forall>obj. tcbInReleaseQueue (f obj) = tcbInReleaseQueue obj \<Longrightarrow>
-   threadSet f t \<lbrace>valid_release_queue\<rbrace>"
-  by (wpsimp wp: threadSet_valid_release_queue)
-
-lemma threadSet_valid_release_queue'_inv:
-  "\<forall>obj. tcbInReleaseQueue (f obj) = tcbInReleaseQueue obj \<Longrightarrow>
-   threadSet f t \<lbrace>valid_release_queue'\<rbrace>"
-  apply (wpsimp wp: threadSet_valid_release_queue')
-  by (auto simp: valid_release_queue'_def obj_at'_def)
-
-crunch handleFaultReply, doIPCTransfer
-  for valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  (wp: crunch_wps threadSet_valid_release_queue_inv threadSet_valid_release_queue'_inv
-   ignore: threadSet
-   simp: crunch_simps)
-
-lemma refillReady_sp:
-  "\<lbrace>P\<rbrace>
-   refillReady scp
-   \<lbrace>\<lambda>rv s. P s \<and> (\<exists>ko. ko_at' ko scp s \<and> rv = (rTime (refillHd ko) \<le> ksCurTime s + kernelWCETTicks))\<rbrace>"
-  apply (wpsimp wp: refillReady_wp)
-  by fastforce
-
-lemma refillSufficient_sp:
-  "\<lbrace>P\<rbrace>
-  refillSufficient scp k
-  \<lbrace>\<lambda>rv s. P s \<and> (\<exists>ko. ko_at' ko scp s \<and> rv = (sufficientRefills k (scRefills ko) (scRefillHead ko)))\<rbrace>"
-  unfolding refillSufficient_def getRefills_def
-  apply wpsimp
-  by (clarsimp simp: sufficientRefills_def obj_at'_def)
-
-lemma isValidTimeoutHandler_sp:
-  "\<lbrace>P\<rbrace>
-   isValidTimeoutHandler x
-   \<lbrace>\<lambda>rv s. P s \<and> (\<exists>ko. ko_at' ko x s \<and> rv = (is_EndpointCap (cteCap (tcbTimeoutHandler ko))))\<rbrace>"
-  unfolding isValidTimeoutHandler_def
-  apply (wpsimp wp: getTCB_wp)
-  by (auto simp: is_EndpointCap_def)
+(* when we cannot talk about reply cap rights explicitly (for instance, when a schematic ?rights
+   would be generated too early *)
+lemma doReplyTransfer_corres':
+  "corres dc
+     (einvs and tcb_at receiver and tcb_at sender
+           and cte_wp_at (is_reply_cap_to receiver) slot)
+     (invs' and tcb_at' sender and tcb_at' receiver
+            and valid_pspace' and cte_at' (cte_map slot))
+     (do_reply_transfer sender receiver slot grant)
+     (doReplyTransfer sender receiver (cte_map slot) grant)"
+  using doReplyTransfer_corres[of receiver sender _ slot]
+  by (fastforce simp add: cte_wp_at_reply_cap_to_ex_rights corres_underlying_def)
+
+lemma valid_pspace'_splits[elim!]:
+  "valid_pspace' s \<Longrightarrow> valid_objs' s"
+  "valid_pspace' s \<Longrightarrow> pspace_aligned' s"
+  "valid_pspace' s \<Longrightarrow> pspace_distinct' s"
+  "valid_pspace' s \<Longrightarrow> valid_mdb' s"
+  "valid_pspace' s \<Longrightarrow> no_0_obj' s"
+  by (simp add: valid_pspace'_def)+
+
+lemma sts_valid_pspace_hangers:
+  "\<lbrace>valid_pspace' and tcb_at' t and
+   valid_tcb_state' st\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<lbrace>valid_pspace' and tcb_at' t and
+   valid_tcb_state' st\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
+  "\<lbrace>valid_pspace' and tcb_at' t and
+   valid_tcb_state' st\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
+  "\<lbrace>valid_pspace' and tcb_at' t and
+   valid_tcb_state' st\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
+  "\<lbrace>valid_pspace' and tcb_at' t and
+   valid_tcb_state' st\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. no_0_obj'\<rbrace>"
+  by (safe intro!: hoare_strengthen_post [OF sts'_valid_pspace'_inv])
 
 declare no_fail_getSlotCap [wp]
 
+lemma setupCallerCap_corres:
+  "corres dc
+     (st_tcb_at (Not \<circ> halted) sender and tcb_at receiver and
+      st_tcb_at (Not \<circ> awaiting_reply) sender and valid_reply_caps and
+      valid_objs and pspace_distinct and pspace_aligned and valid_mdb
+      and valid_list and
+      valid_reply_masters and cte_wp_at (\<lambda>c. c = cap.NullCap) (receiver, tcb_cnode_index 3))
+     (tcb_at' sender and tcb_at' receiver and valid_pspace'
+                and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s))
+     (setup_caller_cap sender receiver grant)
+     (setupCallerCap sender receiver grant)"
+  supply if_split[split del]
+  apply (simp add: setup_caller_cap_def setupCallerCap_def
+                   getThreadReplySlot_def locateSlot_conv
+                   getThreadCallerSlot_def)
+  apply (rule stronger_corres_guard_imp)
+    apply (rule corres_split_nor)
+       apply (rule setThreadState_corres)
+       apply (simp split: option.split)
+      apply (rule corres_symb_exec_r)
+         apply (rule_tac F="\<exists>r. cteCap masterCTE = capability.ReplyCap sender True r
+                             \<and> mdbNext (cteMDBNode masterCTE) = nullPointer"
+                      in corres_gen_asm2, clarsimp simp add: isCap_simps)
+         apply (rule corres_symb_exec_r)
+            apply (rule_tac F="rv = capability.NullCap"
+                         in corres_gen_asm2, simp)
+            apply (rule cteInsert_corres)
+              apply (simp split: if_splits)
+             apply (simp add: cte_map_def tcbReplySlot_def
+                              tcb_cnode_index_def cte_level_bits_def)
+            apply (simp add: cte_map_def tcbCallerSlot_def
+                             tcb_cnode_index_def cte_level_bits_def)
+           apply (rule_tac Q'="\<lambda>rv. cte_at' (receiver + 2 ^ cte_level_bits * tcbCallerSlot)"
+                    in hoare_post_add)
+
+           apply (wp, (wp getSlotCap_wp)+)
+          apply blast
+         apply (rule no_fail_pre, wp)
+         apply (clarsimp simp: cte_wp_at'_def cte_at'_def)
+        apply (rule_tac Q'="\<lambda>rv. cte_at' (sender + 2 ^ cte_level_bits * tcbReplySlot)"
+                     in hoare_post_add)
+        apply (wp, (wp getCTE_wp')+)
+       apply blast
+      apply (rule no_fail_pre, wp)
+      apply (clarsimp simp: cte_wp_at_ctes_of)
+     apply (wp sts_valid_pspace_hangers
+                 | simp add: cte_wp_at_ctes_of)+
+   apply (clarsimp simp: valid_tcb_state_def st_tcb_at_reply_cap_valid
+                         st_tcb_at_tcb_at st_tcb_at_caller_cap_null
+                  split: option.split)
+  apply (clarsimp simp: valid_tcb_state'_def valid_cap'_def capAligned_reply_tcbI)
+  apply (frule(1) st_tcb_at_reply_cap_valid, simp, clarsimp)
+  apply (clarsimp simp: cte_wp_at_ctes_of cte_wp_at_caps_of_state)
+  apply (drule pspace_relation_cte_wp_at[rotated, OF caps_of_state_cteD],
+         erule valid_pspace'_splits, clarsimp+)+
+  apply (clarsimp simp: cte_wp_at_ctes_of cte_map_def tcbReplySlot_def
+                        tcbCallerSlot_def tcb_cnode_index_def
+                        is_cap_simps)
+  apply (auto intro: reply_no_descendants_mdbNext_null[OF not_waiting_reply_slot_no_descendants]
+               simp: cte_index_repair)
+  done
+
+crunch getThreadCallerSlot
+  for tcb_at'[wp]: "tcb_at' t"
+
+lemma getThreadReplySlot_tcb_at'[wp]:
+  "\<lbrace>tcb_at' t\<rbrace> getThreadReplySlot tcb \<lbrace>\<lambda>_. tcb_at' t\<rbrace>"
+  by (simp add: getThreadReplySlot_def, wp)
+
+lemma setupCallerCap_tcb_at'[wp]:
+  "\<lbrace>tcb_at' t\<rbrace> setupCallerCap sender receiver grant \<lbrace>\<lambda>_. tcb_at' t\<rbrace>"
+  by (simp add: setupCallerCap_def, wp hoare_drop_imp)
+
+crunch setupCallerCap
+  for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
+  (wp: crunch_wps)
+
 lemma cteInsert_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
      cteInsert newCap srcSlot destSlot
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
 by (wp sch_act_wf_lift tcb_in_cur_domain'_lift)
 
+lemma setupCallerCap_sch_act [wp]:
+  "\<lbrace>\<lambda>s. sch_act_not t s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
+  setupCallerCap t r g \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: setupCallerCap_def getSlotCap_def getThreadCallerSlot_def
+            getThreadReplySlot_def locateSlot_conv)
+  apply (wp getCTE_wp' sts_sch_act' hoare_drop_imps hoare_vcg_all_lift)
+  apply clarsimp
+  done
+
+lemma possibleSwitchTo_weak_sch_act_wf[wp]:
+  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<and> st_tcb_at' runnable' t s\<rbrace>
+      possibleSwitchTo t \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: possibleSwitchTo_def setSchedulerAction_def threadGet_def curDomain_def
+                   bitmap_fun_defs)
+  apply (wp rescheduleRequired_weak_sch_act_wf
+            weak_sch_act_wf_lift_linear[where f="tcbSchedEnqueue t"]
+            getObject_tcb_wp hoare_weak_lift_imp
+           | wpc)+
+  apply (clarsimp simp: obj_at'_def projectKOs weak_sch_act_wf_def ps_clear_def tcb_in_cur_domain'_def)
+  done
+
+lemmas transferCapsToSlots_pred_tcb_at' =
+    transferCapsToSlots_pres1 [OF cteInsert_pred_tcb_at']
+
 crunch doIPCTransfer, possibleSwitchTo
   for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
   (wp: mapM_wp' crunch_wps simp: zipWithM_x_mapM)
@@ -2216,7 +2366,7 @@ lemma setSchedulerAction_ct_in_domain:
   \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
   by (simp add:setSchedulerAction_def | wp)+
 
-crunch doIPCTransfer, possibleSwitchTo
+crunch setupCallerCap, doIPCTransfer, possibleSwitchTo
   for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
   and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
   and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
@@ -2226,1190 +2376,235 @@ crunch doIPCTransfer
   for tcbDomain_obj_at'[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
   (wp: crunch_wps constOnFailure_wp simp: crunch_simps)
 
-lemma tcbEPFindIndex_corres:
-  "corres (=) (tcb_at t and (\<lambda>s. \<forall>t \<in> set list. tcb_at t s) and K (n < length list))
-              (tcb_at' t and (\<lambda>s. \<forall>t \<in> set list. tcb_at' t s))
-              (tcb_ep_find_index t list n) (tcbEPFindIndex t list n)"
-  apply (rule corres_gen_asm')
-  apply (induct n)
-   apply (subst tcb_ep_find_index.simps)
-   apply (subst tcbEPFindIndex.simps)
-   apply (rule corres_split_eqr)
-      apply (rule threadGet_corres, simp add: tcb_relation_def)
-     apply (rule corres_split_eqr)
-        apply (rule threadGet_corres, simp add: tcb_relation_def)
-       apply (rule corres_if, simp)
-        apply (rule corres_trivial, simp)
-       apply (rule corres_trivial, simp)
-      apply wpsimp
-     apply wpsimp
-    apply wpsimp
-   apply wpsimp
-  apply (subst tcb_ep_find_index.simps)
-  apply (subst tcbEPFindIndex.simps)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_eqr)
-       apply (rule threadGet_corres, simp add: tcb_relation_def)
-      apply (rule corres_split_eqr)
-         apply (rule threadGet_corres, simp add: tcb_relation_def)
-        apply (rule corres_if, simp)
-         apply (rule corres_if, simp)
-          apply (rule corres_trivial, simp)
-         apply simp
-        apply (rule corres_trivial, simp)
-       apply (wp thread_get_wp)
-      apply (wp threadGet_wp)
-     apply (wp thread_get_wp)
-    apply (wpsimp wp: threadGet_wp)
-   apply (fastforce simp: projectKO_eq projectKO_tcb obj_at'_def)+
-  done
-
-(* The condition `reply_ptr \<notin> fst ` replies_with_sc s` is provable in the presence of
-   sym_refs, but sym_refs may not hold at a call of reply_push. If we had sym_refs
-   for replies <-> scs only, then that would be enough and should be true at any call of
-   reply_push. *)
-lemma reply_push_valid_objs:
-  "\<lbrace>valid_objs and valid_replies and
-    reply_tcb_reply_at (\<lambda>tptr. tptr = None) reply_ptr and
-    (\<lambda>s. reply_ptr \<notin> fst ` replies_with_sc s)\<rbrace>
-   reply_push caller callee reply_ptr can_donate
-   \<lbrace>\<lambda>_. valid_objs\<rbrace>"
-  supply if_split [split del]
-  unfolding reply_push_def get_tcb_obj_ref_def
-  apply simp
-  apply (rule bind_wp[OF _ thread_get_sp])
-  apply (rule bind_wp[OF _ thread_get_sp])
-  apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift' hoare_vcg_disj_lift
-                    get_tcb_obj_ref_wp)
-  apply (subgoal_tac "tcb_at caller s \<and> reply_at reply_ptr s", clarsimp)
-   apply (subgoal_tac "sc_at y s", clarsimp)
-    apply (subst sc_at_ppred_exm)
-     apply (clarsimp simp: obj_at_def valid_obj_def valid_tcb_def)
-    apply (clarsimp simp: replies_with_sc_def image_def obj_at_def is_sc_obj)
-   apply (frule obj_at_ko_at[where p = caller], clarsimp)
-   apply (drule (1) valid_objs_ko_at)
-   apply (clarsimp simp: obj_at_def valid_obj_def valid_tcb_def)
-  apply (clarsimp simp: obj_at_def is_tcb sk_obj_at_pred_def is_reply)
-  done
-
-lemma tcbEPAppend_corres:
-  "corres (=) (\<lambda>s. tcb_at t s \<and> (\<forall>t \<in> set qs. tcb_at t s))
-              (\<lambda>s. tcb_at' t s \<and> (\<forall>t \<in> set qs. tcb_at' t s))
-              (tcb_ep_append t qs) (tcbEPAppend t qs)"
-  apply (clarsimp simp: tcb_ep_append_def tcbEPAppend_def null_def split del: if_split)
-  apply (rule corres_guard_imp)
-    apply (rule corres_if; clarsimp?)
-    apply (rule_tac corres_split[OF tcbEPFindIndex_corres])
-      apply wpsimp+
-  done
-
-lemma tcbEPFindIndex_inv[wp]:
-  "tcbEPFindIndex t list n \<lbrace>P\<rbrace>"
-  apply (rule hoare_weaken_pre)
-   apply (induct n)
-    apply (subst tcbEPFindIndex.simps, wpsimp)
-   apply (subst tcbEPFindIndex.simps, wpsimp, assumption)
-      apply wpsimp+
-  done
-
-crunch tcbEPAppend
-  for ep_at'[wp]: "ep_at' epptr"
-
-crunch bindScReply
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  (simp: crunch_simps)
-
-crunch replyPush
-  for pspace_aligned'[wp]: pspace_aligned'
-  and pspace_distinct'[wp]: pspace_distinct'
-  and pspace_bounded'[wp]: pspace_bounded'
-  and if_unsafe_then_cap'[wp]: "if_unsafe_then_cap'"
-  and valid_global_refs'[wp]: "valid_global_refs'"
-  and valid_arch_state'[wp]: "valid_arch_state'"
-  and valid_irq_node'[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
-  and valid_irq_handlers'[wp]: "valid_irq_handlers'"
-  and valid_irq_states'[wp]: "valid_irq_states'"
-  and valid_machine_state'[wp]: "valid_machine_state'"
-  and valid_release_queue'[wp]: "valid_release_queue'"
-  and ct_not_inQ[wp]: "ct_not_inQ"
-  and ct_idle_or_in_cur_domain'[wp]: "ct_idle_or_in_cur_domain'"
-  and valid_pde_mappings'[wp]: "valid_pde_mappings'"
-  and pspace_domain_valid[wp]: "pspace_domain_valid"
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and valid_dom_schedule'[wp]: "valid_dom_schedule'"
-  and cur_tcb'[wp]: "cur_tcb'"
-  and no_0_obj'[wp]: no_0_obj'
-  and valid_mdb'[wp]: valid_mdb'
-  and tcb_at'[wp]: "tcb_at' t"
-  and cte_wp_at'[wp]: "cte_wp_at' P p"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and vrq[wp]: valid_release_queue
-  and valid_queues'[wp]: valid_queues'
-  (wp: crunch_wps hoare_vcg_all_lift valid_irq_node_lift simp: crunch_simps valid_mdb'_def)
-
-crunch setQueue
-  for valid_tcb_state'[wp]: "valid_tcb_state' ts"
-
-lemma tcbSchedEnqueue_valid_tcb_state'[wp]:
-  "tcbSchedEnqueue t \<lbrace>valid_tcb_state' ts\<rbrace>"
-  by (wpsimp simp: tcbSchedEnqueue_def)
-
-lemma replyPush_valid_objs'[wp]:
-  "replyPush callerPtr calleePtr replyPtr canDonate \<lbrace>valid_objs'\<rbrace>"
-  supply if_split [split del]
-  unfolding replyPush_def updateReply_def bind_assoc
-  apply (wpsimp wp: schedContextDonate_valid_objs' updateReply_valid_objs'
-                    hoare_vcg_if_lift2 threadGet_wp hoare_vcg_imp_lift')
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (intro conjI impI; (fastforce simp: obj_at'_def projectKOs valid_tcb_state'_def)?)
-  by (insert reply_ko_at_valid_objs_valid_reply';
-      fastforce simp: valid_reply'_def obj_at'_def projectKOs valid_bound_obj'_def)+
-
-lemma replyPush_valid_replies'[wp]:
-  "\<lbrace>valid_replies' and pspace_distinct' and pspace_aligned' and pspace_bounded'
-    and st_tcb_at' (Not \<circ> is_replyState) callerPtr\<rbrace>
-   replyPush callerPtr calleePtr replyPtr canDonate
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  apply (solves wp | simp (no_asm_use) add: replyPush_def split del: if_split cong: conj_cong |
-         wp hoare_vcg_if_lift hoare_vcg_imp_lift' hoare_vcg_ex_lift
-            sts'_valid_replies'_except_Blocked updateReply_valid_replies'_except
-            sts_st_tcb' threadGet_wp)+
-  apply (auto simp: pred_tcb_at'_def obj_at'_def projectKOs)
-  done
-
-lemma replyPush_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_objs'\<rbrace>
-   replyPush callerPtr calleePtr replyPtr canDonate
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  supply if_split [split del]
-  unfolding replyPush_def updateReply_def bind_assoc
-  apply (intro bind_wp[OF _ stateAssert_sp] | simp)+
-  apply (rule bind_wp[OF _ threadGet_sp'])
-  apply (rule bind_wp[OF _ threadGet_sp'])
-  apply (rule bind_wp[OF _ get_reply_sp'])
-  apply (wpsimp wp: schedContextDonate_valid_queues
-                    threadGet_wp hoare_vcg_if_lift2 hoare_vcg_imp_lift')
-  apply (clarsimp simp: ko_at_obj_at'[where P=\<top>])
-  apply (clarsimp simp: valid_reply'_def dest!: reply_ko_at_valid_objs_valid_reply')
-  done
-
-crunch reply_unlink_tcb
-  for sc_replies_sc_at[wp]: "\<lambda>s. Q (sc_replies_sc_at P scp s)"
-  (wp: crunch_wps simp: crunch_simps ignore: refill_unblock_check)
-
-crunch if_cond_refill_unblock_check
-  for valid_sched_action[wp]: valid_sched_action
-  (wp: crunch_wps simp: crunch_simps)
-
-crunch doIPCTransfer
-  for reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  (wp: crunch_wps simp: crunch_simps)
+crunch possibleSwitchTo
+  for tcb_at'[wp]: "tcb_at' t"
+  and valid_pspace'[wp]: valid_pspace'
+  (wp: crunch_wps)
 
 lemma sendIPC_corres:
-(* call is only true if called in handleSyscall SysCall, which is always blocking. *)
+(* call is only true if called in handleSyscall SysCall, which
+   is always blocking. *)
   assumes "call \<longrightarrow> bl"
   shows
-  "corres dc (all_invs_but_fault_tcbs and fault_tcbs_valid_states_except_set {t} and valid_list
-              and active_scs_valid and current_time_bounded
-              and valid_sched_action and ep_at ep and ex_nonz_cap_to t and st_tcb_at active t
-              and scheduler_act_not t and (\<lambda>s. cd \<longrightarrow> bound_sc_tcb_at (\<lambda>a. \<exists>y. a = Some y) t s))
-             invs'
-             (send_ipc bl call bg cg cgr cd t ep) (sendIPC bl call bg cg cgr cd t ep)"
+  "corres dc (einvs and st_tcb_at active t and ep_at ep and ex_nonz_cap_to t)
+             (invs' and  sch_act_not t and tcb_at' t and ep_at' ep)
+             (send_ipc bl call bg cg cgr t ep) (sendIPC bl call bg cg cgr t ep)"
+proof -
+  show ?thesis
   apply (insert assms)
-  apply add_sym_refs
-  apply add_valid_idle'
-  apply add_cur_tcb'
-  apply (clarsimp simp: send_ipc_def sendIPC_def Let_def split del: if_split)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: sym_refs_asrt_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: valid_idle'_asrt_def)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split [OF getEndpoint_corres, where
-             R="\<lambda>rv. all_invs_but_fault_tcbs and valid_list and st_tcb_at active t
-                     and ep_at ep and valid_sched_action and active_scs_valid
-                     and valid_ep rv and obj_at (\<lambda>ob. ob = Endpoint rv) ep
-                     and ex_nonz_cap_to t and scheduler_act_not t and current_time_bounded
-                     and (\<lambda>s. cd \<longrightarrow> bound_sc_tcb_at (\<lambda>a. \<exists>y. a = Some y) t s)"
-             and
-             R'="\<lambda>rv'. invs' and cur_tcb' and tcb_at' t and sch_act_not t
-                             and ep_at' ep and valid_ep' rv'
-                             and ko_at' (rv' :: endpoint) ep
-                             and (\<lambda>s'. sym_refs (state_refs_of' s'))"])
-      apply (rename_tac ep' rv)
-      apply (case_tac ep')
-        apply (case_tac bl; simp add: ep_relation_def)
+  apply (unfold send_ipc_def sendIPC_def Let_def)
+  apply (case_tac bl)
+   apply clarsimp
+   apply (rule corres_guard_imp)
+     apply (rule corres_split[OF getEndpoint_corres,
+              where
+              R="\<lambda>rv. einvs and st_tcb_at active t and ep_at ep and
+                      valid_ep rv and obj_at (\<lambda>ob. ob = Endpoint rv) ep
+                      and ex_nonz_cap_to t"
+              and
+              R'="\<lambda>rv'. invs' and tcb_at' t and sch_act_not t
+                              and ep_at' ep and valid_ep' rv'"])
+       apply (case_tac rv)
+         apply (simp add: ep_relation_def)
+         apply (rule corres_guard_imp)
+           apply (rule corres_split[OF setThreadState_corres])
+              apply simp
+             apply (rule setEndpoint_corres)
+             apply (simp add: ep_relation_def)
+            apply wp+
+          apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def invs_distinct)
+         apply clarsimp
+         \<comment> \<open>concludes IdleEP if bl branch\<close>
+        apply (simp add: ep_relation_def)
         apply (rule corres_guard_imp)
-          apply (rule corres_split [OF setThreadState_corres setEndpoint_corres])
+          apply (rule corres_split[OF setThreadState_corres])
              apply simp
+            apply (rule setEndpoint_corres)
             apply (simp add: ep_relation_def)
            apply wp+
-         apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def
-                               invs_def valid_state_def valid_pspace_def)
-        apply (clarsimp simp: invs'_def valid_pspace'_def)
-        \<comment> \<open>concludes IdleEP\<close>
+         apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def invs_distinct)
+        apply clarsimp
+        \<comment> \<open>concludes SendEP if bl branch\<close>
        apply (simp add: ep_relation_def)
-       apply (case_tac bl; simp add: ep_relation_def)
+       apply (rename_tac list)
+       apply (rule_tac F="list \<noteq> []" in corres_req)
+        apply (simp add: valid_ep_def)
+       apply (case_tac list)
+        apply simp
+       apply (clarsimp split del: if_split)
        apply (rule corres_guard_imp)
-         apply (rule corres_split [OF setThreadState_corres], simp)
-           apply (rule corres_split [OF tcbEPAppend_corres])
-             apply (rule setEndpoint_corres)
-             apply (simp add: ep_relation_def)
-            apply (wpsimp wp: hoare_vcg_ball_lift)+
-        apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def invs_def valid_state_def valid_pspace_def valid_ep_def)
-       apply (clarsimp simp: invs'_def valid_pspace'_def valid_ep'_def)
-       \<comment> \<open>concludes SendEP\<close>
+         apply (rule corres_split[OF setEndpoint_corres])
+            apply (simp add: ep_relation_def split: list.split)
+           apply (simp add: isReceive_def split del:if_split)
+           apply (rule corres_split[OF getThreadState_corres])
+             apply (rule_tac
+                    F="\<exists>data. recv_state = Structures_A.BlockedOnReceive ep data"
+                    in corres_gen_asm)
+             apply (clarsimp simp: case_bool_If  case_option_If if3_fold
+                         simp del: dc_simp split del: if_split cong: if_cong)
+             apply (rule corres_split[OF doIPCTransfer_corres])
+               apply (rule corres_split[OF setThreadState_corres])
+                  apply simp
+                 apply (rule corres_split[OF possibleSwitchTo_corres])
+                   apply (fold when_def)[1]
+                   apply (rule_tac P="call" and P'="call"
+                            in corres_symmetric_bool_cases, blast)
+                    apply (simp add: when_def dc_def[symmetric] split del: if_split)
+                    apply (rule corres_if2, simp)
+                     apply (rule setupCallerCap_corres)
+                    apply (rule setThreadState_corres, simp)
+                   apply (rule corres_trivial)
+                   apply (simp add: when_def dc_def[symmetric] split del: if_split)
+                  apply (simp split del: if_split add: if_apply_def2)
+                  apply (wp hoare_drop_imps)[1]
+                 apply (simp split del: if_split add: if_apply_def2)
+                 apply (wp hoare_drop_imps)[1]
+                apply (wp | simp)+
+                apply (wp sts_cur_tcb set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at_cases)
+               apply (wp sts_weak_sch_act_wf sts_valid_objs'
+                         sts_cur_tcb' setThreadState_tcb' sts_st_tcb_at'_cases)[1]
+              apply (simp add: valid_tcb_state_def pred_conj_def)
+              apply (strengthen reply_cap_doesnt_exist_strg disjI2_strg
+                                valid_queues_in_correct_ready_q valid_queues_ready_qs_distinct
+                                valid_sched_valid_queues)+
+              apply ((wp hoare_drop_imps do_ipc_transfer_tcb_caps weak_valid_sched_action_lift
+                   | clarsimp simp: is_cap_simps)+)[1]
+             apply (simp add: pred_conj_def)
+             apply (strengthen sch_act_wf_weak)
+             apply (simp add: valid_tcb_state'_def)
+             apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift hoare_drop_imps)[1]
+            apply (wp gts_st_tcb_at)+
+          apply (simp add: pred_conj_def cong: conj_cong)
+          apply (wp hoare_TrueI)
+         apply (simp)
+         apply (wp weak_sch_act_wf_lift_linear set_ep_valid_objs' setEndpoint_valid_mdb')+
+        apply (clarsimp simp add: invs_def valid_state_def valid_pspace_def ep_redux_simps
+                        ep_redux_simps' st_tcb_at_tcb_at valid_ep_def
+                        cong: list.case_cong)
+        apply (drule(1) sym_refs_obj_atD[where P="\<lambda>ob. ob = e" for e])
+        apply (clarsimp simp: st_tcb_at_refs_of_rev st_tcb_at_reply_cap_valid
+                              st_tcb_def2 valid_sched_def valid_sched_action_def)
+        apply (force simp: st_tcb_def2 dest!: st_tcb_at_caller_cap_null[simplified,rotated])
+       subgoal by (auto simp: valid_ep'_def invs'_def valid_state'_def split: list.split)
+      apply wp+
+    apply (clarsimp simp: ep_at_def2)+
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF getEndpoint_corres,
+             where
+             R="\<lambda>rv. einvs and st_tcb_at active t and ep_at ep and
+                     valid_ep rv and obj_at (\<lambda>k. k = Endpoint rv) ep"
+             and
+             R'="\<lambda>rv'. invs' and tcb_at' t and sch_act_not t
+                             and ep_at' ep and valid_ep' rv'"])
+      apply (rename_tac rv rv')
+      apply (case_tac rv)
+        apply (simp add: ep_relation_def)
+        \<comment> \<open>concludes IdleEP branch if not bl and no ft\<close>
+       apply (simp add: ep_relation_def)
+       \<comment> \<open>concludes SendEP branch if not bl and no ft\<close>
       apply (simp add: ep_relation_def)
       apply (rename_tac list)
-      apply (rule_tac F="list \<noteq> []" in corres_req, simp add: valid_ep_def)
-      apply (case_tac list, simp)
+      apply (rule_tac F="list \<noteq> []" in corres_req)
+       apply (simp add: valid_ep_def)
+      apply (case_tac list)
+       apply simp
+      apply (rule_tac F="a \<noteq> t" in corres_req)
+       apply (clarsimp simp: invs_def valid_state_def
+                             valid_pspace_def)
+       apply (drule(1) sym_refs_obj_atD[where P="\<lambda>ob. ob = e" for e])
+       apply (clarsimp simp: st_tcb_at_def obj_at_def tcb_bound_refs_def2)
+       apply fastforce
       apply (clarsimp split del: if_split)
-       \<comment> \<open>start corres logic\<close>
-      apply (rename_tac t' tl)
       apply (rule corres_guard_imp)
-        apply (rule corres_split [OF setEndpoint_corres])
-           apply (clarsimp simp: ep_relation_def split: list.splits)
-          apply (simp add: isReceive_def split del:if_split)
-          apply (rule corres_split [OF getThreadState_corres])
-            apply (rule stronger_corres_guard_imp)
-              apply (rule_tac
-                     F="\<exists>reply_opt pl. recv_state = Structures_A.BlockedOnReceive ep reply_opt pl"
-                     in corres_gen_asm)
-              apply (clarsimp simp: case_bool_If case_option_If if3_fold
-                          simp del: dc_simp split del: if_split cong: if_cong)
-              apply (rule corres_split [OF doIPCTransfer_corres])
-                apply (rule corres_split[where r'=dc])
-                   apply (clarsimp simp: maybeM_def)
-                   apply (rule corres_option_split[OF refl corres_return_trivial])
-                   apply (rule replyUnlinkTcb_corres)
-                  apply (simp only: get_tcb_obj_ref_def)
-                  apply (rule corres_split [OF threadGet_corres[where r="(=)"]])
-                     apply (clarsimp simp: tcb_relation_def)
-                    apply (rule corres_split [OF threadGet_corres[where r=fault_rel_optionation]])
-                       apply (clarsimp simp: tcb_relation_def)
-                      apply (rule corres_split [OF corres_if[where r=dc], where r=dc])
-                           apply (clarsimp simp: fault_rel_optionation_def)
-                          apply (rule corres_if, clarsimp)
-                           apply (rule replyPush_corres, simp)
-                          apply (rule setThreadState_corres, simp)
-                         apply (rule corres_when, simp)
-                         apply (rule corres_split [OF threadGet_corres[where r="(=)"]])
-                            apply (clarsimp simp: tcb_relation_def)
-                           apply (simp, rule schedContextDonate_corres)
-                          prefer 3 \<comment> \<open>deferring Hoare triples\<close>
-                          apply (rule corres_split [OF setThreadState_corres])
-                             apply simp
-                            apply (rule corres_split_eqr[OF threadGet_corres])
-                               apply (clarsimp simp: tcb_relation_def)
-                              apply (rule corres_split [OF ifCondRefillUnblockCheck_corres])
-                                 apply (rule possibleSwitchTo_corres, simp)
-                            \<comment> \<open>starting Hoare triples\<close>
-                               apply wpsimp
-                              apply wpsimp
-                             apply (rule_tac Q'="\<lambda>r. valid_sched_action and active_scs_valid
-                                                    and bound_sc_tcb_at ((=) r) t'
-                                                    and pspace_aligned
-                                                    and pspace_distinct
-                                                    and valid_tcbs
-                                                    and active_scs_valid
-                                                    and current_time_bounded"
-                                    in hoare_strengthen_post[rotated])
-                             apply (clarsimp, rename_tac rv s)
-                             apply (case_tac rv; clarsimp simp: pred_tcb_at_def obj_at_def is_tcb option.case_eq_if)
-                              apply (drule sym[of "Some _"])
-                              apply (fastforce simp: valid_tcbs_def valid_tcb_def obj_at_def
-                                                     is_sc_obj opt_map_red opt_pred_def)
-
-                             apply (wpsimp wp: thread_get_wp')
-                            apply (wpsimp wp: threadGet_wp)
-                           apply (rule_tac Q'="\<lambda>_. valid_sched_action and active_scs_valid
-                                                  and tcb_at t'
-                                                  and pspace_aligned
-                                                  and pspace_distinct
-                                                  and valid_tcbs
-                                                  and active_scs_valid
-                                                  and current_time_bounded"
-                                  in hoare_strengthen_post[rotated])
-                            apply (clarsimp simp: pred_tcb_at_def obj_at_def)
-                           apply (wpsimp wp: set_thread_state_valid_sched_action)
-                          apply (rule_tac Q'="\<lambda>_. tcb_at' t' and valid_objs' and valid_release_queue_iff
-                                                 and valid_queues and valid_queues'"
-                                 in hoare_strengthen_post[rotated])
-                           apply (clarsimp simp: obj_at'_def valid_objs'_valid_tcbs' split: option.split)
-                          apply wpsimp
-                         apply (wpsimp wp: thread_get_wp')
-                        apply (wpsimp wp: threadGet_wp)
-                       apply (rule_tac Q'="\<lambda>_. valid_objs and pspace_aligned and pspace_distinct
-                                              and tcb_at t' and active_scs_valid
-                                              and valid_sched_action and current_time_bounded"
-                              in hoare_strengthen_post[rotated])
-                        apply clarsimp
-                       apply (wpsimp wp: set_thread_state_valid_sched_action sched_context_donate_valid_sched_action
-                                         thread_get_wp' reply_push_valid_objs)
-                      apply (rule_tac Q'="\<lambda>_. valid_objs' and valid_release_queue_iff and
-                                             valid_queues and valid_queues' and tcb_at' t'"
-                             in hoare_strengthen_post[rotated])
-                       apply clarsimp
-                      apply (wpsimp wp: threadGet_wp schedContextDonate_valid_objs')
-                     apply (wpsimp wp: thread_get_wp')
-                    apply (wpsimp wp: threadGet_wp)
-                   apply (wpsimp wp: thread_get_wp')
-                  apply (wpsimp wp: threadGet_wp)
-                 apply (rule_tac Q'="\<lambda>_. valid_objs and pspace_aligned and pspace_distinct and
-                          scheduler_act_not t and valid_sched_action and valid_replies and
-                          st_tcb_at active t and tcb_at t' and scheduler_act_not t' and active_scs_valid and
-                          (\<lambda>s. reply_opt \<noteq> None \<longrightarrow> reply_at (the reply_opt) s \<and>
-                               ex_nonz_cap_to (the reply_opt) s \<and>
-                               reply_tcb_reply_at (\<lambda>tptr. tptr = None) (the reply_opt) s \<and>
-                               reply_sc_reply_at (\<lambda>tptr. tptr = None) (the reply_opt) s \<and>
-                               the reply_opt \<notin> fst ` replies_with_sc s \<and>
-                               sym_refs (state_refs_of s)) and
-                          K (t \<noteq> idle_thread_ptr) and current_time_bounded and
-                          (\<lambda>s. cd \<longrightarrow> bound_sc_tcb_at (\<lambda>a. \<exists>y. a = Some y) t s) and valid_idle"
-                        in hoare_strengthen_post[rotated])
-                  apply (prop_tac "reply_opt \<noteq> None
-                                   \<longrightarrow> sym_refs
-                                         (\<lambda>p. if p = t
-                                              then tcb_non_st_state_refs_of s t
-                                              else state_refs_of s p)")
-                   subgoal
-                     apply clarsimp
-                     apply (erule delta_sym_refs)
-                     by (auto simp: state_refs_of_def get_refs_def2
-                                    pred_tcb_at_def obj_at_def
-                             split: if_split_asm option.splits)
-                  apply (prop_tac "st_tcb_at (\<lambda>st. reply_object st = None) t s")
-                   apply (fastforce elim!: pred_tcb_weakenE)
-                  apply (clarsimp simp: st_tcb_at_tcb_at cong: conj_cong)
-                  apply (frule valid_sched_action_weak_valid_sched_action, simp)
-                  apply (frule valid_objs_valid_tcbs, simp)
-                  apply (subgoal_tac "(cd \<longrightarrow> bound_sc_tcb_at (\<lambda>a. sc_at (the a) s) t s)")
-                   apply (clarsimp simp: obj_at_def is_tcb pred_tcb_at_def)
-                  apply (drule pred_tcb_at_ko_atD, clarsimp)
-                  apply (frule (1) valid_objs_ko_at)
-                  apply (clarsimp simp: pred_tcb_at_def obj_at_def valid_obj_def valid_tcb_def)
-                 apply (wpsimp wp: reply_unlink_tcb_valid_sched_action
-                                   reply_unlink_tcb_valid_replies_BlockedOnReceive
-                                   reply_unlink_tcb_sym_refs_BlockedOnReceive
-                                   reply_unlink_tcb_reply_tcb_reply_at[where P=id, simplified]
-                                   reply_unlink_tcb_st_tcb_at'
-                                   replies_with_sc_lift)
-                apply (rule_tac Q'="\<lambda>_. tcb_at' t and tcb_at' t' and valid_release_queue and
-                                       valid_release_queue' and
-                                       valid_queues and valid_objs' and
-                                       valid_queues' and
-                                       (\<lambda>s. reply_opt \<noteq> None \<longrightarrow>
-                                            reply_at' (the reply_opt) s \<and>
-                                            replySCs_of s (the reply_opt) = None) and cur_tcb'"
-                       in hoare_strengthen_post[rotated])
-                 apply (clarsimp cong: conj_cong)
-                 apply (frule valid_objs'_valid_tcbs')
-                 apply (drule obj_at_ko_at')+
-                 apply (blast dest: no_replySC_valid_replies'_sc_asrt)
-                apply wpsimp
-               apply (wpfix add: reply_object.simps(1))
-               apply (rule_tac Q'="\<lambda>_. valid_objs and pspace_aligned and pspace_distinct and
-                        valid_replies and active_scs_valid and
-                        scheduler_act_not t and valid_sched_action
-                        and st_tcb_at active t and tcb_at t' and
-                        if_live_then_nonz_cap and scheduler_act_not t' and
-                        K (t \<noteq> idle_thread_ptr) and current_time_bounded and
-                        (\<lambda>s. cd \<longrightarrow> bound_sc_tcb_at (\<lambda>a. \<exists>y. a = Some y) t s) and
-                        (\<lambda>s. reply_opt \<noteq> None
-                          \<longrightarrow> st_tcb_at ((=) (Structures_A.thread_state.BlockedOnReceive ep reply_opt pl)) t' s
-                              \<and> ex_nonz_cap_to (the reply_opt) s
-                              \<and> reply_tcb_reply_at ((=) (Some t')) (the reply_opt) s
-                              \<and> reply_sc_reply_at (\<lambda>a. a = None) (the reply_opt) s
-                              \<and> the reply_opt \<notin> fst ` replies_with_sc s) and
-                        (\<lambda>s. sym_refs
-                               (\<lambda>x. if x = t'
-                                    then {r \<in> state_refs_of s x.
-                                            snd r = TCBBound \<or> snd r = TCBSchedContext \<or>
-                                            snd r = TCBYieldTo \<or> snd r = TCBReply}
-                                    else state_refs_of s x)) and valid_idle"
-                      in hoare_strengthen_post[rotated])
-                apply (clarsimp split: option.splits cong: conj_cong)
-                apply (intro conjI)
-                    apply (erule valid_objs_valid_tcbs)
-                   apply (clarsimp simp: pred_tcb_at_def obj_at_def is_tcb, fastforce)
-                  apply fastforce
-                 apply (fastforce simp: reply_tcb_reply_at_def obj_at_def st_tcb_at_def)
-                apply (clarsimp simp: sk_obj_at_pred_def obj_at_def is_reply)
-               apply (wpsimp wp: hoare_vcg_imp_lift hoare_vcg_all_lift simp: iff_conv_conj_imp)
-              apply (wpfix add: Structures_H.thread_state.sel)
-              apply (rule_tac Q'="\<lambda>_. tcb_at' t and tcb_at' t' and valid_release_queue and
-                                     valid_release_queue' and valid_queues and valid_objs' and
-                                     valid_queues' and (\<lambda>s. reply_opt \<noteq> None \<longrightarrow> reply_at' (the reply_opt) s \<and>
-                                     replySCs_of s (the reply_opt) = None) and cur_tcb'"
-                     in hoare_strengthen_post[rotated])
-               apply (fastforce split: option.splits)
-              apply (wpsimp wp: hoare_vcg_imp_lift)
-             apply assumption
-            apply (prop_tac "(tcb_at' t and tcb_at' t' and valid_pspace' and cur_tcb' and
-                              ep_at' ep and valid_release_queue and valid_release_queue' and
-                              valid_queues and valid_objs' and valid_mdb' and valid_queues' and
-                              cur_tcb') s'",
-                   assumption)
-            apply clarsimp
-            apply (case_tac reply_opt; clarsimp)
-            apply (subgoal_tac "reply_at' a s'", simp)
-             apply (frule (1) replySCs_of_cross, simp)
-            apply (erule cross_relF[OF _ reply_at'_cross_rel])
-            apply (clarsimp simp: obj_at_def reply_sc_reply_at_def is_reply)
-           apply (wpsimp wp: gts_wp)
-          apply (wpsimp wp: gts_wp')
-         apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-        apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-       \<comment> \<open>end of main Hoare triples\<close>
-       apply (subgoal_tac "tcb_at t' s")
-        apply (subgoal_tac "t' \<noteq> ep")
-         apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_def
-                               valid_sched_action_def pred_tcb_at_eq_commute)
-         apply (prop_tac "(t', EPRecv) \<in> state_refs_of s ep")
-          apply (clarsimp simp: state_refs_of_def obj_at_def)
-         apply (frule (1) sym_refsD, simp)
-         apply (frule TCBBlockedRecv_in_state_refs_of)
-         apply (clarsimp simp: invs_def pred_tcb_at_eq_commute st_tcb_at_tcb_at cong: conj_cong)
-         apply (intro conjI impI)
-               apply (clarsimp simp: valid_ep_def split: list.splits)
-              apply (erule (1) if_live_then_nonz_capD)
-              apply (clarsimp simp: obj_at_def live_def)
-             apply (erule weak_valid_sched_action_scheduler_action_not)
-             apply (clarsimp simp: obj_at_def pred_tcb_at_def)
-            apply (clarsimp, erule (1) FalseI[OF idle_no_ex_cap], clarsimp simp: valid_idle_def)
-           apply (case_tac "reply_object x"; simp)
-           apply (subgoal_tac "data = Some a", simp)
-            apply (subgoal_tac "reply_tcb_reply_at ((=) (Some t')) a s", simp)
-             apply (subgoal_tac "reply_sc_reply_at (\<lambda>a. a = None) a s", simp)
-              apply (intro conjI)
-               apply (clarsimp simp: sk_obj_at_pred_def obj_at_def)
-               apply (erule (1) if_live_then_nonz_capD2)
-               apply (clarsimp simp: live_def live_reply_def)
-              apply clarsimp
-              apply (frule (1) valid_repliesD1_simp, clarsimp simp: replies_blocked_def)
-              apply (subst (asm) identity_eq[where x="Structures_A.thread_state.BlockedOnReply aa" for aa, symmetric])+
-              apply (frule (1) st_tcb_reply_state_refs)
-              apply (clarsimp simp: pred_tcb_at_def obj_at_def reply_tcb_reply_at_def)
-             apply (subst identity_eq)
-             apply (erule (1) valid_replies_ReceiveD[rotated])
-              apply (subst identity_eq, assumption, simp)
-            apply (subst identity_eq)
-            apply (erule st_tcb_recv_reply_state_refs[rotated])
-            apply (subst identity_eq, assumption)
-           apply (clarsimp simp: obj_at_def pred_tcb_at_def)
-          subgoal for t' _ s
-            apply (rule delta_sym_refs, assumption)
-             apply (fastforce simp: obj_at_def state_refs_of_def split: list.splits if_splits)
-            apply clarsimp
-            apply (intro conjI)
-             apply (fastforce simp: valid_obj_def valid_ep_def is_tcb obj_at_def
-                             split: list.splits if_splits)
-            apply (clarsimp, intro conjI)
-             apply (clarsimp simp: obj_at_def split: if_splits)
-             apply (erule (1) pspace_valid_objsE)
-             apply (fastforce simp: state_refs_of_def)
-            apply (clarsimp simp: obj_at_def split: if_splits)
-             apply (subgoal_tac "st_tcb_at (\<lambda>st. \<exists>r pl. st = Structures_A.BlockedOnReceive ep r pl) t' s")
-              apply (clarsimp simp: st_tcb_at_def obj_at_def state_refs_of_def get_refs_def2
-                             split: if_splits)
-             apply (erule (1) valid_objsE)
-             apply (clarsimp simp: valid_obj_def valid_ep_def st_tcb_at_def obj_at_def)
-            apply (clarsimp simp: sym_refs_ko_atD obj_at_def split: list.splits)
-            done
-         apply (clarsimp simp: obj_at_def pred_tcb_at_def)
-        apply (clarsimp simp: obj_at_def is_tcb)
+        apply (rule corres_split[OF setEndpoint_corres])
+           apply (simp add: ep_relation_def split: list.split)
+          apply (rule corres_split[OF getThreadState_corres])
+            apply (rule_tac
+               F="\<exists>data. recv_state = Structures_A.BlockedOnReceive ep data"
+                   in corres_gen_asm)
+            apply (clarsimp simp: isReceive_def case_bool_If
+                       split del: if_split cong: if_cong)
+            apply (rule corres_split[OF doIPCTransfer_corres])
+              apply (rule corres_split[OF setThreadState_corres])
+                 apply simp
+                apply (rule possibleSwitchTo_corres)
+               apply (simp add: if_apply_def2)
+               apply ((wp sts_cur_tcb set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at_cases |
+                          simp add: if_apply_def2 split del: if_split)+)[1]
+              apply (wp sts_weak_sch_act_wf sts_valid_objs'
+                        sts_cur_tcb' setThreadState_tcb' sts_st_tcb_at'_cases)
+             apply (simp add: valid_tcb_state_def pred_conj_def)
+             apply ((wp hoare_drop_imps do_ipc_transfer_tcb_caps  weak_valid_sched_action_lift
+                     | clarsimp simp: is_cap_simps
+                     | strengthen valid_queues_in_correct_ready_q valid_queues_ready_qs_distinct
+                                  valid_sched_valid_queues )+)[1]
+            apply (simp add: valid_tcb_state'_def pred_conj_def)
+            apply (strengthen sch_act_wf_weak)
+            apply (wp weak_sch_act_wf_lift_linear hoare_drop_imps)
+           apply (wp gts_st_tcb_at)+
+         apply (simp add: pred_conj_def cong: conj_cong)
+         apply (wp hoare_TrueI)
+        apply simp
+        apply (wp weak_sch_act_wf_lift_linear set_ep_valid_objs' setEndpoint_valid_mdb')
+       apply (clarsimp simp add: invs_def valid_state_def
+                                 valid_pspace_def ep_redux_simps ep_redux_simps'
+                                 st_tcb_at_tcb_at
+                           cong: list.case_cong)
        apply (clarsimp simp: valid_ep_def)
-      apply (subgoal_tac "tcb_at' t' s")
-       apply (clarsimp simp: invs'_def valid_pspace'_def)
-       apply (clarsimp simp: valid_ep'_def split: list.splits)
-      apply (clarsimp simp: valid_ep'_def)
-      \<comment> \<open>concludes RecvEP\<close>
-     apply wpsimp
-    apply (wpsimp wp: get_ep_ko')
-   apply (clarsimp simp: obj_at_def is_ep)
-  apply simp
-  apply (frule cross_relF[OF _ tcb_at'_cross_rel[where t=t]]; clarsimp)
-  apply (frule cross_relF[OF _ ep_at'_cross_rel[where t=ep]]; clarsimp)
-  apply (frule cross_relF[OF _ sch_act_not_cross_rel[where t=t]]; clarsimp)
+       apply (drule(1) sym_refs_obj_atD[where P="\<lambda>ob. ob = e" for e])
+       apply (clarsimp simp: st_tcb_at_refs_of_rev st_tcb_at_reply_cap_valid
+                             st_tcb_at_caller_cap_null)
+       apply (fastforce simp: st_tcb_def2 valid_sched_def valid_sched_action_def)
+      subgoal by (auto simp: valid_ep'_def
+                      split: list.split;
+                  clarsimp simp: invs'_def valid_state'_def)
+     apply wp+
+   apply (clarsimp simp: ep_at_def2)+
   done
+qed
 
-end
-
-crunch maybeReturnSc
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p' s)"
-  and sc_at'_n[wp]: "\<lambda>s. Q (sc_at'_n n p s)"
-
-global_interpretation maybeReturnSc: typ_at_all_props' "maybeReturnSc ntfnPtr tcbPtr"
-  by typ_at_props'
+crunch setMessageInfo
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
 
-global_interpretation setMessageInfo: typ_at_all_props' "setMessageInfo t info"
-  by typ_at_props'
+lemmas setMessageInfo_typ_ats[wp] = typ_at_lifts [OF setMessageInfo_typ_at']
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+(* Annotation added by Simon Winwood (Thu Jul  1 20:54:41 2010) using taint-mode *)
+declare tl_drop_1[simp]
 
 crunch cancel_ipc
   for cur[wp]: "cur_tcb"
-  and ntfn_at[wp]: "ntfn_at t"
-  (wp: crunch_wps simp: crunch_simps ignore: set_object)
+  (wp: crunch_wps simp: crunch_simps)
+
+crunch asUser
+  for valid_objs'[wp]: "valid_objs'"
 
 lemma valid_sched_weak_strg:
   "valid_sched s \<longrightarrow> weak_valid_sched_action s"
   by (simp add: valid_sched_def valid_sched_action_def)
 
-lemma runnable_tsr:
-  "thread_state_relation ts ts' \<Longrightarrow> runnable' ts' = runnable ts"
-  by (case_tac ts, auto)
-
-lemma idle_tsr:
-  "thread_state_relation ts ts' \<Longrightarrow> idle' ts' = idle ts"
-  by (case_tac ts, auto)
-
-crunch cancelIPC
-  for cur[wp]: cur_tcb'
-  (wp: crunch_wps gts_wp' simp: crunch_simps)
-
-lemma setCTE_weak_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
-   setCTE c cte
-   \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add: weak_sch_act_wf_def)
-  apply (wp hoare_vcg_all_lift hoare_convert_imp setCTE_pred_tcb_at' setCTE_tcb_in_cur_domain')
-  done
-
-lemma getTCBSc_corres:
-  "corres (\<lambda>x y. \<exists>n. sc_relation x n y)
-          (\<lambda>s. bound_sc_tcb_at (\<lambda>sc. \<exists>y. sc = Some y \<and> sc_at y s) t s)
-          (\<lambda>s. bound_sc_tcb_at' (\<lambda>sc. \<exists>y. sc = Some y \<and> sc_at' y s) t s)
-          (get_tcb_sc t) (getTCBSc t)"
-  unfolding get_tcb_sc_def getTCBSc_def
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_eqr)
-       apply (clarsimp simp: get_tcb_obj_ref_def)
-       apply (rule threadGet_corres, simp add: tcb_relation_def)
-      apply clarsimp
-      apply (rule corres_assert_opt_assume_l)
-      apply (rule corres_assert_assume_r)
-      apply (rule get_sc_corres)
-     apply (clarsimp simp: get_tcb_obj_ref_def)
-     apply (wp thread_get_wp)
-    apply (wp threadGet_wp)
-   apply clarsimp
-   apply (fastforce simp: pred_tcb_at_def obj_at_def is_tcb_def)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma getScTime_corres:
-  "corres (=) (valid_objs and pspace_aligned and pspace_distinct
-               and active_scs_valid and active_sc_tcb_at t)
-              valid_objs'
-              (get_sc_time t) (getScTime t)"
-  apply (simp only: get_sc_time_def getScTime_def)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split[OF getTCBSc_corres])
-      apply clarsimp
-      apply (rule_tac s'=s' in conjunct2[OF refill_hd_relation2, symmetric])
-        apply simp+
-     apply (wpsimp wp: thread_get_wp simp: get_tcb_sc_def get_tcb_obj_ref_def)
-    apply (wpsimp wp: threadGet_wp simp: getTCBSc_def)
-   apply (clarsimp simp: vs_all_heap_simps obj_at_kh_kheap_simps is_sc_obj_def)
-   apply (erule_tac x=ref' in valid_objsE; simp add: valid_obj_def)
-   apply (drule_tac scp=ref' in active_scs_validE[rotated])
-    apply (clarsimp simp: is_sc_active_def is_sc_active_kh_simp[symmetric])
-   apply (fastforce simp: vs_all_heap_simps pred_map_def cfg_valid_refills_def rr_valid_refills_def
-                          sp_valid_refills_def sc_refill_cfgs_of_scs_def map_project_def)
-  apply (clarsimp simp: active_sc_tcb_at_def2)
-  apply (clarsimp simp: pred_tcb_at_def obj_at_def)
-  apply (prop_tac "sc_at scp s")
-   apply (fastforce simp: valid_obj_def valid_tcb_def)
-  apply (frule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-  apply clarsimp
-  apply (rename_tac ko; case_tac ko; simp add: other_obj_relation_def)
-  apply (frule (2) tcb_at_cross[OF state_relation_pspace_relation])
-   apply (fastforce simp: obj_at_def is_tcb)
-  apply (drule (2) sc_at_cross[OF state_relation_pspace_relation])
-   apply (fastforce simp: obj_at_def)
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def projectKOs tcb_relation_def valid_obj'_def
-                  dest!: sym[of "Some _"])
-  done
-
-lemma tcbReleaseEnqueue_corres:
-  "corres dc (valid_objs and pspace_aligned and pspace_distinct
-              and valid_release_q and active_scs_valid and active_sc_tcb_at t)
-             valid_objs'
-             (tcb_release_enqueue t) (tcbReleaseEnqueue t)"
-  apply (clarsimp simp: tcb_release_enqueue_def tcbReleaseEnqueue_def setReleaseQueue_def)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split_eqr)
-       apply (rule getScTime_corres)
-      apply (rule corres_split_eqr)
-         apply (rule release_queue_corres)
-        apply (rule corres_split_eqr)
-           apply (rule_tac r'="(=)" and S="(=)" in corres_mapM_list_all2; clarsimp)
-              apply (clarsimp simp: list.rel_eq)
-              apply wpfix
-              apply (rule_tac P="\<lambda>s. valid_objs s \<and> pspace_aligned s \<and> pspace_distinct s
-                                     \<and> active_scs_valid s
-                                     \<and> (\<forall>x \<in> set (y#xs). active_sc_tcb_at x s)"
-                           in corres_guard1_imp)
-               apply (rule getScTime_corres, simp)
-             apply wpsimp
-            apply (wpsimp simp: getScTime_def getTCBSc_def wp: hoare_drop_imps)
-           apply (clarsimp simp: list.rel_eq)
-          apply (rule corres_split)
-             apply (rule corres_when, simp)
-             apply (rule reprogram_timer_corres)
-            apply (rule corres_add_noop_lhs2)
-            apply (rule corres_split)
-               apply (rule corres_modify)
-               apply (clarsimp simp: state_relation_def release_queue_relation_def swp_def)
-              apply (rule threadSet_corres_noop; clarsimp simp: tcb_relation_def)
-             apply wp
-            apply wp
-           apply (rule hoare_strengthen_post[OF hoare_TrueI], simp)
-          apply (rule_tac Q="\<lambda>_. P and P" for P in hoare_triv)
-          apply wpsimp
-         apply wpsimp
-        apply (wpsimp wp: mapM_wp_lift threadGet_wp
-                    simp: getScTime_def getTCBSc_def obj_at'_def)
-       apply wp
-      apply wpsimp
-     apply wpsimp
-    apply (wpsimp wp: threadGet_wp simp: getScTime_def getTCBSc_def)
-   apply (clarsimp simp: valid_release_q_def)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma postpone_corres:
-  "corres dc (\<lambda>s. valid_objs s \<and> pspace_aligned s \<and> pspace_distinct s
-                         \<and> sym_refs (state_refs_of s)
-                         \<and> valid_release_q s \<and> active_scs_valid s \<and> is_active_sc ptr s
-                         \<and> sc_tcb_sc_at (\<lambda>sc. \<exists>t. sc = Some t \<and> not_queued t s) ptr s)
-             (valid_queues and valid_objs')
-             (SchedContext_A.postpone ptr) (postpone ptr)"
-  apply (rule stronger_corres_guard_imp)
-    apply (clarsimp simp: SchedContext_A.postpone_def postpone_def get_sc_obj_ref_def)
-    apply (rule_tac r'="\<lambda>sc sca. \<exists>n. sc_relation sc n sca" in corres_split)
-       apply (rule get_sc_corres)
-      apply (rule corres_assert_opt_assume_l)
-      apply (rule corres_split)
-         apply (clarsimp simp: sc_relation_def)
-         apply (rule_tac P="tcb_at (the (sc_tcb rv))" in corres_guard1_imp)
-          apply (rule tcbSchedDequeue_corres)
-         apply clarsimp
-        apply (rule corres_split)
-           apply (clarsimp simp: sc_relation_def)
-           apply (rule tcbReleaseEnqueue_corres)
-          apply (rule reprogram_timer_corres)
-         apply wp
-        apply wp
-       apply (wp tcb_sched_dequeue_not_queued_inv)
-       apply (subgoal_tac "scTCB rv' = sc_tcb rv")
-        apply clarsimp
-        apply assumption
-       apply (clarsimp simp: sc_relation_def)
-      apply wpsimp
-     apply wp
-    apply wp
-   apply (clarsimp simp: vs_all_heap_simps valid_obj_def obj_at_def is_obj_defs sc_at_ppred_def)
-   apply (drule_tac p=ptr in sym_refs_ko_atD[rotated])
-    apply (simp add: obj_at_def)
-   apply (fastforce simp: valid_obj_def valid_sched_context_def obj_at_def
-                          is_obj_defs get_refs_def refs_of_rev)
-  apply clarsimp
-  apply (rule context_conjI)
-   apply (fastforce intro!: sc_at_cross simp: sc_tcb_sc_at_def obj_at_def is_sc_obj_def valid_obj_def)
-  apply (clarsimp simp: sc_tcb_sc_at_def obj_at_def)
-  apply (rename_tac sc' sc n tp)
-  apply (prop_tac "scTCB sc' = Some tp")
-   apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-   apply (clarsimp simp: projectKOs obj_at'_def sc_relation_def split: if_split_asm)
-  apply simp
-  apply (rule tcb_at_cross; (simp add: state_relation_pspace_relation)?)
-  apply (fastforce simp: valid_obj_def valid_sched_context_def)
-  done
-
-lemma schedContextResume_corres:
-  "corres dc (valid_objs and pspace_aligned and pspace_distinct and valid_ready_qs and valid_release_q
-                   and active_scs_valid and sc_tcb_sc_at (\<lambda>sc. sc \<noteq> None) ptr
-                   and (\<lambda>s. sym_refs (state_refs_of s)))
-             (valid_objs' and valid_queues and valid_release_queue_iff)
-             (sched_context_resume ptr) (schedContextResume ptr)"
-  apply (simp only: sched_context_resume_def schedContextResume_def)
-  apply (rule stronger_corres_guard_imp)
-    apply clarsimp
-    apply (rule_tac r'="\<lambda>sc sca. \<exists>n. sc_relation sc n sca" in corres_split)
-       apply (rule get_sc_corres)
-      apply (rename_tac sc sca)
-      apply (rule corres_assert_opt_assume_l)
-      apply (rule corres_assert_assume_r)
-      apply (rule corres_split_eqr)
-         apply (clarsimp simp: sc_relation_def)
-         apply (rule corres_guard_imp)
-           apply (rule isSchedulable_corres)
-          apply (prop_tac "(valid_objs and tcb_at (the (sc_tcb sc))
-                                       and pspace_aligned and pspace_distinct) s")
-           apply assumption
-          apply clarsimp
-         apply assumption
-        apply (rule corres_when)
-         apply clarsimp
-        apply (rule corres_symb_exec_l)
-           apply (rule_tac F="runnable ts \<and> sc_active sc" in corres_gen_asm)
-           apply (rule corres_split_eqr)
-              apply (rule refillReady_corres, simp)
-             apply (rule corres_split_eqr)
-                apply (rule refillSufficient_corres, simp)
-               apply (rule corres_when)
-                apply clarsimp
-               apply (rule corres_symb_exec_l)
-                  apply (rule corres_symb_exec_l)
-                     apply (rule corres_symb_exec_l)
-                        apply (rule corres_assert_assume_l)
-                        apply (rule postpone_corres)
-                       apply (wpsimp simp: get_tcb_queue_def)
-                      apply wp
-                     apply (clarsimp simp: no_fail_def get_tcb_queue_def gets_def get_def)
-                    prefer 2
-                    apply (wp thread_get_wp)
-                   apply (wp thread_get_exs_valid)
-                    apply (clarsimp simp: obj_at_def is_tcb_def)
-                   apply clarsimp
-                  apply (clarsimp simp: no_fail_def obj_at_def thread_get_def
-                                        gets_the_def get_tcb_def gets_def get_def
-                                        assert_opt_def bind_def return_def)
-                 prefer 2
-                 apply (wp thread_get_wp)
-                apply (wp thread_get_exs_valid)
-                 apply (clarsimp simp: obj_at_def is_tcb_def)
-                apply clarsimp
-               apply (clarsimp simp: no_fail_def obj_at_def thread_get_def
-                                     gets_the_def get_tcb_def gets_def get_def
-                                     assert_opt_def bind_def return_def)
-              apply wp
-             apply (wpsimp simp: refillSufficient_def getRefills_def)
-            apply wp
-           apply (wpsimp simp: refillReady_def getCurTime_def)
-          apply (rule thread_get_exs_valid)
-          apply (erule conjunct1)
-         apply (wp thread_get_wp)
-         apply (clarsimp cong: conj_cong)
-         apply assumption
-        apply clarsimp
-        apply (rule no_fail_pre)
-         apply (wpsimp simp: thread_get_def)
-        apply (clarsimp simp: tcb_at_def)
-       apply (wp is_schedulable_wp)
-      apply (wp isSchedulable_wp)
-     apply wp
-    apply wp
-   apply (subgoal_tac "sc_tcb_sc_at (\<lambda>t. bound_sc_tcb_at (\<lambda>sc. sc = Some ptr) (the t) s) ptr s ")
-    apply (clarsimp simp: sc_at_ppred_def obj_at_def is_sc_obj_def bound_sc_tcb_at_def is_tcb_def
-                    cong: conj_cong)
-
-    apply (intro conjI; (clarsimp simp: invs_def valid_state_def; fail)?)
-     apply (fastforce simp: invs_def valid_state_def valid_pspace_def valid_obj_def)
-    apply (clarsimp simp: schedulable_def get_tcb_def obj_at_kh_kheap_simps)
-    apply (rename_tac t; prop_tac "budget_sufficient t s")
-     apply (erule active_valid_budget_sufficient)
-     apply (clarsimp simp: vs_all_heap_simps)
-    apply (intro conjI impI)
-        apply (fastforce simp: valid_refills_def vs_all_heap_simps rr_valid_refills_def
-                               opt_map_red opt_pred_def MIN_REFILLS_def
-                        dest!: active_scs_validE split: if_split_asm)
-       apply (fastforce simp: valid_refills_def vs_all_heap_simps rr_valid_refills_def
-                       dest!: active_scs_validE)
-      apply (fastforce simp: vs_all_heap_simps valid_ready_qs_2_def
-                             valid_ready_queued_thread_2_def in_ready_q_def)
-     apply (fastforce simp: vs_all_heap_simps valid_ready_qs_2_def
-                            valid_ready_queued_thread_2_def in_ready_q_def)
-    apply (fastforce simp: vs_all_heap_simps valid_ready_qs_2_def
-                           valid_ready_queued_thread_2_def in_ready_q_def)
-   apply (clarsimp simp: sc_at_ppred_def obj_at_def)
-   apply (drule sym_refs_ko_atD[rotated], simp add: obj_at_def)
-   apply (clarsimp simp: pred_tcb_at_def obj_at_def refs_of_rev)
-  apply (clarsimp simp: invs'_def valid_pspace'_def)
-  apply (rule context_conjI; clarsimp?)
-   apply (fastforce simp: sc_tcb_sc_at_def obj_at_def is_sc_obj_def valid_obj_def
-                    dest: invs_valid_objs intro!: sc_at_cross)
-  apply (rule conjI, erule valid_objs'_valid_tcbs')
-  apply (clarsimp simp: sc_tcb_sc_at_def obj_at_def)
-  apply (frule (2) sym_ref_sc_tcb, clarsimp)
-  apply (prop_tac "scTCB ko = Some y")
-   apply (frule state_relation_sc_relation[where ptr=ptr])
-     apply (clarsimp simp: obj_at_simps is_sc_obj)
-     apply (erule (1) valid_sched_context_size_objsI, simp)
-   apply (clarsimp simp: sc_relation_def projection_rewrites obj_at_simps opt_map_red)
-  apply (frule_tac x=y in pspace_relation_absD[OF _ state_relation_pspace_relation]; simp)
-  apply (clarsimp simp: obj_at'_def projectKOs isSchedulable_bool_def projection_rewrites
-                        other_obj_relation_def tcb_relation_def)
-  apply (drule sym[where s="Some ptr"])
-  apply (clarsimp simp: projection_rewrites isScActive_def opt_map_red)
-  apply (erule (1) valid_objsE')
-  apply (clarsimp simp: valid_obj'_def valid_sched_context'_def sc_relation_def valid_refills'_def
-                        opt_map_def opt_pred_def)
-  done
-
-lemma getScTime_wp:
-  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb tptr s \<longrightarrow> (tcbSchedContext tcb \<noteq> None) \<longrightarrow>
-        (\<forall>sc. ko_at' sc (the (tcbSchedContext tcb)) s \<longrightarrow>
-          P (rTime (refillHd sc)) s)\<rbrace>
-   getScTime tptr \<lbrace>P\<rbrace>"
-  apply (wpsimp simp: getScTime_def getTCBSc_def wp: threadGet_wp)
-  by (clarsimp simp: tcb_at'_ex_eq_all)
-
-lemma updateRefillHd_valid_objs':
-  "\<lbrace>valid_objs' and active_sc_at' scPtr\<rbrace> updateRefillHd scPtr f \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  apply (clarsimp simp: updateRefillHd_def updateSchedContext_def)
-  apply wpsimp
-  apply (frule (1) sc_ko_at_valid_objs_valid_sc')
-  apply (clarsimp simp: valid_sched_context'_def active_sc_at'_def obj_at'_real_def ko_wp_at'_def
-                        valid_sched_context_size'_def objBits_def objBitsKO_def projectKO_sc)
-  done
-
-lemma getCTE_cap_to_refs[wp]:
-  "\<lbrace>\<top>\<rbrace> getCTE p \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' (cteCap rv). ex_nonz_cap_to' r s\<rbrace>"
-  apply (rule hoare_strengthen_post [OF getCTE_sp])
-  apply (clarsimp simp: ex_nonz_cap_to'_def)
-  apply (fastforce elim: cte_wp_at_weakenE')
-  done
-
-lemma lookupCap_cap_to_refs[wp]:
-  "\<lbrace>\<top>\<rbrace> lookupCap t cref \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s\<rbrace>,-"
-  apply (simp add: lookupCap_def lookupCapAndSlot_def split_def
-                   getSlotCap_def)
-  apply (wp | simp)+
-  done
-
-lemma arch_stt_objs' [wp]:
-  "\<lbrace>valid_objs'\<rbrace> Arch.switchToThread t \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
-  apply (simp add: ARM_H.switchToThread_def)
-  apply wp
-  done
-
-lemma cteInsert_ct'[wp]:
-  "\<lbrace>cur_tcb'\<rbrace> cteInsert a b c \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
-  by (wp sch_act_wf_lift valid_queues_lift cur_tcb_lift tcb_in_cur_domain'_lift)
-
-lemma maybeDonateSc_corres:
-  "corres dc (tcb_at tcb_ptr and ntfn_at ntfn_ptr and weak_valid_sched_action
-              and valid_ready_qs and active_scs_valid and valid_release_q
-              and valid_objs and pspace_aligned and pspace_distinct and (\<lambda>s. sym_refs (state_refs_of s)))
-             (tcb_at' tcb_ptr and ntfn_at' ntfn_ptr
-              and valid_objs' and valid_queues and valid_queues' and valid_release_queue_iff)
-             (maybe_donate_sc tcb_ptr ntfn_ptr)
-             (maybeDonateSc tcb_ptr ntfn_ptr)"
-  unfolding maybeDonateSc_def maybe_donate_sc_def
-  apply (simp add: get_tcb_obj_ref_def get_sk_obj_ref_def liftM_def maybeM_def get_sc_obj_ref_def)
-  apply add_sym_refs
-  apply (rule corres_stateAssert_assume)
-   apply (rule stronger_corres_guard_imp)
-     apply (rule corres_split[OF threadGet_corres, where r'="(=)"])
-        apply (clarsimp simp: tcb_relation_def)
-       apply (rule corres_when, simp)
-       apply (rule corres_split[OF getNotification_corres])
-         apply (rule corres_option_split)
-           apply (clarsimp simp: ntfn_relation_def)
-          apply (rule corres_return_trivial)
-         apply (simp add: get_tcb_obj_ref_def liftM_def maybeM_def)
-         apply (rule corres_split[OF get_sc_corres])
-           apply (rule corres_when)
-            apply (clarsimp simp: sc_relation_def)
-           apply (rule corres_split[OF schedContextDonate_corres])
-             apply (rule schedContextResume_corres, simp)
-            apply clarsimp
-            apply wpsimp
-            apply (rule_tac Q'="\<lambda>_. valid_objs and valid_ready_qs and
-                      pspace_aligned and pspace_distinct and (\<lambda>s. sym_refs (state_refs_of s)) and
-                      active_scs_valid and valid_release_q and
-                      sc_not_in_release_q xa and sc_tcb_sc_at ((=) (Some tcb_ptr)) xa"
-                   in hoare_strengthen_post[rotated])
-             apply (fastforce simp: sc_at_pred_n_def obj_at_def)
-            apply (wpsimp wp: sched_context_donate_sym_refs
-                              sched_context_donate_sc_not_in_release_q
-                              sched_context_donate_sc_tcb_sc_at)
-           apply (wpsimp wp: schedContextDonate_valid_objs')
-          apply (wpsimp wp: get_simple_ko_wp getNotification_wp)+
-      apply (wpsimp wp: thread_get_wp' threadGet_wp)+
-    apply (clarsimp simp: tcb_at_kh_simps pred_map_eq_normalise invs_def valid_state_def valid_pspace_def
-                   split: option.splits cong: conj_cong)
-    apply (rename_tac sc_ptr)
-    apply (subgoal_tac "sc_at sc_ptr s", clarsimp)
-     apply (subgoal_tac "pred_map_eq None (tcb_scps_of s) tcb_ptr", clarsimp)
-      apply (intro conjI)
-        apply (erule (1) weak_valid_sched_action_no_sc_sched_act_not)
-       apply (erule (1) valid_release_q_no_sc_not_in_release_q)
-      apply clarsimp
-      apply (drule heap_refs_retractD[OF sym_refs_retract_tcb_scps, rotated], simp)
-      apply (clarsimp simp: vs_all_heap_simps obj_at_def)
-     apply (clarsimp simp: vs_all_heap_simps obj_at_def)
-    apply (frule valid_objs_ko_at[where ptr=ntfn_ptr, rotated], clarsimp)
-    apply (clarsimp simp: valid_obj_def valid_ntfn_def)
-   apply (clarsimp simp: tcb_at'_ex_eq_all split: option.splits)
-   apply (rename_tac sc_ptr)
-   apply (fastforce elim!: valid_objsE'[where x=ntfn_ptr] simp: obj_at_simps valid_obj'_def valid_ntfn'_def)
-  apply (clarsimp simp: sym_refs_asrt_def)
-  done
-
-lemma setReleaseQueue_valid_release_queue[wp]:
-  "\<lbrace>\<lambda>s. \<forall>t. t \<in> set Q \<longrightarrow> obj_at' (tcbInReleaseQueue) t s\<rbrace>
-   setReleaseQueue Q
-   \<lbrace>\<lambda>_. valid_release_queue\<rbrace>"
-  apply (clarsimp simp: valid_release_queue_def)
-  by (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-
-lemma setReleaseQueue_valid_queues[wp]:
-  "setReleaseQueue Q \<lbrace>valid_queues\<rbrace>"
-  by (wpsimp simp: valid_queues_def)
-
-lemma getScTime_tcb_at'[wp]:
-  "\<lbrace>\<top>\<rbrace> getScTime tptr \<lbrace>\<lambda>_. tcb_at' tptr\<rbrace>"
-  by (wpsimp wp: getScTime_wp)
-
-lemma tcbReleaseEnqueue_vrq[wp]:
-  "tcbReleaseEnqueue tcbPtr \<lbrace>valid_release_queue\<rbrace>"
-  unfolding tcbReleaseEnqueue_def
-  apply wpsimp
-          apply (wpsimp wp: threadSet_enqueue_vrq)
-         apply ((wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)+)[4]
-     apply (rule_tac Q'="\<lambda>r. tcb_at' tcbPtr and (\<lambda>s. \<forall>x. x \<in> set qs \<longrightarrow> obj_at' tcbInReleaseQueue x s)
-                        and K (length qs = length r)"
-            in hoare_strengthen_post[rotated])
-      apply (fastforce dest: in_set_zip1)
-     apply (wpsimp wp: mapM_wp_inv)
-    apply wpsimp
-   apply (wpsimp wp_del: getScTime_inv, wpsimp)
-  apply (clarsimp simp: valid_release_queue_def)
-  done
-
-lemma tcbReleaseEnqueue_vrq'[wp]:
-  "tcbReleaseEnqueue tcbPtr \<lbrace>valid_release_queue'\<rbrace>"
-  unfolding tcbReleaseEnqueue_def
-  apply wpsimp
-          apply (wpsimp wp: threadSet_enqueue_vrq')
-         apply ((wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)+)[4]
-     apply (rule_tac Q'="\<lambda>r. tcb_at' tcbPtr and (\<lambda>s. \<forall>x. obj_at' tcbInReleaseQueue x s \<longrightarrow> x \<in> set qs)
-                            and K (length qs = length r)"
-            in hoare_strengthen_post[rotated])
-      apply clarsimp
-      apply (drule_tac x=x in spec, clarsimp)
-      apply (subst (asm) fst_image_set_zip[symmetric], assumption)
-      apply (fastforce simp: image_def)
-     apply (wpsimp wp: mapM_wp_inv)
-    apply wpsimp
-   apply (wpsimp wp_del: getScTime_inv, wpsimp)
-  apply (clarsimp simp: valid_release_queue'_def)
-  done
-
-lemma tcbReleaseEnqueue_valid_queues[wp]:
-  "tcbReleaseEnqueue tcbPtr \<lbrace>valid_queues\<rbrace>"
-  unfolding tcbReleaseEnqueue_def
-  apply (wpsimp wp: threadSet_valid_queues)
-         apply (clarsimp cong: conj_cong simp: inQ_def)
-         by (wpsimp wp: mapM_wp_inv)+
-
-lemma tcbReleaseEnqueue_valid_queues'[wp]:
-  "tcbReleaseEnqueue tcbPtr \<lbrace>valid_queues'\<rbrace>"
-  unfolding tcbReleaseEnqueue_def
-  apply (wpsimp wp: threadSet_valid_queues')
-         apply (clarsimp cong: conj_cong simp: inQ_def)
-         by (wpsimp wp: mapM_wp_inv)+
-
-lemma postpone_vrq[wp]:
-  "\<lbrace>valid_release_queue and valid_objs' and obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr\<rbrace>
-   postpone scPtr
-   \<lbrace>\<lambda>_. valid_release_queue\<rbrace>"
-  unfolding postpone_def
-  by (wpsimp wp: getNotification_wp threadGet_wp)
-
-lemma postpone_vrq'[wp]:
-  "\<lbrace>valid_release_queue' and valid_objs' and obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr\<rbrace>
-   postpone scPtr
-   \<lbrace>\<lambda>_. valid_release_queue'\<rbrace>"
-  unfolding postpone_def
-  by (wpsimp wp: getNotification_wp threadGet_wp)
-
-lemma postpone_vq[wp]:
-  "\<lbrace>valid_queues and valid_objs'\<rbrace>
-   postpone scPtr
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  unfolding postpone_def
-  apply (wpsimp wp: getNotification_wp threadGet_wp tcbSchedDequeue_valid_queues)
-  apply (subst obj_at'_conj[symmetric])
-  apply (erule (1) valid_objs_valid_tcbE')
-  by (clarsimp simp: valid_tcb'_def)
-
-crunch postpone
-  for valid_queues'[wp]: valid_queues'
-
-crunch setReleaseQueue, tcbReleaseEnqueue, postpone, schedContextResume
-  for valid_objs'[wp]: valid_objs'
-  (wp: crunch_wps)
-
-lemma schedContextResume_vrq[wp]:
-  "\<lbrace>valid_release_queue and valid_objs' and obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr\<rbrace>
-   schedContextResume scPtr
-   \<lbrace>\<lambda>_. valid_release_queue\<rbrace>"
-  unfolding schedContextResume_def
-  by (wpsimp wp: hoare_vcg_if_lift2 hoare_drop_imp refillReady_wp)
-
-lemma schedContextResume_vrq'[wp]:
-  "\<lbrace>valid_release_queue' and valid_objs'\<rbrace> schedContextResume scPtr \<lbrace>\<lambda>_. valid_release_queue'\<rbrace>"
-  unfolding schedContextResume_def
-  apply (wpsimp | wpsimp wp: hoare_vcg_if_lift2 hoare_drop_imp refillReady_wp)+
-  by (clarsimp simp: obj_at'_def)
-
-lemma schedContextResume_vq[wp]:
-  "\<lbrace>valid_queues and valid_objs'\<rbrace> schedContextResume scPtr \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  unfolding schedContextResume_def
-  by (wpsimp wp: hoare_vcg_if_lift2 hoare_drop_imp)
-
-crunch schedContextResume
-  for valid_queues'[wp]: valid_queues'
-  (wp: crunch_wps)
-
-lemma updateSchedContext_sc_obj_at':
-  "\<lbrace>if scPtr = scPtr' then (\<lambda>s. \<forall>ko. ko_at' ko scPtr' s \<longrightarrow> P (f ko)) else obj_at' P scPtr'\<rbrace>
-   updateSchedContext scPtr f
-   \<lbrace>\<lambda>rv. obj_at' P scPtr'\<rbrace>"
-  supply if_split [split del]
-  apply (simp add: updateSchedContext_def)
-  apply (wpsimp wp: set_sc'.obj_at')
-  apply (clarsimp split: if_splits simp: obj_at'_real_def ko_wp_at'_def)
-  done
-
-lemma refillPopHead_bound_tcb_sc_at[wp]:
-  "refillPopHead scPtr \<lbrace>obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) t\<rbrace>"
-  supply if_split [split del]
-  unfolding refillPopHead_def
-  apply (wpsimp wp: updateSchedContext_sc_obj_at' getRefillNext_wp)
-  by (clarsimp simp: obj_at'_real_def ko_wp_at'_def split: if_split)
-
-lemma updateRefillHd_bound_tcb_sc_at[wp]:
-  "updateRefillHd scPtr f \<lbrace>obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) t\<rbrace>"
-  supply if_split [split del]
-  unfolding updateRefillHd_def
-  apply (wpsimp wp: set_sc'.obj_at' simp: updateSchedContext_def)
-  by (clarsimp simp: obj_at'_real_def ko_wp_at'_def split: if_split)
-
-crunch refillUnblockCheck
-  for bound_tcb_sc_at[wp]: "obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) t"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma maybeDonateSc_valid_release_queue[wp]:
-  "\<lbrace>valid_objs' and valid_release_queue\<rbrace>
-   maybeDonateSc tcbPtr ntfnPtr
-   \<lbrace>\<lambda>_. valid_release_queue\<rbrace>"
-  unfolding maybeDonateSc_def
-  apply wpsimp
-  apply (rule_tac Q'="\<lambda>_. valid_release_queue and valid_objs'
-                         and obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) x2"
-         in hoare_strengthen_post[rotated], clarsimp)
-       apply (wpsimp wp: getNotification_wp threadGet_wp schedContextDonate_valid_objs')+
-  by (clarsimp simp: obj_at'_def)
-
-lemma maybeDonateSc_valid_objs'[wp]:
-  "\<lbrace>valid_objs'\<rbrace>
-   maybeDonateSc tptr nptr
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  unfolding maybeDonateSc_def
-  apply (wpsimp wp: getNotification_wp threadGet_wp schedContextDonate_valid_objs')
-  by (clarsimp simp: obj_at'_def)
-
-lemma maybeDonateSc_vrq'[wp]:
-  "\<lbrace>valid_objs' and valid_release_queue'\<rbrace>
-   maybeDonateSc tptr nptr
-   \<lbrace>\<lambda>_. valid_release_queue'\<rbrace>"
-  unfolding maybeDonateSc_def
-  apply (wpsimp wp: getNotification_wp threadGet_wp schedContextDonate_valid_objs')
-  by (clarsimp simp: obj_at'_def)
-
-lemma maybeDonateSc_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_objs'\<rbrace>
-   maybeDonateSc tptr nptr
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  unfolding maybeDonateSc_def
-  apply (wpsimp wp: getNotification_wp threadGet_wp schedContextDonate_valid_queues
-                    schedContextDonate_valid_objs')
-  by (clarsimp simp: obj_at'_def)
-
-lemma maybeDonateSc_valid_queues'[wp]:
-  "\<lbrace>valid_queues'\<rbrace>
-   maybeDonateSc tptr nptr
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  unfolding maybeDonateSc_def
-  apply (wpsimp wp: getNotification_wp threadGet_wp schedContextDonate_valid_queues')
-  by (clarsimp simp: obj_at'_def)
-
-lemma tcbFault_update_ex_nonz_cap_to'[wp]:
-  "threadSet (tcbFault_update x) t' \<lbrace>ex_nonz_cap_to' t\<rbrace>"
-  unfolding ex_nonz_cap_to'_def
-  by (wpsimp wp: threadSet_cte_wp_at'T hoare_vcg_ex_lift;
-      fastforce simp: tcb_cte_cases_def)
-
-crunch cancelIPC
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' t"
-  (wp: crunch_wps simp: crunch_simps ignore: threadSet)
-
-lemma thread_state_tcb_in_WaitingNtfn'_q:
-  "\<lbrakk>ko_at' ntfn ntfnPtr s; ntfnObj ntfn = Structures_H.ntfn.WaitingNtfn q; valid_objs' s;
-    sym_refs (state_refs_of' s); t \<in> set q\<rbrakk>
-   \<Longrightarrow> st_tcb_at' is_BlockedOnNotification t s"
-  apply (clarsimp simp: sym_refs_def)
-  apply (erule_tac x = ntfnPtr in allE)
-  apply (drule_tac x = "(t, NTFNSignal)" in bspec)
-   apply (clarsimp simp: state_refs_of'_def obj_at'_def refs_of'_def projectKOs)
-  apply (subgoal_tac "tcb_at' t s")
-   apply (clarsimp simp: state_refs_of'_def refs_of'_def obj_at'_real_def ko_wp_at'_def
-                         projectKO_tcb tcb_st_refs_of'_def tcb_bound_refs'_def get_refs_def)
-   apply (erule disjE)
-    apply (case_tac "tcbState obj"; clarsimp split: if_splits)
-    apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def projectKO_tcb)
-   apply (clarsimp split: option.splits)
-  apply (drule (1) ntfn_ko_at_valid_objs_valid_ntfn')
-  apply (clarsimp simp: valid_ntfn'_def)
-  done
-
-lemma cancelSignal_valid_idle':
-  "\<lbrace>\<lambda>s. valid_idle' s \<and> threadPtr \<noteq> ksIdleThread s\<rbrace>
-   cancelSignal threadPtr ntfnPtr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  apply (clarsimp simp: cancelSignal_def)
-  apply (wpsimp wp: getNotification_wp)
-  done
-
-lemma cancelIPC_valid_idle'[wp]:
-  "\<lbrace>\<lambda>s. valid_idle' s \<and> tptr \<noteq> ksIdleThread s\<rbrace>
-   cancelIPC tptr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  apply (clarsimp simp: cancelIPC_def)
-  apply (rule bind_wp_fwd_skip, solves \<open>wpsimp wp: threadSet_idle'\<close>)+
-  apply (wpsimp wp: blockedCancelIPC_valid_idle' replyRemoveTCB_valid_idle' cancelSignal_valid_idle')
-  done
+crunch as_user
+  for weak_valid_sched_action[wp]: weak_valid_sched_action
+  (wp: weak_valid_sched_action_lift)
 
 lemma sendSignal_corres:
-  "corres dc (einvs and ntfn_at ep and current_time_bounded) (invs' and ntfn_at' ep)
+  "corres dc (einvs and ntfn_at ep) (invs' and ntfn_at' ep)
              (send_signal ep bg) (sendSignal ep bg)"
   apply (simp add: send_signal_def sendSignal_def Let_def)
-  apply add_sym_refs
-  apply add_valid_idle'
-  apply (rule corres_stateAssert_assume)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF getNotification_corres,
-                 where
-                 R  = "\<lambda>rv. einvs and ntfn_at ep and valid_ntfn rv and
-                            ko_at (Structures_A.Notification rv) ep
-                            and current_time_bounded" and
-                 R' = "\<lambda>rv'. invs' and valid_idle' and ntfn_at' ep and
-                             valid_ntfn' rv' and ko_at' rv' ep"])
-       defer
-       apply (wp get_simple_ko_ko_at get_ntfn_ko')+
-     apply (simp add: invs_valid_objs invs_valid_objs')+
-   apply (clarsimp simp: sym_refs_asrt_def)
-  apply add_sym_refs
-  apply (case_tac "ntfn_obj ntfn"; simp)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF getNotification_corres,
+                where
+                R  = "\<lambda>rv. einvs and ntfn_at ep and valid_ntfn rv and
+                           ko_at (Structures_A.Notification rv) ep" and
+                R' = "\<lambda>rv'. invs' and ntfn_at' ep and
+                            valid_ntfn' rv' and ko_at' rv' ep"])
+      defer
+      apply (wp get_simple_ko_ko_at get_ntfn_ko')+
+    apply (simp add: invs_valid_objs)+
+  apply (case_tac "ntfn_obj ntfn")
     \<comment> \<open>IdleNtfn\<close>
     apply (clarsimp simp add: ntfn_relation_def)
-    apply (case_tac "ntfnBoundTCB nTFN"; simp)
+    apply (case_tac "ntfnBoundTCB nTFN")
+     apply clarsimp
      apply (rule corres_guard_imp[OF setNotification_corres])
        apply (clarsimp simp add: ntfn_relation_def)+
     apply (rule corres_guard_imp)
@@ -3421,216 +2616,172 @@ lemma sendSignal_corres:
                                  Structures_H.thread_state.splits)
          apply (rule corres_split[OF cancel_ipc_corres])
            apply (rule corres_split[OF setThreadState_corres])
-              apply clarsimp
+              apply (clarsimp simp: thread_state_relation_def)
              apply (simp add: badgeRegister_def badge_register_def)
              apply (rule corres_split[OF asUser_setRegister_corres])
-               apply (rule corres_split[OF maybeDonateSc_corres])
-                 apply (rule corres_split[OF isSchedulable_corres])
-                   apply (rule corres_split[OF corres_when], simp)
-                      apply (rule possibleSwitchTo_corres; (solves simp)?)
-                     apply (rule corres_split_eqr[OF get_tcb_obj_ref_corres])
-                        apply (clarsimp simp: tcb_relation_def)
-                       apply (rule ifCondRefillUnblockCheck_corres)
-                      apply (wpsimp wp: get_tcb_obj_ref_wp)
-                     apply (wpsimp wp: threadGet_wp)
-                    apply (rule_tac Q'="\<lambda>_. tcb_at a and active_scs_valid and pspace_aligned
-                                           and pspace_distinct and valid_objs"
-                           in hoare_strengthen_post[rotated])
-                     apply (clarsimp, drule (1) valid_objs_ko_at)
-                     apply (fastforce simp: valid_tcb_def obj_at_def is_sc_obj opt_map_def
-                                            opt_pred_def valid_obj_def
-                                     split: option.split)
-                    apply wpsimp
-                   apply (rule_tac Q'="\<lambda>_. tcb_at' a and valid_objs'" in hoare_strengthen_post[rotated])
-                    apply (clarsimp simp: obj_at'_def split: option.split)
-                   apply wpsimp
-                  apply (wpsimp wp: is_schedulable_wp)
-                 apply (wpsimp wp: isSchedulable_wp)
-                apply (wpsimp wp: hoare_drop_imp maybe_donate_sc_valid_sched_action abs_typ_at_lifts
-                     | strengthen valid_objs_valid_tcbs)+
-               apply(wpsimp wp: hoare_drop_imp | strengthen valid_objs'_valid_tcbs')+
-            apply (strengthen valid_sched_action_weak_valid_sched_action)
-            apply (wpsimp wp: sts_cancel_ipc_Running_invs set_thread_state_valid_sched_action
-                              set_thread_state_valid_ready_qs
-                              set_thread_state_valid_release_q)
-           apply (wpsimp wp: sts_invs')
-          apply (rename_tac ntfn ntfn' tptr st st')
-          apply (rule_tac Q'="\<lambda>_. invs and tcb_at tptr and ntfn_at ep and
-                   st_tcb_at
-                     ((=) Structures_A.thread_state.Running or
-                      (=) Structures_A.thread_state.Inactive or
-                      (=) Structures_A.thread_state.Restart or
-                      (=) Structures_A.thread_state.IdleThreadState) tptr and
-                   ex_nonz_cap_to tptr and fault_tcb_at ((=) None) tptr and
-                   valid_sched and scheduler_act_not tptr and active_scs_valid
-                   and current_time_bounded"
-                 in hoare_strengthen_post[rotated])
-           apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_def pred_disj_def)
-           apply (rule conjI, fastforce)
-           apply (prop_tac "tcb_non_st_state_refs_of s tptr = state_refs_of s tptr")
-            apply (drule (1) sym_refs_st_tcb_atD)
-            apply clarsimp
-            apply (prop_tac "tcb_st_refs_of ts = {}")
-             apply (fastforce simp: tcb_st_refs_of_def)
-            apply simp
-            apply (clarsimp simp add: get_refs_def split: option.splits; fastforce?)
-           apply (fold fun_upd_def, simp)
-          apply (wpsimp wp: cancel_ipc_simple_except_awaiting_reply cancel_ipc_ex_nonz_cap_to_tcb)
-         apply (clarsimp cong: conj_cong simp: pred_conj_def valid_tcb_state'_def pred_tcb_at'_eq_commute)
-         apply (rule_tac Q'="\<lambda>_. invs' and valid_idle' and tcb_at' a and ntfn_at' ep and
-                                (\<lambda>s. a \<noteq> ksIdleThread s) and ex_nonz_cap_to' a and
-                                st_tcb_at' simple' a"
-                in hoare_strengthen_post[rotated])
-          apply (fastforce simp: invs'_def valid_pspace'_def pred_tcb_at'_def obj_at'_def)
-         apply (wpsimp wp: cancelIPC_invs')
-        apply (rule setNotification_corres, clarsimp simp: ntfn_relation_def)
-       apply (wpsimp wp: gts_wp gts_wp')+
-     apply (frule (1) valid_objs_ko_at[OF invs_valid_objs])
-     apply (clarsimp simp: valid_obj_def valid_ntfn_def receive_blocked_equiv
-                           is_blocked_on_receive_def)
-     apply (frule (1) valid_sched_scheduler_act_not, simp)
-     apply (frule st_tcb_ex_cap; clarsimp)
-     apply (clarsimp simp: invs_def valid_sched_def valid_state_def valid_pspace_def)
-    apply (clarsimp simp: valid_ntfn'_def)
-    apply (intro conjI)
-     apply (clarsimp simp: valid_idle'_def invs'_def idle_tcb'_def obj_at'_def
-                           pred_tcb_at'_def receiveBlocked_def)
-    apply (rule if_live_then_nonz_capE', clarsimp)
-    apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def projectKO_tcb)
-    apply (clarsimp simp: receiveBlocked_equiv is_BlockedOnReceive_def)
+               apply (rule possibleSwitchTo_corres)
+              apply wp
+             apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
+                       sts_st_tcb' sts_valid_objs' hoare_disjI2
+                       cancel_ipc_cte_wp_at_not_reply_state
+                  | strengthen invs_vobjs_strgs invs_psp_aligned_strg valid_sched_weak_strg
+                               valid_queues_in_correct_ready_q valid_queues_ready_qs_distinct
+                               valid_sched_valid_queues
+                  | simp add: valid_tcb_state_def)+
+         apply (rule_tac Q'="\<lambda>rv. invs' and tcb_at' a" in hoare_strengthen_post)
+          apply wp
+         apply (fastforce simp: invs'_def valid_state'_def sch_act_wf_weak valid_tcb_state'_def)
+        apply (rule setNotification_corres)
+        apply (clarsimp simp add: ntfn_relation_def)
+       apply (wp gts_wp gts_wp' | clarsimp)+
+     apply (auto simp: valid_ntfn_def receive_blocked_def valid_sched_def invs_cur
+                 elim: pred_tcb_weakenE
+                intro: st_tcb_at_reply_cap_valid
+                split: Structures_A.thread_state.splits)[1]
+    apply (clarsimp simp: valid_ntfn'_def invs'_def valid_state'_def valid_pspace'_def sch_act_wf_weak)
    \<comment> \<open>WaitingNtfn\<close>
-   apply (clarsimp simp: ntfn_relation_def Let_def update_waiting_ntfn_def)
+   apply (clarsimp simp add: ntfn_relation_def Let_def)
+   apply (simp add: update_waiting_ntfn_def)
    apply (rename_tac list)
+   apply (case_tac "tl list = []")
+    \<comment> \<open>tl list = []\<close>
+    apply (rule corres_guard_imp)
+      apply (rule_tac F="list \<noteq> []" in corres_gen_asm)
+      apply (simp add: list_case_helper split del: if_split)
+      apply (rule corres_split[OF setNotification_corres])
+         apply (simp add: ntfn_relation_def)
+        apply (rule corres_split[OF setThreadState_corres])
+           apply simp
+          apply (simp add: badgeRegister_def badge_register_def)
+          apply (rule corres_split[OF asUser_setRegister_corres])
+            apply (rule possibleSwitchTo_corres)
+           apply ((wp | simp)+)[1]
+          apply (rule_tac Q'="\<lambda>_. (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
+                                 cur_tcb' and
+                                 st_tcb_at' runnable' (hd list) and valid_objs' and
+                                 sym_heap_sched_pointers and valid_sched_pointers and
+                                 pspace_aligned' and pspace_distinct'"
+                   in hoare_post_imp, clarsimp simp: pred_tcb_at' elim!: sch_act_wf_weak)
+          apply (wp | simp)+
+         apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action
+              | simp)+
+        apply (wp sts_st_tcb_at'_cases sts_valid_objs' setThreadState_st_tcb
+             | simp)+
+      apply (wp set_simple_ko_valid_objs set_ntfn_aligned' set_ntfn_valid_objs'
+                hoare_vcg_disj_lift weak_sch_act_wf_lift_linear
+           | simp add: valid_tcb_state_def valid_tcb_state'_def)+
+     apply (fastforce simp: invs_def valid_state_def valid_ntfn_def
+                            valid_pspace_def ntfn_queued_st_tcb_at valid_sched_def
+                            valid_sched_action_def)
+    apply (auto simp: valid_ntfn'_def )[1]
+    apply (clarsimp simp: invs'_def valid_state'_def)
+
+   \<comment> \<open>tl list \<noteq> []\<close>
    apply (rule corres_guard_imp)
      apply (rule_tac F="list \<noteq> []" in corres_gen_asm)
-     apply (simp add: list_case_helper split del: if_split)
+     apply (simp add: list_case_helper)
      apply (rule corres_split[OF setNotification_corres])
-        apply (clarsimp simp: ntfn_relation_def split: list.splits)
+        apply (simp add: ntfn_relation_def split:list.splits)
        apply (rule corres_split[OF setThreadState_corres])
-          apply clarsimp
+          apply simp
          apply (simp add: badgeRegister_def badge_register_def)
          apply (rule corres_split[OF asUser_setRegister_corres])
-           apply (rule corres_split[OF maybeDonateSc_corres])
-             apply (rule corres_split[OF isSchedulable_corres])
-               apply (rule corres_split[OF corres_when], simp)
-                  apply (rule possibleSwitchTo_corres; (solves simp)?)
-                 apply (rule corres_split_eqr[OF get_tcb_obj_ref_corres])
-                    apply (clarsimp simp: tcb_relation_def)
-                   apply (rule ifCondRefillUnblockCheck_corres)
-                  apply (wpsimp wp: get_tcb_obj_ref_wp)
-                 apply (wpsimp wp: threadGet_wp)
-                apply (rule_tac Q'="\<lambda>_. tcb_at (hd list) and active_scs_valid and pspace_aligned
-                                       and pspace_distinct and valid_objs"
-                       in hoare_strengthen_post[rotated])
-                 apply (clarsimp, drule (1) valid_objs_ko_at)
-                 apply (fastforce simp: valid_tcb_def obj_at_def is_sc_obj opt_map_def opt_pred_def
-                                        valid_obj_def
-                                 split: option.split)
-                apply wpsimp
-               apply (rule_tac Q'="\<lambda>_. tcb_at' (hd list) and valid_objs'" in hoare_strengthen_post[rotated])
-                apply (clarsimp simp: obj_at'_def split: option.split)
-               apply wpsimp
-              apply (wpsimp wp: is_schedulable_wp)
-             apply (wpsimp wp: isSchedulable_wp)
-            apply (wpsimp wp: hoare_drop_imp maybe_donate_sc_valid_sched_action abs_typ_at_lifts
-                 | strengthen valid_objs_valid_tcbs)+
-           apply(wpsimp wp: hoare_drop_imp | strengthen valid_objs'_valid_tcbs')+
-        apply (strengthen valid_sched_action_weak_valid_sched_action)
-        apply (wpsimp simp: invs_def valid_state_def valid_pspace_def
-                        wp: sts_valid_replies sts_only_idle sts_fault_tcbs_valid_states
-                            set_thread_state_valid_sched_action
-                            set_thread_state_valid_ready_qs set_thread_state_valid_release_q)
-       apply (wpsimp wp: sts_invs')
-      apply (clarsimp cong: conj_cong, wpsimp)
-     apply (clarsimp cong: conj_cong, wpsimp wp: set_ntfn_minor_invs' hoare_vcg_all_lift hoare_vcg_imp_lift)
-    apply (clarsimp cong: conj_cong)
-    apply (frule valid_objs_ko_at[rotated], clarsimp)
-    apply (clarsimp simp: valid_obj_def valid_ntfn_def invs_def valid_state_def valid_pspace_def
-                          valid_sched_def obj_at_def)
-    apply (frule valid_objs_valid_tcbs, simp)
-    apply (frule (3) st_in_waitingntfn)
-    apply (subgoal_tac "hd list \<noteq> ep", simp)
-     apply (rule conjI)
-      apply (clarsimp split: list.splits option.splits)
-      apply (case_tac list; fastforce)
-     apply (prop_tac "ex_nonz_cap_to (hd list) s")
-      apply (frule (4) ex_nonz_cap_to_tcb_in_waitingntfn, fastforce)
-     apply (drule_tac x="hd list" in bspec, simp)+
-     apply clarsimp
-     apply (rule conjI)
-      apply (erule delta_sym_refs_remove_only[where tp=TCBSignal], clarsimp)
-       apply (rule subset_antisym, clarsimp)
-       apply (clarsimp simp: state_refs_of_def is_tcb get_refs_def tcb_st_refs_of_def pred_tcb_at_def
-                             obj_at_def)
-       apply (force split: option.splits)
-      apply (rule subset_antisym)
-       apply (clarsimp simp: subset_remove ntfn_q_refs_of_def get_refs_def tcb_st_refs_of_def pred_tcb_at_def
-                             obj_at_def state_refs_of_def)
-       apply (clarsimp split: list.splits option.splits)
-       apply (case_tac list; fastforce)
-      apply (clarsimp simp: subset_remove ntfn_q_refs_of_def get_refs_def tcb_st_refs_of_def pred_tcb_at_def
-                            obj_at_def state_refs_of_def)
-      apply (clarsimp split: list.splits)
-      apply (case_tac list; fastforce)
-     apply (rule valid_sched_scheduler_act_not_better, clarsimp simp: valid_sched_def)
-     apply (clarsimp simp: st_tcb_at_def obj_at_def pred_neg_def)
-    apply (clarsimp simp: st_tcb_at_def obj_at_def)
-    apply (drule_tac x="hd list" in bspec; clarsimp)+
-   apply (clarsimp simp: invs'_def valid_pspace'_def valid_tcb_state'_def
-                   cong: conj_cong)
-   apply (frule_tac t="hd list" in thread_state_tcb_in_WaitingNtfn'_q; assumption?)
-    apply (clarsimp simp: valid_ntfn'_def)
-   apply (intro conjI)
-     apply clarsimp
-    apply (clarsimp simp: valid_ntfn'_def)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def is_BlockedOnNotification_def)
-   apply (clarsimp simp: valid_ntfn'_def split: list.splits)
-   apply (intro conjI impI)
-       apply (metis hd_Cons_tl list.set_intros(1) list.set_intros(2))
-      apply (metis hd_Cons_tl list.set_intros(2))
-     using distinct_tl apply fastforce
-    using distinct_tl apply fastforce
-   apply (case_tac list; clarsimp simp: valid_ntfn'_def split: list.splits option.splits)
+           apply (rule possibleSwitchTo_corres)
+          apply (wp cur_tcb_lift | simp)+
+        apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action
+             | simp)+
+       apply (wpsimp wp: sts_st_tcb_at'_cases sts_valid_objs' setThreadState_st_tcb)
+     apply (wp set_ntfn_aligned' set_simple_ko_valid_objs set_ntfn_valid_objs'
+               hoare_vcg_disj_lift weak_sch_act_wf_lift_linear
+          | simp add: valid_tcb_state_def valid_tcb_state'_def)+
+    apply (fastforce simp: invs_def valid_state_def valid_ntfn_def
+                           valid_pspace_def neq_Nil_conv
+                           ntfn_queued_st_tcb_at valid_sched_def valid_sched_action_def
+                    split: option.splits)
+   apply (auto simp: valid_ntfn'_def neq_Nil_conv invs'_def valid_state'_def
+                     weak_sch_act_wf_def
+              split: option.splits)[1]
   \<comment> \<open>ActiveNtfn\<close>
-  apply (clarsimp simp add: ntfn_relation_def Let_def)
+  apply (clarsimp simp add: ntfn_relation_def)
   apply (rule corres_guard_imp)
     apply (rule setNotification_corres)
-    apply (clarsimp simp: ntfn_relation_def combine_ntfn_badges_def)+
+    apply (simp add: ntfn_relation_def combine_ntfn_badges_def
+                     combine_ntfn_msgs_def)
+   apply (simp add: invs_def valid_state_def valid_ntfn_def)
+  apply (simp add: invs'_def valid_state'_def valid_ntfn'_def)
   done
 
-lemma possibleSwitchTo_ksQ':
-  "\<lbrace>\<lambda>s. t' \<notin> set (ksReadyQueues s p) \<and> sch_act_not t' s \<and> t' \<noteq> t\<rbrace>
+lemma valid_Running'[simp]:
+  "valid_tcb_state' Running = \<top>"
+  by (rule ext, simp add: valid_tcb_state'_def)
+
+crunch setMRs
+  for typ'[wp]: "\<lambda>s. P (typ_at' T p s)"
+   (wp: crunch_wps simp: zipWithM_x_mapM)
+
+lemma possibleSwitchTo_sch_act[wp]:
+  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and> st_tcb_at' runnable' t s\<rbrace>
      possibleSwitchTo t
-   \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs inReleaseQueue_def)
-  apply (wp hoare_weak_lift_imp rescheduleRequired_ksQ' tcbSchedEnqueue_ksQ threadGet_wp
-         | wpc
-         | simp split del: if_split)+
-  apply (auto simp: obj_at'_def)
+   \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: possibleSwitchTo_def curDomain_def bitmap_fun_defs)
+  apply (wp hoare_weak_lift_imp threadSet_sch_act setQueue_sch_act threadGet_wp
+       | simp add: unless_def | wpc)+
+  apply (auto simp: obj_at'_def projectKOs tcb_in_cur_domain'_def)
   done
 
+crunch possibleSwitchTo
+  for st_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
+  (wp: crunch_wps)
+
+crunch possibleSwitchTo
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
+  (wp: crunch_wps)
+crunch possibleSwitchTo
+  for objs'[wp]: valid_objs'
+  (wp: crunch_wps)
+crunch possibleSwitchTo
+  for ct[wp]: cur_tcb'
+  (wp: cur_tcb_lift crunch_wps)
+
 lemma possibleSwitchTo_iflive[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' t
-           and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-     possibleSwitchTo t
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: possibleSwitchTo_def curDomain_def inReleaseQueue_def)
-  apply wpsimp
+  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' t and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
+    and pspace_aligned' and pspace_distinct'\<rbrace>
+   possibleSwitchTo t
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  apply (simp add: possibleSwitchTo_def curDomain_def)
+  apply (wp | wpc | simp)+
       apply (simp only: imp_conv_disj, wp hoare_vcg_all_lift hoare_vcg_disj_lift)
     apply (wp threadGet_wp)+
-  by (fastforce simp: obj_at'_def projectKOs)
+  apply (auto simp: obj_at'_def)
+  done
 
-lemma replyRemoveTCB_irqs_masked'[wp]:
-  "replyRemoveTCB t \<lbrace> irqs_masked' \<rbrace>"
-  unfolding replyRemoveTCB_def
-  by (wpsimp wp: hoare_drop_imps gts_wp'|rule conjI)+
+crunch possibleSwitchTo
+  for ifunsafe[wp]: if_unsafe_then_cap'
+  and idle'[wp]: valid_idle'
+  and global_refs'[wp]: valid_global_refs'
+  and arch_state'[wp]: valid_arch_state'
+  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  and irq_handlers'[wp]: valid_irq_handlers'
+  and irq_states'[wp]: valid_irq_states'
+  and pde_mappigns'[wp]: valid_pde_mappings'
+  (wp: crunch_wps simp: unless_def tcb_cte_cases_def)
 
-crunch sendSignal, refillUnblockCheck
+crunch sendSignal
   for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
   and it'[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and irqs_masked'[wp]: "irqs_masked'"
   (wp: crunch_wps simp: crunch_simps o_def)
 
+context
+notes option.case_cong_weak[cong]
+begin
+crunch sendSignal, setBoundNotification
+  for irqs_masked'[wp]: "irqs_masked'"
+  (wp: crunch_wps getObject_inv loadObject_default_inv
+   simp: crunch_simps unless_def o_def
+   rule: irqs_masked_lift)
+end
+
 lemma ct_in_state_activatable_imp_simple'[simp]:
   "ct_in_state' activatable' s \<Longrightarrow> ct_in_state' simple' s"
   apply (simp add: ct_in_state'_def)
@@ -3640,44 +2791,100 @@ lemma ct_in_state_activatable_imp_simple'[simp]:
 
 lemma setThreadState_nonqueued_state_update:
   "\<lbrace>\<lambda>s. invs' s \<and> st_tcb_at' simple' t s
-               \<and> simple' st
-               \<and> (st \<noteq> Inactive \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
-  setThreadState st t \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
-  apply (rule hoare_pre, wp valid_irq_node_lift
-                            sts_valid_queues)
-  apply (clarsimp simp: pred_tcb_at' pred_tcb_at'_eq_commute)
+               \<and> st \<in> {Inactive, Running, Restart, IdleThreadState}
+               \<and> (st \<noteq> Inactive \<longrightarrow> ex_nonz_cap_to' t s)
+               \<and> (t = ksIdleThread s \<longrightarrow> idle' st)
+               \<and> (\<not> runnable' st \<longrightarrow> sch_act_simple s)\<rbrace>
+   setThreadState st t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def)
+  apply (rule hoare_pre, wp valid_irq_node_lift setThreadState_ct_not_inQ)
+  apply (clarsimp simp: pred_tcb_at')
   apply (rule conjI, fastforce simp: valid_tcb_state'_def)
-  apply (clarsimp simp: list_refs_of_replies'_def o_def pred_tcb_at'_def obj_at'_def)
+  apply (drule simple_st_tcb_at_state_refs_ofD')
+  apply (drule bound_tcb_at_state_refs_ofD')
+  apply (rule conjI)
+   apply clarsimp
+   apply (erule delta_sym_refs)
+    apply (fastforce split: if_split_asm)
+   apply (fastforce simp: symreftype_inverse' tcb_bound_refs'_def split: if_split_asm)
+  apply fastforce
   done
 
-crunch possibleSwitchTo, asUser, doIPCTransfer
+lemma cteDeleteOne_reply_cap_to'[wp]:
+  "\<lbrace>ex_nonz_cap_to' p and
+    cte_wp_at' (\<lambda>c. isReplyCap (cteCap c)) slot\<rbrace>
+   cteDeleteOne slot
+   \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
+  apply (simp add: cteDeleteOne_def ex_nonz_cap_to'_def unless_def)
+  apply (rule bind_wp [OF _ getCTE_sp])
+  apply (rule hoare_assume_pre)
+  apply (subgoal_tac "isReplyCap (cteCap cte)")
+   apply (wp hoare_vcg_ex_lift emptySlot_cte_wp_cap_other isFinalCapability_inv
+        | clarsimp simp: finaliseCap_def isCap_simps | simp
+        | wp (once) hoare_drop_imps)+
+   apply (fastforce simp: cte_wp_at_ctes_of)
+  apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
+  done
+
+crunch setupCallerCap, possibleSwitchTo, asUser, doIPCTransfer
   for vms'[wp]: "valid_machine_state'"
   (wp: crunch_wps simp: zipWithM_x_mapM_x)
 
-crunch activateIdleThread, isFinalCapability
+crunch cancelSignal
+  for nonz_cap_to'[wp]: "ex_nonz_cap_to' p"
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma cancelIPC_nonz_cap_to'[wp]:
+  "\<lbrace>ex_nonz_cap_to' p\<rbrace> cancelIPC t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
+  apply (simp add: cancelIPC_def getThreadReplySlot_def Let_def
+                   capHasProperty_def)
+  apply (wp threadSet_cap_to'
+       | wpc
+       | simp
+       | clarsimp elim!: cte_wp_at_weakenE'
+       | rule hoare_post_imp[where Q'="\<lambda>rv. ex_nonz_cap_to' p"])+
+  done
+
+
+crunch activateIdleThread, getThreadReplySlot, isFinalCapability
   for nosch[wp]:  "\<lambda>s. P (ksSchedulerAction s)"
   (ignore: setNextPC simp: Let_def)
 
-crunch asUser, setMRs, doIPCTransfer, possibleSwitchTo
+crunch setupCallerCap, asUser, setMRs, doIPCTransfer, possibleSwitchTo
   for pspace_domain_valid[wp]: "pspace_domain_valid"
   (wp: crunch_wps simp: zipWithM_x_mapM_x)
 
-crunch doIPCTransfer, possibleSwitchTo
+crunch setupCallerCap, doIPCTransfer, possibleSwitchTo
   for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
   (wp: crunch_wps simp: zipWithM_x_mapM)
 
 lemma setThreadState_not_rct[wp]:
-  "setThreadState st t
-   \<lbrace>\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
-  by (wpsimp wp: setThreadState_def)
+  "\<lbrace>\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>
+   setThreadState st t
+   \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
+  apply (simp add: setThreadState_def)
+  apply (wp)
+       apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
+      apply (simp)
+      apply (wp)+
+  apply simp
+  done
 
 lemma cancelAllIPC_not_rct[wp]:
   "\<lbrace>\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>
    cancelAllIPC epptr
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllIPC_def)
-  apply (wpsimp wp: getEndpoint_wp)
+  apply (wp | wpc)+
+         apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
+        apply simp
+        apply (rule mapM_x_wp_inv)
+        apply (wp)+
+       apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
+      apply simp
+      apply (rule mapM_x_wp_inv)
+      apply (wpsimp wp: hoare_vcg_all_lift hoare_drop_imp)+
   done
 
 lemma cancelAllSignals_not_rct[wp]:
@@ -3685,327 +2892,170 @@ lemma cancelAllSignals_not_rct[wp]:
    cancelAllSignals epptr
    \<lbrace>\<lambda>_ s. ksSchedulerAction s \<noteq> ResumeCurrentThread \<rbrace>"
   apply (simp add: cancelAllSignals_def)
-  apply (wpsimp wp: getNotification_wp)
+  apply (wp | wpc)+
+       apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp)
+      apply simp
+      apply (rule mapM_x_wp_inv)
+      apply (wpsimp wp: hoare_vcg_all_lift hoare_drop_imp)+
   done
 
 crunch finaliseCapTrue_standin
   for not_rct[wp]: "\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread"
-  (simp: crunch_simps wp: crunch_wps)
+(simp: Let_def)
 
-crunch cleanReply
-  for schedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  (simp: crunch_simps)
+declare setEndpoint_ct' [wp]
 
-lemma replyUnlink_ResumeCurrentThread_imp_notct[wp]:
+lemma cancelIPC_ResumeCurrentThread_imp_notct[wp]:
   "\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
-   replyUnlink a b
-   \<lbrace>\<lambda>_ s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
-  apply (clarsimp simp: replyUnlink_def updateReply_def)
-  apply (wpsimp wp: set_reply'.set_wp gts_wp')
-  done
-
-lemma replyRemoveTCB_ResumeCurrentThread_imp_notct[wp]:
-  "\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
-   replyRemoveTCB tptr
+   cancelIPC t
    \<lbrace>\<lambda>_ s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
-  apply (clarsimp simp: replyRemoveTCB_def)
-  apply (rule bind_wp_fwd_skip, solves \<open>wpsimp wp: getEndpoint_wp\<close>)+
-  apply (rule bind_wp_fwd_skip)
-   apply (clarsimp simp: when_def)
-   apply (intro conjI impI)
-    apply (wpsimp wp: set_sc'.set_wp set_reply'.set_wp hoare_vcg_imp_lift')+
-  done
-
-lemma cancelSignal_ResumeCurrentThread_imp_notct[wp]:
-  "cancelSignal t ntfn \<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
   (is "\<lbrace>?PRE t'\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (simp add: cancelSignal_def)
-  apply wp[1]
-       apply (wp hoare_convert_imp)+
-       apply (rule_tac P="\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread"
-                       in hoare_weaken_pre)
-        apply (wpc)
-         apply (wp | simp)+
+proof -
+  have aipc: "\<And>t t' ntfn.
+    \<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
+    cancelSignal t ntfn
+    \<lbrace>\<lambda>_ s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
+    apply (simp add: cancelSignal_def)
+    apply (wp)[1]
+        apply (wp hoare_convert_imp)+
+        apply (rule_tac P="\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread"
+                 in hoare_weaken_pre)
+          apply (wpc)
+           apply (wp | simp)+
+       apply (wpc, wp+)
+     apply (rule_tac Q'="\<lambda>_. ?PRE t'" in hoare_post_imp, clarsimp)
+     apply (wp)
+    apply simp
+    done
+  have cdo: "\<And>t t' slot.
+    \<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
+    cteDeleteOne slot
+    \<lbrace>\<lambda>_ s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
+    apply (simp add: cteDeleteOne_def unless_def split_def)
+    apply (wp)
+        apply (wp hoare_convert_imp)[1]
+       apply (wp)
+      apply (rule_tac Q'="\<lambda>_. ?PRE t'" in hoare_post_imp, clarsimp)
+      apply (wp hoare_convert_imp | simp)+
+     done
+  show ?thesis
+  apply (simp add: cancelIPC_def Let_def)
+  apply (wp, wpc)
+          prefer 4 \<comment> \<open>state = Running\<close>
+          apply wp
+         prefer 7 \<comment> \<open>state = Restart\<close>
+         apply wp
+        apply (wp)+
+           apply (wp hoare_convert_imp)[1]
+          apply (wpc, wp+)
+        apply (rule_tac Q'="\<lambda>_. ?PRE t'" in hoare_post_imp, clarsimp)
+        apply (wp cdo)+
+         apply (rule_tac Q'="\<lambda>_. ?PRE t'" in hoare_post_imp, clarsimp)
+         apply ((wp aipc hoare_convert_imp)+)[6]
+    apply (wp)
+       apply (wp hoare_convert_imp)[1]
       apply (wpc, wp+)
     apply (rule_tac Q'="\<lambda>_. ?PRE t'" in hoare_post_imp, clarsimp)
-    apply (wpsimp wp: stateAssert_wp)+
-  done
-
-lemma blockedCancelIPC_ResumeCurrentThread_imp_notct[wp]:
-  "blockedCancelIPC a b c \<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
-  unfolding blockedCancelIPC_def getBlockingObject_def
-  apply (wpsimp wp: hoare_vcg_imp_lift' getEndpoint_wp)
-  done
-
-crunch cancelIPC
-  for ResumeCurrentThread_imp_notct[wp]: "\<lambda>s. ksSchedulerAction s = ResumeCurrentThread
-                                          \<longrightarrow> ksCurThread s \<noteq> t"
-
-lemma tcbEPFindIndex_wp:
-  "\<lbrace>\<lambda>s. (\<forall>i j. 0 \<le> i \<and> i \<le> Suc sz \<longrightarrow>
-               (\<forall>tcb tcba. ko_at' tcb tptr s \<and> ko_at' tcba (queue ! j) s \<longrightarrow>
-                           (Suc j = i \<longrightarrow> tcbPriority tcba \<ge> tcbPriority tcb) \<longrightarrow>
-                           (i < j \<and> j \<le> sz \<longrightarrow> tcbPriority tcba < tcbPriority tcb) \<longrightarrow> Q i s))\<rbrace>
-   tcbEPFindIndex tptr queue sz \<lbrace>Q\<rbrace>"
-  apply (induct sz; subst tcbEPFindIndex.simps)
-   apply (wpsimp wp: threadGet_wp)
-   apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb)
-  apply (wpsimp wp: threadGet_wp | assumption)+
-  apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb)
-  done
-
-crunch tcbEPAppend, tcbEPDequeue
-  for inv[wp]: P
-
-lemma tcbEPAppend_rv_wf:
-  "\<lbrace>\<top>\<rbrace> tcbEPAppend t q \<lbrace>\<lambda>rv s. set rv = set (t#q)\<rbrace>"
-  apply (simp only: tcbEPAppend_def)
-  apply (wp tcbEPFindIndex_wp)
-  apply (auto simp: null_def set_append[symmetric])
-  done
-
-lemma tcbEPAppend_rv_wf':
-  "\<lbrace>P (set (t#q))\<rbrace> tcbEPAppend t q \<lbrace>\<lambda>rv. P (set rv)\<rbrace>"
-  apply (clarsimp simp: valid_def)
-  apply (frule use_valid[OF _ tcbEPAppend_rv_wf], simp, simp)
-  apply (frule use_valid[OF _ tcbEPAppend_inv, where P = "P (set (t#q))"], simp+)
-  done
-
-lemma tcbEPAppend_rv_wf'':
-  "\<lbrace>P (ep_q_refs_of' (updateEpQueue ep (t#q))) and K (ep \<noteq> IdleEP)\<rbrace>
-   tcbEPAppend t q
-   \<lbrace>\<lambda>rv. P (ep_q_refs_of' (updateEpQueue ep rv))\<rbrace>"
-  by (cases ep; wpsimp wp: tcbEPAppend_rv_wf' simp: updateEpQueue_def)
-
-lemma tcbEPDequeue_rv_wf:
-  "\<lbrace>\<lambda>_. t \<in> set q \<and> distinct q\<rbrace> tcbEPDequeue t q \<lbrace>\<lambda>rv s. set rv = set q - {t}\<rbrace>"
-  apply (wpsimp simp: tcbEPDequeue_def)
-  apply (fastforce dest: findIndex_member)
-  done
-
-lemma tcbEPDequeue_rv_wf':
-  "\<lbrace>P (set q - {t}) and K (t \<in> set q \<and> distinct q)\<rbrace> tcbEPDequeue t q \<lbrace>\<lambda>rv. P (set rv)\<rbrace>"
-  apply (clarsimp simp: valid_def)
-  apply (frule use_valid[OF _ tcbEPDequeue_rv_wf], simp, simp)
-  apply (frule use_valid[OF _ tcbEPDequeue_inv, where P = "P (set q - {t})"], simp+)
-  done
-
-lemma tcbEPDequeue_rv_wf'':
-  "\<lbrace>P (ep_q_refs_of' (updateEpQueue ep q)) and K (t \<in> set q \<and> distinct q \<and> ep \<noteq> IdleEP)\<rbrace>
-   tcbEPDequeue t q
-   \<lbrace>\<lambda>rv. P (ep_q_refs_of' (updateEpQueue ep (t#rv)))\<rbrace>"
-  by (cases ep; wpsimp wp: tcbEPDequeue_rv_wf' simp: Times_Diff_distrib1 insert_absorb updateEpQueue_def)
-
-lemma tcbEPAppend_not_null[wp]:
-  "\<lbrace>\<top>\<rbrace> tcbEPAppend t q \<lbrace>\<lambda>rv _. rv \<noteq> []\<rbrace>"
-  by (wpsimp simp: tcbEPAppend_def split_del: if_split)
-
-lemma tcbEPAppend_distinct[wp]:
-  "\<lbrace>\<lambda>s. distinct q \<and> t \<notin> set q\<rbrace> tcbEPAppend t q \<lbrace>\<lambda>q' s. distinct q'\<rbrace>"
-  apply (simp only: tcbEPAppend_def)
-  apply (wpsimp wp: tcbEPFindIndex_wp)
-  apply (auto simp: set_take_disj_set_drop_if_distinct dest: in_set_dropD in_set_takeD)
-  done
-
-lemma tcbEPAppend_valid_SendEP:
-  "\<lbrace>valid_ep' (SendEP (t#q)) and K (t \<notin> set q)\<rbrace> tcbEPAppend t q \<lbrace>\<lambda>q'. valid_ep' (SendEP q')\<rbrace>"
-  apply (simp only: tcbEPAppend_def)
-  apply (case_tac q; wpsimp wp: tcbEPFindIndex_wp)
-  apply (fastforce simp: valid_ep'_def set_take_disj_set_drop_if_distinct
-                   dest: in_set_takeD in_set_dropD)
-  done
-
-lemma tcbEPAppend_valid_RecvEP:
-  "\<lbrace>valid_ep' (RecvEP (t#q)) and K (t \<notin> set q)\<rbrace> tcbEPAppend t q \<lbrace>\<lambda>q'. valid_ep' (RecvEP q')\<rbrace>"
-  apply (simp only: tcbEPAppend_def)
-  apply (case_tac q; wpsimp wp: tcbEPFindIndex_wp)
-  apply (fastforce simp: valid_ep'_def set_take_disj_set_drop_if_distinct
-                   dest: in_set_takeD in_set_dropD)
-  done
-
-lemma tcbEPAppend_valid_ep':
-  "\<lbrace>valid_ep' (updateEpQueue ep (t#q)) and K (ep \<noteq> IdleEP \<and> t \<notin> set q)\<rbrace>
-   tcbEPAppend t q
-   \<lbrace>\<lambda>q'. valid_ep' (updateEpQueue ep q')\<rbrace>"
-  by (cases ep) (wpsimp wp: tcbEPAppend_valid_SendEP tcbEPAppend_valid_RecvEP simp: updateEpQueue_def)+
-
-lemma tcbEPDequeue_valid_SendEP:
-  "\<lbrace>valid_ep' (SendEP q) and K (t \<in> set q)\<rbrace> tcbEPDequeue t q \<lbrace>\<lambda>q'. valid_ep' (SendEP (t#q'))\<rbrace>"
-  apply (wpsimp simp: tcbEPDequeue_def valid_ep'_def)
-  apply (fastforce simp: findIndex_def findIndex'_app
-                   dest: in_set_takeD in_set_dropD findIndex_member)
-  done
-
-lemma tcbEPDequeue_valid_RecvEP:
-  "\<lbrace>valid_ep' (RecvEP q) and K (t \<in> set q)\<rbrace> tcbEPDequeue t q \<lbrace>\<lambda>q'. valid_ep' (RecvEP (t#q'))\<rbrace>"
-  apply (wpsimp simp: tcbEPDequeue_def valid_ep'_def)
-  apply (fastforce simp: findIndex_def findIndex'_app
-                   dest: in_set_takeD in_set_dropD findIndex_member)
-  done
-
-lemma tcbEPDequeue_valid_ep':
-  "\<lbrace>valid_ep' (updateEpQueue ep q) and K (ep \<noteq> IdleEP \<and> t \<in> set q)\<rbrace>
-   tcbEPDequeue t q
-   \<lbrace>\<lambda>q'. valid_ep' (updateEpQueue ep (t#q'))\<rbrace>"
-  by (cases ep) (wpsimp wp: tcbEPDequeue_valid_SendEP tcbEPDequeue_valid_RecvEP simp: updateEpQueue_def)+
-
-crunch doIPCTransfer
-  for urz[wp]: "untyped_ranges_zero'"
-  (ignore: threadSet wp: threadSet_urz crunch_wps simp: zipWithM_x_mapM)
-
-crunch receiveIPC
-  for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  (wp: crunch_wps transferCapsToSlots_pres1 hoare_vcg_all_lift
-   simp: crunch_simps zipWithM_x_mapM ignore: constOnFailure)
-
-lemmas possibleSwitchToTo_cteCaps_of[wp]
-    = cteCaps_of_ctes_of_lift[OF possibleSwitchTo_ctes_of]
-
-lemma setThreadState_Running_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> tcb_at' t s \<and> ex_nonz_cap_to' t s
-        \<and> st_tcb_at' (Not \<circ> is_BlockedOnReply) t s\<rbrace>
-   setThreadState Running t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (wpsimp wp: sts_invs')
-  apply (simp add: invs'_def valid_dom_schedule'_def pred_tcb_at'_eq_commute)
-  apply (fastforce dest: global'_no_ex_cap
-                   simp: o_def pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma setThreadState_BlockedOnReceive_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> tcb_at' t s \<and> ep_at' eptr s \<and> ex_nonz_cap_to' t s \<and>
-        valid_bound_reply' rptr s \<and>
-        st_tcb_at' (Not \<circ> is_BlockedOnReply) t s\<rbrace>
-   setThreadState (BlockedOnReceive eptr cg rptr) t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: sts_sch_act' setThreadState_ct_not_inQ valid_irq_node_lift simp: pred_tcb_at'_eq_commute)
-  apply (clarsimp dest: global'_no_ex_cap
-                  simp: valid_tcb_state'_def comp_def pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma ksReleaseQueue_ksReprogramTimer_update:
-  "ksReleaseQueue_update (\<lambda>_. fv) (ksReprogramTimer_update (\<lambda>_. gv) s) =
-   ksReprogramTimer_update (\<lambda>_. gv) (ksReleaseQueue_update (\<lambda>_. fv) s)"
-  by simp
-
-lemma ksPSpace_ksReprogramTimer_update:
-  "ksPSpace_update (\<lambda>_. fv) (ksReprogramTimer_update (\<lambda>_. gv) s) =
-   ksReprogramTimer_update (\<lambda>_. gv) (ksPSpace_update (\<lambda>_. fv) s)"
-  by simp
-
-lemma tcbReleaseEnqueue_invs'[wp]:
-  "tcbReleaseEnqueue tcb \<lbrace>invs'\<rbrace>"
-  apply (clarsimp simp: getScTime_def getTCBSc_def tcbReleaseEnqueue_def
-                        getReleaseQueue_def setReleaseQueue_def setReprogramTimer_def)
-  apply (clarsimp simp: invs'_def valid_dom_schedule'_def split del: if_split)
-  apply (wp threadSet_valid_pspace'T threadSet_sch_actT_P[where P=False, simplified]
-           threadSet_iflive'T threadSet_ifunsafe'T threadSet_idle'T threadSet_not_inQ
-           valid_irq_node_lift valid_irq_handlers_lift'' threadSet_ct_idle_or_in_cur_domain'
-           threadSet_cur untyped_ranges_zero_lift threadSet_valid_queues threadSet_valid_queues'
-         | rule refl threadSet_wp [THEN hoare_vcg_conj_lift]
-         | clarsimp simp: tcb_cte_cases_def cteCaps_of_def)+
-     apply (clarsimp simp: ksReleaseQueue_ksReprogramTimer_update
-                           ksPSpace_ksReprogramTimer_update if_cancel_eq_True)
-     apply (wpsimp wp: mapM_wp_lift getScTime_wp threadGet_wp)+
-  apply (clarsimp simp: invs'_def comp_def obj_at'_def inQ_def cteCaps_of_def)
-  apply (intro conjI)
-      apply (clarsimp simp: valid_release_queue_def obj_at'_def projectKOs objBitsKO_def)+
-   apply (intro conjI impI; clarsimp)
-       apply (auto split: if_splits elim: ps_clear_domE)[3]
-    apply (drule_tac x=a in spec, drule mp)
-     apply (rule_tac ys=rvs in tup_in_fst_image_set_zipD)
-     apply (clarsimp simp: image_def)
-     apply (rule_tac x="(a,b)" in bexI)
-      apply (auto split: if_splits elim: ps_clear_domE)[3]
-   apply (drule_tac x=a in spec, drule mp)
-    apply (rule_tac ys=rvs in tup_in_fst_image_set_zipD)
-    apply (clarsimp simp: image_def)
-    apply (rule_tac x="(a,b)" in bexI)
-     apply (auto split: if_splits elim: ps_clear_domE)[3]
-  apply (clarsimp simp: valid_release_queue'_def)
-  apply (erule_tac x=t in allE)
-  apply (drule mp)
-   apply (fastforce simp: obj_at'_def projectKO_eq projectKO_tcb objBitsKO_def inQ_def
-                    elim: ps_clear_domE split: if_splits)
-  apply (clarsimp simp: image_def in_set_conv_decomp zip_append1)
-  apply (rule_tac x="hd (drop (length ys) rvs)" in exI)
-  apply (case_tac "drop (length ys) rvs"; fastforce dest: list_all2_lengthD)
-  done
-
-crunch postpone, schedContextResume
-  for invs'[wp]: invs'
-  (wp: crunch_wps)
-
-lemma maybeDonateSc_invs':
-  "\<lbrace>invs' and ex_nonz_cap_to' tptr\<rbrace> maybeDonateSc tptr nptr \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp only: maybeDonateSc_def)
-  apply (wpsimp wp: schedContextDonate_invs' getNotification_wp threadGet_wp)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs sym_refs_asrt_def)
-  apply (rename_tac tcb)
-  apply (rule_tac x=tcb in exI, clarsimp)
-  apply (erule if_live_then_nonz_capE'[OF invs_iflive'])
-  apply (drule_tac ko="ntfn :: notification" for ntfn in sym_refs_ko_atD'[rotated])
-   apply (fastforce simp: obj_at'_def projectKOs)
-  apply (auto simp: refs_of_rev' ko_wp_at'_def live_sc'_def)
+    apply (wp)
+   apply (rule_tac Q'="\<lambda>_. ?PRE t'" in hoare_post_imp, clarsimp)
+   apply (wp)
+  apply simp
   done
+qed
 
-lemma simple'_not_is_BlockedOnReply:
-  "simple' st \<Longrightarrow> \<not> is_BlockedOnReply st"
-  by (clarsimp simp: is_BlockedOnReply_def)
+crunch setMRs
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma sai_invs'[wp]:
   "\<lbrace>invs' and ex_nonz_cap_to' ntfnptr\<rbrace>
-   sendSignal ntfnptr badge
-   \<lbrace>\<lambda>y. invs'\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (simp add: sendSignal_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
+     sendSignal ntfnptr badge \<lbrace>\<lambda>y. invs'\<rbrace>"
+  unfolding sendSignal_def
+  including classic_wp_pre
   apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (rule_tac P'="?pre and ko_at' nTFN ntfnptr and valid_ntfn' nTFN and sym_refs_asrt
-                          and (\<lambda>s. sym_refs (state_refs_of' s))" in hoare_weaken_pre)
-   apply (case_tac "ntfnObj nTFN"; clarsimp)
-     \<comment> \<open>IdleNtfn\<close>
-     apply (case_tac "ntfnBoundTCB nTFN"; clarsimp)
-      apply (wp setNotification_invs')
-      apply (clarsimp simp: valid_ntfn'_def)
-     apply (wp isSchedulable_wp)
-           apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post[rotated])
-            apply (clarsimp simp: isSchedulable_bool_def isSchedulable_bool_runnableE)
-           apply (wpsimp wp: maybeDonateSc_invs' setThreadState_Running_invs'
-                             setNotification_invs' gts_wp' cancelIPC_simple
-                       simp: o_def
-                  | strengthen pred_tcb'_weakenE[mk_strg I _ O],
-                    rule simple'_not_is_BlockedOnReply, assumption)+
-     apply (clarsimp simp: valid_ntfn'_def cong: conj_cong)
-     apply (erule if_live_then_nonz_capE'[OF invs_iflive'])
-     apply (drule_tac ko="ntfn :: notification" for ntfn in sym_refs_ko_atD'[rotated])
-      apply fastforce
-     apply (fastforce simp: refs_of_rev' ko_wp_at'_def)
-    \<comment> \<open>ActiveNtfn\<close>
-    apply (wpsimp wp: setNotification_invs' simp: valid_ntfn'_def)
-   \<comment> \<open>WaitingNtfn\<close>
-   apply (rename_tac list)
-   apply (case_tac list; clarsimp)
-   apply (wp isSchedulable_wp)
-       apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post[rotated])
-        apply (clarsimp simp: isSchedulable_bool_def isSchedulable_bool_runnableE)
-       apply (wp maybeDonateSc_invs' setThreadState_Running_invs' setNotification_invs')+
-   apply (clarsimp cong: conj_cong simp: valid_ntfn'_def)
-   apply (rule conjI)
-    apply (clarsimp split: option.splits list.splits)
-   apply (rule conjI)
-    apply (erule if_live_then_nonz_capE'[OF invs_iflive'])
-    apply (drule_tac ko="ntfn :: notification" for ntfn in sym_refs_ko_atD'[rotated])
-     apply fastforce
-    apply (fastforce simp: refs_of_rev' ko_wp_at'_def)
-   apply (erule (1) thread_state_tcb_in_WaitingNtfn'_q[THEN pred_tcb'_weakenE]; fastforce?)
-  \<comment> \<open>resolve added preconditions\<close>
-  apply (clarsimp simp: sym_refs_asrt_def)
-  apply (erule_tac x=ntfnptr in valid_objsE'[OF invs_valid_objs'])
-   apply (fastforce simp: obj_at'_def projectKOs)
-  apply (fastforce simp: valid_obj'_def valid_ntfn'_def)
-  done
+  apply (case_tac "ntfnObj nTFN", simp_all)
+    prefer 3
+    apply (rename_tac list)
+    apply (case_tac list,
+           simp_all split del: if_split
+                          add: setMessageInfo_def)[1]
+    apply (rule hoare_pre)
+     apply (wp hoare_convert_imp [OF asUser_nosch]
+               hoare_convert_imp [OF setMRs_sch_act])+
+     apply (clarsimp simp:conj_comms)
+     apply (simp add: invs'_def valid_state'_def)
+     apply ((wp valid_irq_node_lift sts_valid_objs' setThreadState_ct_not_inQ
+               set_ntfn_valid_objs' cur_tcb_lift sts_st_tcb'
+               hoare_convert_imp [OF setNotification_nosch]
+           | simp split del: if_split)+)[3]
+
+    apply (intro conjI[rotated];
+      (solves \<open>clarsimp simp: invs'_def valid_state'_def valid_pspace'_def\<close>)?)
+           apply clarsimp
+           apply (clarsimp simp: invs'_def valid_state'_def split del: if_split)
+           apply (drule(1) ct_not_in_ntfnQueue, simp+)
+          apply clarsimp
+          apply (frule ko_at_valid_objs', clarsimp)
+           apply (simp add: projectKOs)
+          apply (clarsimp simp: valid_obj'_def valid_ntfn'_def
+                         split: list.splits)
+         apply (clarsimp simp: invs'_def valid_state'_def)
+         apply (clarsimp simp: st_tcb_at_refs_of_rev' valid_idle'_def pred_tcb_at'_def idle_tcb'_def
+                        dest!: sym_refs_ko_atD' sym_refs_st_tcb_atD' sym_refs_obj_atD'
+                        split: list.splits)
+        apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+        apply (frule(1) ko_at_valid_objs')
+         apply (simp add: projectKOs)
+        apply (clarsimp simp: valid_obj'_def valid_ntfn'_def
+                    split: list.splits option.splits)
+       apply (clarsimp elim!: if_live_then_nonz_capE' simp:invs'_def valid_state'_def)
+       apply (drule(1) sym_refs_ko_atD')
+       apply (clarsimp elim!: ko_wp_at'_weakenE
+                   intro!: refs_of_live')
+      apply (clarsimp split del: if_split)+
+      apply (frule ko_at_valid_objs', clarsimp)
+       apply (simp add: projectKOs)
+      apply (clarsimp simp: valid_obj'_def valid_ntfn'_def split del: if_split)
+      apply (frule invs_sym')
+      apply (drule(1) sym_refs_obj_atD')
+      apply (clarsimp split del: if_split cong: if_cong
+                         simp: st_tcb_at_refs_of_rev' ep_redux_simps' ntfn_bound_refs'_def)
+      apply (frule st_tcb_at_state_refs_ofD')
+      apply (erule delta_sym_refs)
+       apply (fastforce simp: split: if_split_asm)
+      apply (fastforce simp: tcb_bound_refs'_def set_eq_subset symreftype_inverse'
+                      split: if_split_asm)
+     apply (clarsimp simp:invs'_def)
+     apply (frule ko_at_valid_objs')
+       apply (clarsimp simp: valid_pspace'_def valid_state'_def)
+      apply (simp add: projectKOs)
+     apply (clarsimp simp: valid_obj'_def valid_ntfn'_def split del: if_split)
+    apply (clarsimp simp:invs'_def valid_state'_def valid_pspace'_def)
+    apply (frule(1) ko_at_valid_objs')
+     apply (simp add: projectKOs)
+    apply (clarsimp simp: valid_obj'_def valid_ntfn'_def
+                  split: list.splits option.splits)
+   apply (case_tac "ntfnBoundTCB nTFN", simp_all)
+    apply (wp set_ntfn_minor_invs')
+    apply (fastforce simp: valid_ntfn'_def invs'_def valid_state'_def
+                    elim!: obj_at'_weakenE
+                    dest!: global'_no_ex_cap)
+   apply (wp add: hoare_convert_imp [OF asUser_nosch]
+             hoare_convert_imp [OF setMRs_sch_act]
+             setThreadState_nonqueued_state_update sts_st_tcb'
+             del: cancelIPC_simple)
+     apply (clarsimp | wp cancelIPC_ct')+
+    apply (wp set_ntfn_minor_invs' gts_wp' | clarsimp)+
+   apply (frule pred_tcb_at')
+   by (wp set_ntfn_minor_invs'
+        | rule conjI
+        | clarsimp elim!: st_tcb_ex_cap''
+        | fastforce simp: receiveBlocked_def projectKOs pred_tcb_at'_def obj_at'_def
+                   dest!: invs_rct_ct_activatable'
+                   split: thread_state.splits
+        | fastforce simp: invs'_def valid_state'_def receiveBlocked_def projectKOs
+                          valid_obj'_def valid_ntfn'_def
+                   split: thread_state.splits
+                   dest!: global'_no_ex_cap st_tcb_ex_cap'' ko_at_valid_objs')+
 
 lemma replyFromKernel_corres:
   "corres dc (tcb_at t and invs) invs'
@@ -4035,1090 +3085,476 @@ lemma rfk_invs':
 crunch replyFromKernel
   for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
 
-lemma set_tcb_obj_ref_ntfns_of[wp]:
-  "set_tcb_obj_ref f t new \<lbrace>\<lambda>s. P (ntfns_of s)\<rbrace>"
-  by (wpsimp simp: set_tcb_obj_ref_def wp: set_object_wp)
-     (fastforce dest!: get_tcb_SomeD elim!: rsubst[where P=P] simp: opt_map_def
-               split: option.splits Structures_A.kernel_object.splits)+
-
-lemma update_sched_context_ntfns_of[wp]:
-  "update_sched_context f' scp \<lbrace>\<lambda>s. P (ntfns_of s)\<rbrace>"
-  by (wpsimp simp: update_sched_context_def wp: set_object_wp get_object_wp)
-     (fastforce elim!: rsubst[where P=P] simp: opt_map_def obj_at_def
-               split: option.splits Structures_A.kernel_object.splits)+
-
-crunch maybe_donate_sc
-  for ntfn_at[wp]: "ntfn_at ntfnp"
-  and ntfns_of[wp]: "\<lambda>s. P (ntfns_of s)"
-  (simp: crunch_simps wp: crunch_wps set_object_wp ignore: set_tcb_obj_ref)
-
-crunch maybeDonateSc
-  for ntfn_at'[wp]: "ntfn_at' ntfnp"
-  and tcb_at'[wp]: "\<lambda>s. P (tcb_at' tp s)"
-  (simp: crunch_simps wp: crunch_wps)
-
 lemma completeSignal_corres:
-  "corres dc
-      (ntfn_at ntfnptr and tcb_at tcb and valid_objs and pspace_aligned and pspace_distinct
-       and (\<lambda>s. sym_refs (state_refs_of s)) and (\<lambda>s. (Ipc_A.isActive |< ntfns_of s) ntfnptr)
-       and valid_sched and current_time_bounded)
-      (ntfn_at' ntfnptr and tcb_at' tcb and invs' and obj_at' isActive ntfnptr)
-      (complete_signal ntfnptr tcb) (completeSignal ntfnptr tcb)"
+  "corres dc (ntfn_at ntfnptr and tcb_at tcb and pspace_aligned and pspace_distinct and valid_objs
+             \<comment> \<open>and obj_at (\<lambda>ko. ko = Notification ntfn \<and> Ipc_A.isActive ntfn) ntfnptr*\<close> )
+             (ntfn_at' ntfnptr and tcb_at' tcb and valid_pspace' and obj_at' isActive ntfnptr)
+             (complete_signal ntfnptr tcb) (completeSignal ntfnptr tcb)"
   apply (simp add: complete_signal_def completeSignal_def)
   apply (rule corres_guard_imp)
-    apply (rule_tac R'="\<lambda>ntfn. ntfn_at' ntfnptr and tcb_at' tcb and invs'
-                               and valid_ntfn' ntfn and (\<lambda>_. isActive ntfn)"
-           in corres_split[OF getNotification_corres])
+    apply (rule_tac R'="\<lambda>ntfn. ntfn_at' ntfnptr and tcb_at' tcb and valid_pspace'
+                         and valid_ntfn' ntfn and (\<lambda>_. isActive ntfn)"
+                                in corres_split[OF getNotification_corres])
       apply (rule corres_gen_asm2)
       apply (case_tac "ntfn_obj rv")
         apply (clarsimp simp: ntfn_relation_def isActive_def
                        split: ntfn.splits Structures_H.notification.splits)+
       apply (rule corres_guard2_imp)
        apply (simp add: badgeRegister_def badge_register_def)
-       apply (rule corres_split[OF asUser_setRegister_corres])
-         apply (rule corres_split[OF setNotification_corres])
-            apply (clarsimp simp: ntfn_relation_def)
-           apply (rule_tac P="tcb_at tcb and ntfn_at ntfnptr and valid_objs and pspace_aligned
-                              and pspace_distinct and valid_sched
-                              and (\<lambda>s. sym_refs ((state_refs_of s)))"
-                      and P'="tcb_at' tcb and ntfn_at' ntfnptr and valid_objs' and valid_queues
-                              and valid_queues' and valid_release_queue_iff"
-                  in corres_inst)
-           apply (rule corres_guard_imp)
-             apply (rule corres_split[OF maybeDonateSc_corres])
-               apply (rule corres_split_eqr[OF get_tcb_obj_ref_corres])
-                  apply (clarsimp simp: tcb_relation_def)
-                 apply (rule_tac P="bound_sc_tcb_at ((=) sc_opt) tcb and ntfn_at ntfnptr and valid_objs
-                                    and pspace_aligned and pspace_distinct
-                                    and active_scs_valid"
-                            and P'="bound_sc_tcb_at' ((=) sc_opt) tcb and ntfn_at' ntfnptr and valid_objs'"
-                        in corres_inst)
-                 apply (rename_tac sc_opt; case_tac sc_opt;
-                        simp add: maybeM_def liftM_def get_sk_obj_ref_def)
-                 apply (rule corres_guard_imp)
-                   apply (rule corres_split[OF get_sc_corres])
-                     apply (rename_tac scp sc sc')
-                     apply (rule_tac P="sc_at scp and (\<lambda>s. scs_of2 s scp = Some sc) and ntfn_at ntfnptr and active_scs_valid
-                                        and pspace_aligned and pspace_distinct"
-                                and P'="ko_at' sc' scp and ntfn_at' ntfnptr and valid_objs'"
-                            in corres_inst)
-                     apply (rule corres_guard_imp)
-                       apply (rule corres_when2)
-                        apply (clarsimp simp: sc_relation_def active_sc_def)
-                       apply (rule corres_split[OF getNotification_corres])
-                         apply (rule corres_split[OF getCurSc_corres])
-                           apply (rule corres_when2)
-                            apply (clarsimp simp: ntfn_relation_def)
-                           apply (rule refillUnblockCheck_corres)
-                          apply wpsimp
-                         apply wpsimp
-                        apply (wpsimp wp: get_simple_ko_wp)
-                       apply (wpsimp wp: getNotification_wp)
-                      apply (clarsimp simp: obj_at_def is_ntfn)
-                      apply (drule active_scs_validE[rotated])
-                       apply (fastforce simp: vs_all_heap_simps is_sc_obj elim!: opt_mapE)
-                      apply (clarsimp simp: valid_refills_def vs_all_heap_simps rr_valid_refills_def
-                                            opt_pred_def
-                                     elim!: opt_mapE)
-                     apply (clarsimp elim!: opt_mapE)
-                     apply (erule valid_objs'_valid_refills', clarsimp simp: obj_at'_def)
-                     apply (clarsimp dest!: valid_objs'_valid_refills'
-                                      simp: opt_map_red opt_pred_def is_active_sc'_def obj_at'_def projectKOs)
-                    apply wpsimp
-                   apply wpsimp
-                  apply (clarsimp simp: pred_tcb_at_def obj_at_def valid_obj_def valid_tcb_def
-                                 dest!: sym[of "Some _"])
-                  apply (erule (1) valid_objsE[where x=tcb])
-                  apply (clarsimp simp: obj_at_def valid_obj_def valid_tcb_def is_sc_obj opt_map_red)
-                 apply clarsimp
-                 apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def dest!: sym[of "Some _"])
-                 apply (erule (1) valid_objsE'[where x=tcb])
-                 apply (clarsimp simp: obj_at'_def projectKOs valid_obj'_def valid_tcb'_def)
-                apply (wpsimp wp: get_tcb_obj_ref_wp threadGet_wp)
-               apply (wpsimp wp: get_tcb_obj_ref_wp threadGet_wp)
-              apply (rule_tac Q'="\<lambda>_. tcb_at tcb  and ntfn_at ntfnptr and valid_objs
-                                     and pspace_distinct and pspace_aligned and active_scs_valid"
-                     in hoare_strengthen_post[rotated])
-               apply (clarsimp simp: pred_tcb_at_def obj_at_def opt_map_red)
-              apply (wpsimp wp: abs_typ_at_lifts)
-             apply (rule_tac Q'="\<lambda>_. tcb_at' tcb and ntfn_at' ntfnptr and valid_objs'"
-                    in hoare_strengthen_post[rotated])
-              apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-             apply wpsimp
-            apply (clarsimp simp: valid_sched_def obj_at_def is_ntfn valid_sched_action_def
-                                  invs_def valid_state_def valid_pspace_def opt_map_red)
-           apply (clarsimp simp: invs'_def)
-          apply wpsimp
-         apply wpsimp
-        apply (wpsimp simp: valid_ntfn_def)
-       apply (clarsimp simp: live'_def live_ntfn'_def valid_ntfn'_def)
-       apply wpsimp
-      apply (clarsimp simp: live_ntfn'_def valid_ntfn'_def invs'_def valid_pspace'_def)
-     apply (wpsimp wp: get_simple_ko_wp)
-    apply (wpsimp wp: getNotification_wp)
-   apply clarsimp
-   apply (clarsimp simp: valid_sched_def valid_sched_action_def invs_def valid_pspace_def valid_state_def)
-   apply (drule (1) valid_objs_ko_at)
-   apply (clarsimp simp: valid_obj_def valid_ntfn_def fun_upd_def[symmetric])
-   apply (clarsimp simp: state_refs_of_def get_refs_def2 obj_at_def ntfn_q_refs_of_def
-                         Ipc_A.isActive_def fun_upd_idem
-                  dest!: opt_predD split: Structures_A.ntfn.splits
-                  elim!: opt_mapE)
-  apply (clarsimp simp: valid_pspace'_def invs'_def)
-  apply (frule (1) ntfn_ko_at_valid_objs_valid_ntfn')
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  done
-
-lemma ntfn_relation_par_inj:
-  "ntfn_relation ntfn ntfn' \<Longrightarrow> ntfn_sc ntfn = ntfnSc ntfn'"
-  by (simp add: ntfn_relation_def)
-
-lemma thread_set_weak_valid_sched_action2:
-  "\<lbrace>weak_valid_sched_action and scheduler_act_not tptr\<rbrace> thread_set f tptr \<lbrace>\<lambda>rv. weak_valid_sched_action\<rbrace>"
-  apply (wpsimp wp: thread_set_wp simp: obj_at_kh_kheap_simps vs_all_heap_simps fun_upd_def
-                    weak_valid_sched_action_def)
-  apply (clarsimp simp: weak_valid_sched_action_def scheduler_act_not_def)
-  apply (rule_tac x=ref' in exI; clarsimp)
-  done
-
-lemma notQueued_cross_rel:
-  "cross_rel (not_queued t) (notQueued t)"
-  unfolding cross_rel_def state_relation_def
-  by (clarsimp simp: notQueued_def ready_queues_relation_def not_queued_def)
-
-lemma valid_tcb_sched_context_update_empty[elim!]:
-  "valid_tcb tp tcb s \<Longrightarrow> valid_tcb tp (tcb_sched_context_update Map.empty tcb) s"
-  by (auto simp: valid_tcb_def tcb_cap_cases_def)
-
-lemma valid_tcb'_SchedContext_update_empty[elim!]:
-  "valid_tcb' tcb s' \<Longrightarrow> valid_tcb' (tcbSchedContext_update Map.empty tcb) s'"
-  by (auto simp: valid_tcb'_def valid_cap'_def tcb_cte_cases_def)
-
-lemma maybeReturnSc_corres:
-  "corres dc
-   (ntfn_at ntfnPtr and tcb_at thread and valid_tcbs and pspace_aligned
-      and scheduler_act_not thread and active_scs_valid
-      and pspace_distinct and weak_valid_sched_action
-      and not_queued thread and not_in_release_q thread
-      and (\<lambda>s. sym_refs (state_refs_of s)))
-   (valid_tcbs' and valid_queues and valid_queues' and valid_release_queue_iff)
-   (maybe_return_sc ntfnPtr thread)
-   (maybeReturnSc ntfnPtr thread)"
-  unfolding maybe_return_sc_def maybeReturnSc_def
-  apply add_sym_refs
-  apply (rule corres_stateAssert_assume)
-   apply (clarsimp simp: liftM_def get_sk_obj_ref_def get_tcb_obj_ref_def
-                         set_tcb_obj_ref_thread_set)
-   apply (rule stronger_corres_guard_imp)
-     apply (rule corres_split[OF getNotification_corres])
-       apply (frule ntfn_relation_par_inj[symmetric], simp)
-       apply (rule corres_split[OF threadGet_corres[where r="(=)"]])
-          apply (clarsimp simp: tcb_relation_def)
-         apply (rule corres_when2, simp)
-         apply (rule corres_assert_opt_assume_l)
-         apply (rule corres_split[OF threadset_corresT])
-              apply (clarsimp simp: tcb_relation_def)
-             apply (rule ball_tcb_cap_casesI; simp)
-            apply (clarsimp simp: tcb_cte_cases_def)
-           apply (rule_tac Q'="\<top>" in corres_symb_exec_r')
-              apply (rule corres_split)
-                 apply (rule update_sc_no_reply_stack_update_ko_at'_corres
-                             [where f'="scTCB_update (\<lambda>_. None)"])
-                    apply ((clarsimp simp: sc_relation_def objBits_def objBitsKO_def)+)[4]
-                apply (rule corres_split[OF getCurThread_corres])
-                  apply (rule corres_when [OF _ rescheduleRequired_corres], simp)
-                 apply (wpsimp wp: hoare_vcg_imp_lift')+
-          apply (wpsimp wp: hoare_vcg_imp_lift' thread_set_weak_valid_sched_action2)
-         apply (wpsimp wp: hoare_drop_imp threadSet_valid_queues_no_state
-                           threadSet_valid_queues' threadSet_valid_release_queue
-                           threadSet_valid_tcbs'
-                           threadSet_valid_release_queue')
-        apply (wpsimp wp: thread_get_wp threadGet_wp)+
-       apply (frule ntfn_relation_par_inj, simp)
-      apply (wpsimp wp: get_simple_ko_wp getNotification_wp)+
-    apply (rule valid_tcbs_valid_tcbE, simp, simp)
-    apply (clarsimp simp: valid_tcb_def valid_bound_obj_def split: option.splits)
-   apply (rule cross_rel_srE [OF tcb_at'_cross_rel [where t=thread]]; simp)
-   apply (rule cross_rel_srE [OF ntfn_at'_cross_rel [where t=ntfnPtr]], simp)
-   apply (rule cross_rel_srE [OF notQueued_cross_rel [where t=thread]], simp)
-   apply clarsimp
-   apply (subgoal_tac "\<exists>tcb. ko_at' (tcb :: tcb) thread s'", clarsimp)
-    apply (rule_tac x=tcb in exI, clarsimp)
-    apply (clarsimp simp: notQueued_def)
-    apply (clarsimp simp: valid_release_queue'_def inQ_def)
-    apply (intro conjI)
-      apply clarsimp
-     apply (clarsimp simp: obj_at'_def valid_release_queue'_def)
-    apply (subgoal_tac "valid_tcb' tcb s'")
-     apply (clarsimp simp: valid_tcb'_def valid_bound_obj'_def split: option.splits)
-    apply (clarsimp simp: valid_tcbs'_def obj_at'_real_def ko_wp_at'_def projectKO_tcb)
-   apply (clarsimp simp: obj_at'_def)
-  apply (clarsimp simp: sym_refs_asrt_def)
+       apply (rule corres_split[OF asUser_setRegister_corres setNotification_corres])
+         apply (clarsimp simp: ntfn_relation_def)
+        apply (wp set_simple_ko_valid_objs get_simple_ko_wp getNotification_wp | clarsimp simp: valid_ntfn'_def)+
+  apply (clarsimp simp: valid_pspace'_def)
+  apply (frule_tac P="(\<lambda>k. k = ntfn)" in obj_at_valid_objs', assumption)
+  apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def obj_at'_def)
   done
 
-lemma tcbEPDequeue_corres:
-  "qs = qs' \<Longrightarrow> corres (=) \<top> \<top> (tcb_ep_dequeue t qs) (tcbEPDequeue t qs')"
-  by (clarsimp simp: tcb_ep_dequeue_def tcbEPDequeue_def)
 
 lemma doNBRecvFailedTransfer_corres:
-  "corres dc (pspace_aligned and pspace_distinct and tcb_at thread) \<top>
-             (do_nbrecv_failed_transfer thread) (doNBRecvFailedTransfer thread)"
-  apply (rule corres_cross[where Q' = "tcb_at' thread", OF tcb_at'_cross_rel], simp)
-  apply (clarsimp simp: do_nbrecv_failed_transfer_def doNBRecvFailedTransfer_def)
-  apply (rule corres_guard_imp)
-    apply (clarsimp simp: badge_register_def badgeRegister_def)
-    apply (rule asUser_setRegister_corres)
-   apply clarsimp+
-  done
+  "corres dc (tcb_at thread and pspace_aligned and pspace_distinct) \<top>
+             (do_nbrecv_failed_transfer thread)
+             (doNBRecvFailedTransfer thread)"
+  unfolding do_nbrecv_failed_transfer_def doNBRecvFailedTransfer_def
+  by (corres corres: asUser_setRegister_corres
+               simp: badgeRegister_def badge_register_def)+
 
-crunch maybe_return_sc
-  for tcb_at[wp]: "tcb_at thread"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma maybeReturnSc_valid_objs'[wp]:
-  "maybeReturnSc ntfnPtr tcbPtr \<lbrace>valid_objs'\<rbrace>"
-  apply (clarsimp simp: maybeReturnSc_def)
-  apply (wpsimp wp: threadSet_valid_objs' threadGet_wp getNotification_wp
-                    hoare_vcg_all_lift hoare_vcg_imp_lift')
-  apply (clarsimp dest!: ntfn_ko_at_valid_objs_valid_ntfn'
-                   simp: obj_at'_def projectKOs)
-  apply (rename_tac tcb)
-  apply (rule_tac x=tcb in exI)
+lemma receiveIPC_corres:
+  assumes "is_ep_cap cap" and "cap_relation cap cap'"
+  shows "
+   corres dc (einvs and valid_sched and tcb_at thread and valid_cap cap and ex_nonz_cap_to thread
+              and cte_wp_at (\<lambda>c. c = cap.NullCap) (thread, tcb_cnode_index 3))
+             (invs' and tcb_at' thread and valid_cap' cap')
+             (receive_ipc thread cap isBlocking) (receiveIPC thread cap' isBlocking)"
+  apply (insert assms)
+  apply (simp add: receive_ipc_def receiveIPC_def
+              split del: if_split)
+  apply (case_tac cap, simp_all add: isEndpointCap_def)
+  apply (rename_tac word1 word2 right)
   apply clarsimp
-  apply (rename_tac sc sc_ptr)
-  apply (prop_tac "ko_at' sc (the (tcbSchedContext tcb)) s")
-   apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (fastforce dest!: sc_ko_at_valid_objs_valid_sc'
-                    simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF getEndpoint_corres])
+      apply (rule corres_guard_imp)
+        apply (rule corres_split[OF getBoundNotification_corres])
+          apply (rule_tac r'="ntfn_relation" in corres_split)
+             apply (rule corres_option_split[rotated 2])
+               apply (rule getNotification_corres)
+              apply clarsimp
+             apply (rule corres_trivial, simp add: ntfn_relation_def default_notification_def
+                                                   default_ntfn_def)
+            apply (rule corres_if)
+              apply (clarsimp simp: ntfn_relation_def Ipc_A.isActive_def Endpoint_H.isActive_def
+                             split: Structures_A.ntfn.splits Structures_H.notification.splits)
+             apply clarsimp
+             apply (rule completeSignal_corres)
+            apply (rule_tac P="einvs and valid_sched and tcb_at thread and
+                                      ep_at word1 and valid_ep ep and
+                                      obj_at (\<lambda>k. k = Endpoint ep) word1
+                                      and cte_wp_at (\<lambda>c. c = cap.NullCap) (thread, tcb_cnode_index 3)
+                                      and ex_nonz_cap_to thread" and
+                                P'="invs' and tcb_at' thread and ep_at' word1 and
+                                          valid_ep' epa"
+                                in corres_inst)
+            apply (case_tac ep)
+              \<comment> \<open>IdleEP\<close>
+              apply (simp add: ep_relation_def)
+              apply (rule corres_guard_imp)
+                apply (case_tac isBlocking; simp)
+                 apply (rule corres_split[OF setThreadState_corres])
+                    apply simp
+                   apply (rule setEndpoint_corres)
+                   apply (simp add: ep_relation_def)
+                  apply wp+
+                apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp)
+                apply simp
+               apply (clarsimp simp add: invs_def valid_state_def valid_pspace_def
+              valid_tcb_state_def st_tcb_at_tcb_at)
+              apply auto[1]
+             \<comment> \<open>SendEP\<close>
+             apply (simp add: ep_relation_def)
+             apply (rename_tac list)
+             apply (rule_tac F="list \<noteq> []" in corres_req)
+              apply (clarsimp simp: valid_ep_def)
+             apply (case_tac list, simp_all split del: if_split)[1]
+             apply (rule corres_guard_imp)
+               apply (rule corres_split[OF setEndpoint_corres])
+                  apply (case_tac lista, simp_all add: ep_relation_def)[1]
+                 apply (rule corres_split[OF getThreadState_corres])
+                   apply (rule_tac
+                            F="\<exists>data.
+                                sender_state =
+                                Structures_A.thread_state.BlockedOnSend word1 data"
+                            in corres_gen_asm)
+                   apply (clarsimp simp: isSend_def case_bool_If
+                                         case_option_If if3_fold
+                              split del: if_split cong: if_cong)
+                   apply (rule corres_split[OF doIPCTransfer_corres])
+                     apply (simp split del: if_split cong: if_cong)
+                     apply (fold dc_def)[1]
+                     apply (rule_tac P="valid_objs and valid_mdb and valid_list
+                                             and valid_sched
+                                             and cur_tcb
+                                             and valid_reply_caps
+                                             and pspace_aligned and pspace_distinct
+                                             and st_tcb_at (Not \<circ> awaiting_reply) a
+                                             and st_tcb_at (Not \<circ> halted) a
+                                             and tcb_at thread and valid_reply_masters
+                                             and cte_wp_at (\<lambda>c. c = cap.NullCap)
+                                                           (thread, tcb_cnode_index 3)"
+                                 and P'="tcb_at' a and tcb_at' thread and cur_tcb'
+                                                   and valid_pspace'
+                                                   and valid_objs'
+                                             and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
+                                             and sym_heap_sched_pointers and valid_sched_pointers
+                                             and pspace_aligned' and pspace_distinct'"
+                                  in corres_guard_imp [OF corres_if])
+                         apply (simp add: fault_rel_optionation_def)
+                        apply (rule corres_if2 [OF _ setupCallerCap_corres setThreadState_corres])
+                         apply simp
+                        apply simp
+                       apply (rule corres_split[OF setThreadState_corres])
+                          apply simp
+                         apply (rule possibleSwitchTo_corres)
+                        apply (wpsimp wp: sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action)+
+                       apply (wp sts_st_tcb_at'_cases sts_valid_objs' setThreadState_st_tcb
+                            | simp)+
+                      apply (fastforce simp: st_tcb_at_tcb_at st_tcb_def2 valid_sched_def
+                                             valid_sched_action_def)
+                     apply (clarsimp split: if_split_asm)
+                    apply (clarsimp | wp do_ipc_transfer_tcb_caps)+
+                   apply (rule_tac Q'="\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s
+                                            \<and> sym_heap_sched_pointers s \<and> valid_sched_pointers s
+                                            \<and> pspace_aligned' s \<and> pspace_distinct' s"
+                                in hoare_post_imp)
+                    apply (fastforce elim: sch_act_wf_weak)
+                   apply (wp sts_st_tcb' gts_st_tcb_at | simp)+
+                apply (simp cong: list.case_cong)
+                apply wp
+               apply simp
+               apply (wp weak_sch_act_wf_lift_linear setEndpoint_valid_mdb' set_ep_valid_objs')
+              apply (clarsimp split: list.split)
+              apply (clarsimp simp add: invs_def valid_state_def st_tcb_at_tcb_at)
+              apply (clarsimp simp add: valid_ep_def valid_pspace_def)
+              apply (drule(1) sym_refs_obj_atD[where P="\<lambda>ko. ko = Endpoint e" for e])
+              apply (fastforce simp: st_tcb_at_refs_of_rev elim: st_tcb_weakenE)
+             apply (auto simp: valid_ep'_def invs'_def valid_state'_def split: list.split)[1]
+            \<comment> \<open>RecvEP\<close>
+            apply (simp add: ep_relation_def)
+            apply (rule_tac corres_guard_imp)
+              apply (case_tac isBlocking; simp)
+               apply (rule corres_split[OF setThreadState_corres])
+                  apply simp
+                 apply (rule setEndpoint_corres)
+                 apply (simp add: ep_relation_def)
+                apply wp+
+              apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp)
+              apply simp
+             apply (fastforce simp: valid_tcb_state_def)
+            apply (clarsimp simp add: valid_tcb_state'_def)
+           apply (wp get_simple_ko_wp[where f=Notification] getNotification_wp gbn_wp gbn_wp'
+                      hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_if_lift
+                    | wpc | simp add: ep_at_def2[symmetric, simplified] | clarsimp)+
+   apply (fastforce simp: valid_cap_def invs_psp_aligned invs_valid_objs pred_tcb_at_def
+                          valid_obj_def valid_tcb_def valid_bound_ntfn_def
+                   elim!: obj_at_valid_objsE
+                   split: option.splits)
+  apply (auto simp: valid_cap'_def invs_valid_pspace' valid_obj'_def valid_tcb'_def
+                    valid_bound_ntfn'_def obj_at'_def projectKOs pred_tcb_at'_def
+             dest!: invs_valid_objs' obj_at_valid_objs'
+             split: option.splits)
   done
 
-lemma maybeReturnSc_valid_tcbs'[wp]:
-  "maybeReturnSc ntfnPtr tcbPtr \<lbrace>valid_tcbs'\<rbrace>"
-  apply (clarsimp simp: maybeReturnSc_def)
-  apply (wpsimp wp: threadSet_valid_tcbs' threadGet_wp getNotification_wp
-                    hoare_vcg_all_lift hoare_vcg_imp_lift')
-  apply (fastforce simp: obj_at'_def projectKOs)
+lemma receiveSignal_corres:
+ "\<lbrakk> is_ntfn_cap cap; cap_relation cap cap' \<rbrakk> \<Longrightarrow>
+  corres dc (invs and st_tcb_at active thread and valid_cap cap and ex_nonz_cap_to thread)
+            (invs' and tcb_at' thread and valid_cap' cap')
+            (receive_signal thread cap isBlocking) (receiveSignal thread cap' isBlocking)"
+  apply (simp add: receive_signal_def receiveSignal_def)
+  apply (case_tac cap, simp_all add: isEndpointCap_def)
+  apply (rename_tac word1 word2 rights)
+  apply (rule corres_guard_imp)
+    apply (rule_tac R="\<lambda>rv. invs and tcb_at thread and st_tcb_at active thread and
+                            ntfn_at word1 and ex_nonz_cap_to thread and
+                            valid_ntfn rv and
+                            obj_at (\<lambda>k. k = Notification rv) word1" and
+                            R'="\<lambda>rv'. invs' and tcb_at' thread and ntfn_at' word1 and
+                            valid_ntfn' rv'"
+                         in corres_split[OF getNotification_corres])
+      apply clarsimp
+      apply (case_tac "ntfn_obj rv")
+        \<comment> \<open>IdleNtfn\<close>
+        apply (simp add: ntfn_relation_def)
+        apply (rule corres_guard_imp)
+          apply (case_tac isBlocking; simp)
+           apply (rule corres_split[OF setThreadState_corres])
+              apply simp
+             apply (rule setNotification_corres)
+             apply (simp add: ntfn_relation_def)
+            apply wp+
+          apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, fastforce+)
+       \<comment> \<open>WaitingNtfn\<close>
+       apply (simp add: ntfn_relation_def)
+       apply (rule corres_guard_imp)
+         apply (case_tac isBlocking; simp)
+          apply (rule corres_split[OF setThreadState_corres])
+             apply simp
+            apply (rule setNotification_corres)
+            apply (simp add: ntfn_relation_def)
+           apply wp+
+         apply (rule corres_guard_imp)
+           apply (rule doNBRecvFailedTransfer_corres, fastforce+)
+      \<comment> \<open>ActiveNtfn\<close>
+      apply (simp add: ntfn_relation_def)
+      apply (rule corres_guard_imp)
+        apply (simp add: badgeRegister_def badge_register_def)
+        apply (rule corres_split[OF asUser_setRegister_corres])
+          apply (rule setNotification_corres)
+          apply (simp add: ntfn_relation_def)
+         apply wp+
+       apply (fastforce simp: invs_def valid_state_def valid_pspace_def
+                       elim!: st_tcb_weakenE)
+      apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
+     apply wp+
+   apply (clarsimp simp add: ntfn_at_def2 valid_cap_def st_tcb_at_tcb_at)
+  apply (clarsimp simp add: valid_cap'_def)
+  done
+
+lemma tg_sp':
+  "\<lbrace>P\<rbrace> threadGet f p \<lbrace>\<lambda>t. obj_at' (\<lambda>t'. f t' = t) p and P\<rbrace>"
+  including no_pre
+  apply (simp add: threadGet_def)
+  apply wp
+  apply (rule hoare_strengthen_post)
+   apply (rule getObject_tcb_sp)
+  apply clarsimp
+  apply (erule obj_at'_weakenE)
+  apply simp
   done
 
-lemma maybeReturnSc_valid_queues:
-  "\<lbrace>valid_queues and valid_tcbs'\<rbrace>
-   maybeReturnSc ntfnPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (clarsimp simp: maybeReturnSc_def)
-  apply (wpsimp wp: hoare_drop_imps)
-     apply (wpsimp wp: threadSet_valid_queues_new hoare_vcg_if_lift2
-                       getNotification_wp threadGet_wp)+
-  apply (clarsimp simp: obj_at'_def inQ_def)
-  done
+declare lookup_cap_valid' [wp]
 
-crunch maybeReturnSc
-  for valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  (wp: crunch_wps simp: crunch_simps inQ_def)
-
-lemma maybeReturnSc_valid_release_queue':
-  "\<lbrace>valid_release_queue' and valid_tcbs'\<rbrace>
-   maybeReturnSc ntfnPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_release_queue'\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (clarsimp simp: maybeReturnSc_def liftM_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (rule bind_wp[OF _ threadGet_sp])
-  apply (rule hoare_when_cases; clarsimp)
-  apply (rule_tac Q'="\<lambda>_. ?pre" in bind_wp_fwd)
-   apply (wpsimp wp: threadSet_valid_release_queue' threadSet_valid_objs')
-   apply (clarsimp simp: obj_at'_def valid_release_queue'_def)
-  apply wpsimp
+lemma sendFaultIPC_corres:
+  "valid_fault f \<Longrightarrow> fr f f' \<Longrightarrow>
+  corres (fr \<oplus> dc)
+         (einvs and st_tcb_at active thread and ex_nonz_cap_to thread)
+         (invs' and sch_act_not thread and tcb_at' thread)
+         (send_fault_ipc thread f) (sendFaultIPC thread f')"
+  apply (simp add: send_fault_ipc_def sendFaultIPC_def
+                   liftE_bindE Let_def)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split [where r'="\<lambda>fh fh'. fh = to_bl fh'"])
+       apply (rule threadGet_corres)
+       apply (simp add: tcb_relation_def)
+      apply simp
+      apply (rule corres_splitEE)
+         apply (rule corres_cap_fault)
+         apply (rule lookup_cap_corres, rule refl)
+        apply (rule_tac P="einvs and st_tcb_at active thread
+                                and valid_cap handler_cap and ex_nonz_cap_to thread"
+                    and P'="invs' and tcb_at' thread and sch_act_not thread
+                                  and valid_cap' handlerCap"
+                    in corres_inst)
+        apply (case_tac handler_cap,
+               simp_all add: isCap_defs lookup_failure_map_def
+                             case_bool_If If_rearrage
+                  split del: if_split cong: if_cong)[1]
+         apply (rule corres_guard_imp)
+           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 (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
+                  | simp add: tcb_cap_cases_def)+
+            apply ((wp threadSet_invs_trivial threadSet_tcb'
+                  | simp add: tcb_cte_cases_def
+                  | wp (once) sch_act_sane_lift)+)[1]
+           apply (rule corres_trivial, simp add: lookup_failure_map_def)
+          apply (clarsimp simp: st_tcb_at_tcb_at split: if_split)
+          apply (fastforce simp: valid_cap_def)
+         apply (clarsimp simp: valid_cap'_def inQ_def)
+        apply auto[1]
+        apply (clarsimp simp: lookup_failure_map_def)
+       apply wp+
+   apply (fastforce elim: st_tcb_at_tcb_at)
+  apply fastforce
   done
 
-lemma maybe_return_sc_weak_valid_sched_action:
-  "\<lbrace>weak_valid_sched_action and scheduler_act_not tcb_ptr and tcb_at tcb_ptr\<rbrace>
-   maybe_return_sc ntfn_ptr tcb_ptr
-   \<lbrace>\<lambda>_. weak_valid_sched_action\<rbrace>"
-  apply (clarsimp simp: maybe_return_sc_def)
-  apply (wpsimp wp: set_object_wp thread_get_wp get_simple_ko_wp
-              simp: set_tcb_obj_ref_def get_tcb_obj_ref_def get_sk_obj_ref_def)
-  apply (clarsimp simp: obj_at_def is_tcb_def)
-  apply (rename_tac tcb, case_tac tcb; clarsimp)
-  apply (fastforce simp: weak_valid_sched_action_def scheduler_act_not_def vs_all_heap_simps)
+lemma gets_the_noop_corres:
+  assumes P: "\<And>s. P s \<Longrightarrow> f s \<noteq> None"
+  shows "corres dc P P' (gets_the f) (return x)"
+  apply (clarsimp simp: corres_underlying_def gets_the_def
+                        return_def gets_def bind_def get_def)
+  apply (clarsimp simp: assert_opt_def return_def dest!: P)
   done
 
-lemma maybeReturnSc_invs'_and_valid_idle':
-  "\<lbrace>invs' and valid_idle' and (\<lambda>s. tptr \<noteq> ksIdleThread s)\<rbrace>
-   maybeReturnSc nptr tptr
-   \<lbrace>\<lambda>_. invs' and valid_idle'\<rbrace>"
-  apply (wpsimp wp: setSchedContext_invs' simp: maybeReturnSc_def)
-      apply (clarsimp simp add: invs'_def split del: if_split)
-      apply (wp threadSet_valid_pspace'T threadSet_sch_actT_P[where P=False, simplified]
-                threadSet_ctes_of threadSet_iflive'T threadSet_ifunsafe'T threadSet_idle'T
-                threadSet_not_inQ valid_irq_node_lift valid_irq_handlers_lift'' threadSet_cur
-                threadSet_ct_idle_or_in_cur_domain' untyped_ranges_zero_lift threadSet_cap_to'
-                threadSet_valid_queues threadSet_valid_queues' threadSet_valid_release_queue
-                threadSet_valid_release_queue' threadGet_wp getNotification_wp
-                hoare_vcg_imp_lift' hoare_vcg_all_lift valid_dom_schedule'_lift
-             | clarsimp simp: tcb_cte_cases_def cteCaps_of_def)+
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (rename_tac ntfn tcb)
-  apply (rule_tac x=tcb in exI)
-  apply (clarsimp simp: invs'_def inQ_def comp_def eq_commute[where a="Some _"])
-  apply (intro conjI impI allI; clarsimp?)
-        apply (fastforce simp: valid_release_queue'_def obj_at'_def projectKOs)
-       apply (fastforce simp: valid_release_queue'_def obj_at'_def projectKOs)
-      apply (clarsimp simp: untyped_ranges_zero_inv_def cteCaps_of_def comp_def)
-     apply (clarsimp simp: valid_idle'_def obj_at'_def projectKOs sym_refs_asrt_def)
-     apply (drule_tac ko="tcb" and p=tptr in sym_refs_ko_atD'[rotated])
-      apply (fastforce simp: obj_at'_def projectKOs)
-     apply (clarsimp simp: ko_wp_at'_def refs_of_rev')
-     apply (fastforce elim: if_live_then_nonz_capE' simp: ko_wp_at'_def live_sc'_def)
-    apply (fastforce simp: valid_pspace'_def valid_obj'_def valid_sched_context'_def)
-   apply (fastforce simp: valid_obj'_def valid_sched_context_size'_def objBits_def objBitsKO_def)
-  apply (clarsimp simp: valid_idle'_def obj_at'_def projectKOs sym_refs_asrt_def)
-  apply (drule_tac ko="tcb" and p=tptr in sym_refs_ko_atD'[rotated])
-   apply (fastforce simp: obj_at'_def projectKOs)
-  apply (clarsimp simp: ko_wp_at'_def refs_of_rev')
+lemma handleDoubleFault_corres:
+  "corres dc (tcb_at thread and pspace_aligned and pspace_distinct)
+             \<top>
+             (handle_double_fault thread f ft)
+             (handleDoubleFault thread f' ft')"
+  apply (rule corres_cross_over_guard[where Q="tcb_at' thread"])
+   apply (fastforce intro!: tcb_at_cross)
+  apply (simp add: handle_double_fault_def handleDoubleFault_def)
+  apply (rule corres_guard_imp)
+    apply (subst bind_return [symmetric],
+           rule corres_split[OF setThreadState_corres])
+       apply simp
+      apply (rule corres_noop2)
+         apply (simp add: exs_valid_def return_def)
+        apply (rule hoare_eq_P)
+        apply wp
+        apply (rule asUser_inv)
+        apply (rule getRestartPC_inv)
+       apply (wp no_fail_getRestartPC)+
+   apply (wp|simp)+
   done
 
-lemma
-  shows
-  maybeReturnSc_invs':
-  "\<lbrace>invs' and valid_idle' and (\<lambda>s. tptr \<noteq> ksIdleThread s)\<rbrace>
-   maybeReturnSc nptr tptr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  and maybeReturnSc_valid_idle':
-  "\<lbrace>invs' and valid_idle' and (\<lambda>s. tptr \<noteq> ksIdleThread s)\<rbrace>
-   maybeReturnSc nptr tptr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  by (fastforce intro: hoare_strengthen_post[OF maybeReturnSc_invs'_and_valid_idle'])+
+crunch sendFaultIPC
+  for tcb'[wp]: "tcb_at' t" (wp: crunch_wps)
 
-crunch doIPCTransfer
-  for pspace_aligned'[wp]: pspace_aligned'
-  and pspace_distinct'[wp]: pspace_distinct'
-  and no_0_obj'[wp]: no_0_obj'
-  and vrq[wp]: valid_release_queue
-  and vrq'[wp]: valid_release_queue'
-  (wp: crunch_wps simp: zipWithM_x_mapM_x)
+crunch receiveIPC
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps)
 
-definition receiveIPC_preamble where
-  "receiveIPC_preamble replyCap thread \<equiv>
-    case replyCap of NullCap \<Rightarrow> return Nothing
-                 | ReplyCap r _ \<Rightarrow>
-                 (do tptrOpt <- liftM replyTCB (getReply (r));
-                     when (tptrOpt \<noteq> Nothing \<and> tptrOpt \<noteq> Some thread) $ cancelIPC (the tptrOpt);
-                     return (Just r)
-                  od)
-                 | _ \<Rightarrow> haskell_fail []"
-
-crunch maybe_return_sc
-  for ep_at[wp]: "ep_at epptr"
-  (wp: crunch_wps simp: crunch_simps)
+lemmas receiveIPC_typ_ats[wp] = typ_at_lifts [OF receiveIPC_typ_at']
 
-lemma thread_set_cap_to_fault_helper:
-  "(a, b, c) \<in> ran tcb_cap_cases \<Longrightarrow> a (tcb_fault_update h tcb) = a tcb"
-  by (clarsimp simp: tcb_cap_cases_def, fastforce)
+crunch receiveSignal
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps)
 
-crunch cancel_ipc
-  for ep_at[wp]: "ep_at epptr"
-  and reply_at[wp]: "reply_at rptr"
-  and ex_nonz_cap_to[wp]: "ex_nonz_cap_to t"
-  (simp: crunch_simps thread_set_cap_to_fault_helper
-     wp: crunch_wps thread_set_cap_to)
+lemmas receiveAIPC_typ_ats[wp] = typ_at_lifts [OF receiveSignal_typ_at']
 
-crunch doIPCTransfer
-  for replySCs_of[wp]: "\<lambda>s. P (replySCs_of s)"
-  and replyTCBs_of[wp]: "\<lambda>s. P (replyTCBs_of s)"
-  (wp: crunch_wps simp: zipWithM_x_mapM_x)
+declare cart_singleton_empty[simp]
 
-crunch receive_ipc_preamble
-  for ep_at[wp]: "ep_at epptr"
-  and valid_list[wp]: valid_list
-  and tcb_at[wp]: "tcb_at t"
-  and ex_nonz_cap_to[wp]: "ex_nonz_cap_to epptr"
-  and idle_thread[wp]: "\<lambda>s. P (idle_thread s)"
-  and cte_wp_at[wp]: "cte_wp_at P x"
-
-crunch receiveIPC_preamble
-  for ep_at'[wp]: "ep_at' epptr"
-  and tcb_at'[wp]: "tcb_at' t"
-  and invs'[wp]: invs'
-  and cur_tcb'[wp]: cur_tcb'
-
-crunch maybeReturnSc
-  for cur_tcb'[wp]: cur_tcb'
-  (wp: crunch_wps threadSet_cur)
-
-lemma receiveIPC_preamble_vbreply'[wp]:
-  "\<lbrace>\<top>\<rbrace> receiveIPC_preamble replyCap thread \<lbrace>valid_bound_reply'\<rbrace>"
-  unfolding receiveIPC_preamble_def
-  by (case_tac replyCap; wpsimp)
-
-lemma receiveIPC_preamble_corres:
-  assumes "cap_relation reply_cap replyCap"
-      and "is_reply_cap reply_cap \<or> (reply_cap = cap.NullCap)"
-  shows "corres (=) (invs and valid_ready_qs and valid_cap reply_cap) invs'
-     (receive_ipc_preamble reply_cap thread)
-     (receiveIPC_preamble replyCap thread)"
-  supply if_split [split del]
-  apply (insert assms)
-  apply (clarsimp simp: receive_ipc_preamble_def receiveIPC_preamble_def)
-  apply (case_tac reply_cap; simp add: is_reply_cap_def)
-  apply (rule stronger_corres_guard_imp)
-    apply (clarsimp simp: liftM_def)
-    apply (rule corres_split[OF get_reply_corres])
-      apply (rule corres_split[OF _ corres_return_eq_same[OF refl], where r'=dc])
-        apply (rule corres_when2)
-         apply (clarsimp simp: reply_relation_def)
-         apply (rename_tac r, case_tac "replyTCB r"; simp)
-        apply (rename_tac r r')
-        apply (subgoal_tac "replyTCB r' = reply_tcb r", simp)
-         apply (rule cancel_ipc_corres)
-        apply (clarsimp simp: reply_relation_def)
-       apply wpsimp
-      apply wpsimp
-     apply (wpsimp wp: get_simple_ko_wp)
-    apply (wpsimp wp: getReply_wp)
-   apply (clarsimp simp: valid_cap_def)
-   apply (frule (1) valid_objs_ko_at[OF invs_valid_objs])
-   apply (clarsimp simp: valid_obj_def valid_reply_def)
-  apply (clarsimp simp: valid_cap_def)
-  apply (erule cross_relF[OF _ reply_at'_cross_rel])
-  apply fastforce
-  done
+declare cart_singleton_empty2[simp]
 
-lemma ri_preamble_vbreply:
-  "receive_ipc_preamble_rv reply_cap replyOpt s \<Longrightarrow> valid_bound_reply replyOpt s"
-  by (case_tac replyOpt; clarsimp elim!: reply_at_ppred_reply_at)
-
-lemma ri_preamble_not_in_sc:
-  "\<lbrakk>sym_refs (state_refs_of s);
-    valid_replies s;
-    receive_ipc_preamble_rv reply_cap replyOpt s\<rbrakk>
-   \<Longrightarrow> valid_bound_obj (\<lambda>a b. a \<notin> fst ` replies_with_sc b) replyOpt s"
-  apply (case_tac replyOpt; simp)
-  apply (erule (1) no_tcb_not_in_replies_with_sc, simp)
-  done
+crunch setupCallerCap
+  for aligned'[wp]: "pspace_aligned'"
+  (wp: crunch_wps)
+crunch setupCallerCap
+  for distinct'[wp]: "pspace_distinct'"
+  (wp: crunch_wps)
+crunch setupCallerCap
+  for cur_tcb[wp]: "cur_tcb'"
+  (wp: crunch_wps)
 
-lemma receiveIPC_corres_helper:
-  "(do replyOpt <-
-                 case replyCap of capability.NullCap \<Rightarrow> return Nothing
-                 | capability.ReplyCap r v18 \<Rightarrow> return (Just r)
-                 | _ \<Rightarrow> haskell_fail [];
-                 y <-
-                 when (\<exists>y. replyOpt = Some y)
-                  (do tptrOpt <- liftM replyTCB (getReply (the replyOpt));
-                      when ((\<exists>y. tptrOpt = Some y) \<and> tptrOpt \<noteq> Some thread)
-                       (cancelIPC (the tptrOpt))
-                   od);
-                 f replyOpt
-          od) = (do replyOpt <-
-                 case replyCap of capability.NullCap \<Rightarrow> return Nothing
-                 | capability.ReplyCap r _ \<Rightarrow>
-                 (do tptrOpt <- liftM replyTCB (getReply (r));
-                     when (tptrOpt \<noteq> Nothing \<and> tptrOpt \<noteq> Some thread) $ cancelIPC (the tptrOpt);
-                     return (Just r)
-                  od)
-                 | _ \<Rightarrow> haskell_fail [];
-                 f replyOpt
-          od)"
-  by (case_tac replyCap; simp add: bind_assoc)
-
-lemma maybeReturnSc_sch_act_wf_not_thread[wp]:
-  "maybeReturnSc ntnfnPtr tcbPtr \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (clarsimp simp: maybeReturnSc_def)
-  apply (rule bind_wp_fwd_skip, solves wpsimp)+
-  apply (rule hoare_when_cases, simp)
-  apply (rule bind_wp_fwd_skip, solves \<open>wpsimp wp: threadSet_sch_act\<close>)+
-  apply wpsimp
+lemma setupCallerCap_state_refs_of[wp]:
+  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (sender := {r \<in> state_refs_of' s sender. snd r = TCBBound}))\<rbrace>
+     setupCallerCap sender rcvr grant
+   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
+  apply (simp add: setupCallerCap_def getThreadCallerSlot_def
+                   getThreadReplySlot_def)
+  apply (wp hoare_drop_imps)
+  apply (simp add: fun_upd_def cong: if_cong)
   done
 
-lemma receiveIPC_preamble_sch_act_wf:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and> sym_refs (state_refs_of' s)\<rbrace>
-   receiveIPC_preamble replyCap thread
-   \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (clarsimp simp: receiveIPC_preamble_def)
-  apply wpsimp
-  apply (fastforce dest: sym_ref_replyTCB_Receive_or_Reply
-                   simp: st_tcb_at'_def obj_at_simps)
-  done
+crunch setupCallerCap
+  for sch_act_wf: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
+  (wp: crunch_wps ssa_sch_act sts_sch_act rule: sch_act_wf_lift)
 
-lemma receiveIPC_preamble_valid_idle':
-  "\<lbrace>\<lambda>s. valid_idle' s \<and> thread \<noteq> ksIdleThread s \<and> sym_refs (state_refs_of' s)\<rbrace>
-   receiveIPC_preamble replyCap thread
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  apply (clarsimp simp: receiveIPC_preamble_def)
-  apply wpsimp
-  apply (fastforce dest: sym_ref_replyTCB_Receive_or_Reply
-                   simp: st_tcb_at'_def obj_at_simps valid_idle'_def idle_tcb'_def)
+lemma is_derived_ReplyCap' [simp]:
+  "\<And>m p g. is_derived' m p (capability.ReplyCap t False g) =
+            (\<lambda>c. \<exists> g. c = capability.ReplyCap t True g)"
+  apply (subst fun_eq_iff)
+  apply clarsimp
+  apply (case_tac x, simp_all add: is_derived'_def isCap_simps
+                                   badge_derived'_def
+                                   vsCapRef_def)
   done
 
-crunch ifCondRefillUnblockCheck
-  for reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma receiveIPC_corres:
-  assumes "is_ep_cap cap" and "cap_relation cap cap'" and "cap_relation reply_cap replyCap"
-    and "is_reply_cap reply_cap \<or> (reply_cap = cap.NullCap)"
-  shows
-    "corres dc (einvs and valid_cap cap and current_time_bounded
-              and valid_cap reply_cap
-              and st_tcb_at active thread
-              and not_queued thread and not_in_release_q thread and scheduler_act_not thread
-              and tcb_at thread and ex_nonz_cap_to thread
-              and (\<lambda>s. \<forall>r\<in>zobj_refs reply_cap. ex_nonz_cap_to r s))
-             (invs' and tcb_at' thread and valid_cap' cap' and valid_cap' replyCap)
-             (receive_ipc thread cap isBlocking reply_cap) (receiveIPC thread cap' isBlocking replyCap)"
-    (is "corres _ (_ and ?tat and ?tex and ?rrefs) _ _ _")
-  apply add_sch_act_wf
-  apply add_valid_idle'
-  apply add_cur_tcb'
-  supply if_split [split del]
-  apply (insert assms)
-  apply (rule corres_cross_add_abs_guard[where Q="K (thread \<noteq> idle_thread_ptr)"])
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-   apply (frule (1) idle_no_ex_cap)
-   apply (clarsimp simp: valid_idle_def)
-  apply (simp add: receive_ipc_def receiveIPC_def)
-  apply add_sym_refs
-  apply (case_tac cap, simp_all add: isEndpointCap_def)
-  apply (rename_tac epptr badge right)
-  apply (rule corres_stateAssert_assume)
-   apply (rule corres_stateAssert_assume[rotated])
-    apply (clarsimp simp: sch_act_wf_asrt_def)
-   apply (rule corres_stateAssert_assume[rotated])
-    apply (clarsimp simp: valid_idle'_asrt_def)
-   apply (rule stronger_corres_guard_imp)
-     apply (subst receiveIPC_corres_helper)
-     apply (clarsimp simp: receive_ipc_preamble_def[symmetric] receiveIPC_preamble_def[symmetric])
-     apply (rule corres_split[OF receiveIPC_preamble_corres], simp, simp)
-       apply (rule corres_split[OF getEndpoint_corres])
-         apply (rename_tac ep ep')
-         apply (rule corres_split[OF getBoundNotification_corres])
-           apply (rule_tac r'="ntfn_relation" in corres_split)
-              apply (rule corres_option_split[OF _ corres_returnTT getNotification_corres]; clarsimp)
-              apply (clarsimp simp: ntfn_relation_def default_notification_def default_ntfn_def)
-             apply (rule corres_if)
-               apply (clarsimp simp: ntfn_relation_def Ipc_A.isActive_def Endpoint_H.isActive_def
-                              split: Structures_A.ntfn.splits Structures_H.notification.splits)
-              apply (simp only: )
-              apply (rule completeSignal_corres)
-             apply (rule corres_split[where r'=dc])
-                apply (rule corres_when; simp)
-                apply (rule maybeReturnSc_corres)
-               apply (rule_tac P="einvs and ?tat and ?tex and ep_at epptr
-                        and valid_ep ep and ko_at (Endpoint ep) epptr
-                        and current_time_bounded
-                        and receive_ipc_preamble_rv reply_cap replyOpt and ?rrefs" and
-                      P'="invs' and valid_idle' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                          and cur_tcb' and tcb_at' thread and ep_at' epptr
-                          and valid_ep' ep' and valid_bound_reply' replyOpt"
-                      in corres_inst)
-               apply (rule_tac P'="valid_bound_obj' valid_replies'_sc_asrt replyOpt" and
-                               P=\<top> in corres_add_guard)
-                apply (case_tac replyOpt; simp)
-                apply (erule valid_replies_sc_cross; clarsimp elim!: reply_at_ppred_reply_at)
-               apply (case_tac ep)
-                 \<comment> \<open>IdleEP\<close>
-                 apply (simp add: ep_relation_def)
-                 apply (fold dc_def)[1]
-                 apply (rule corres_guard_imp)
-                   apply (case_tac isBlocking; simp)
-                    apply (rule corres_split[OF setThreadState_corres], simp)
-                      apply (rule corres_split[OF corres_when setEndpoint_corres], clarsimp)
-                         apply (rule replyTCB_update_corres)
-                        prefer 6 \<comment> \<open> defer wp until corres complete \<close>
-                        apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, clarsimp)
-                        apply simp
-                       apply (simp add: ep_relation_def) \<comment> \<open> corres logic done \<close>
-                      apply wpsimp+
-                  apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
-                                        valid_tcb_state_def st_tcb_at_tcb_at
-                                 split: option.splits)
-                  apply (fastforce elim: ri_preamble_vbreply reply_at_ppred_reply_at)
-                 apply fastforce
-                \<comment> \<open>SendEP\<close>
-                apply (simp add: ep_relation_def get_tcb_obj_ref_def)
-                apply (rename_tac list)
-                apply (rule_tac F="list \<noteq> []" in corres_req)
-                 apply (clarsimp simp: valid_ep_def)
-                apply (case_tac list, simp_all)[1]
-                apply (rename_tac sender queue)
-                apply (rule corres_guard_imp)
-                  apply (rule corres_split[OF setEndpoint_corres])
-                     apply (clarsimp simp: ep_relation_def split: list.splits)
-                    apply (rule corres_split[OF getThreadState_corres])
-                      apply (rule_tac F="\<exists>data. sender_state = Structures_A.thread_state.BlockedOnSend epptr data"
-                             in corres_gen_asm)
-                      apply (clarsimp simp: isSend_def case_bool_If
-                                            case_option_If if3_fold
-                                      cong: if_cong)
-                      apply (rule corres_split[OF doIPCTransfer_corres])
-                        apply (rule corres_split_eqr[OF threadGet_corres])
-                           apply (clarsimp simp: tcb_relation_def)
-                          apply (rule corres_split[OF ifCondRefillUnblockCheck_corres])
-                            apply (rule corres_split[OF threadget_fault_corres])
-                              apply (simp cong: if_cong)
-                              apply (fold dc_def)[1]
-                              apply (rule_tac P="valid_objs and valid_mdb and valid_list
-                                                 and valid_sched and valid_replies and valid_idle
-                                                 and cur_tcb and current_time_bounded
-                                                 and pspace_aligned and pspace_distinct
-                                                 and st_tcb_at is_blocked_on_send sender and ?tat
-                                                 and receive_ipc_preamble_rv reply_cap replyOpt
-                                                 and valid_bound_obj (\<lambda>r s. r \<notin> fst ` replies_with_sc s) replyOpt
-                                                 and (\<lambda>s. sym_refs (\<lambda>p. if p = sender
-                                                                        then tcb_non_st_state_refs_of s sender
-                                                                        else state_refs_of s p))
-                                                 and ?rrefs"
-                                          and P'="tcb_at' sender and tcb_at' thread and cur_tcb'
-                                                  and valid_queues
-                                                  and valid_queues'
-                                                  and valid_release_queue
-                                                  and valid_release_queue'
-                                                  and valid_objs'
-                                                  and valid_bound_obj' valid_replies'_sc_asrt replyOpt
-                                                  and cur_tcb'
-                                                  and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)"
-                                           in corres_guard_imp [OF corres_if])
-                                  apply (simp add: fault_rel_optionation_def)
-                                 apply (rule corres_if2)
-                                   apply simp
-                                  apply (rule corres_split_eqr[OF threadGet_corres replyPush_corres])
-                                     apply (clarsimp simp: tcb_relation_def)
-                                    apply (clarsimp simp: fault_rel_optionation_def split: option.splits)
-                                   prefer 3 \<comment> \<open> defer wp until corres complete \<close>
-                                   apply (rule setThreadState_corres, simp)
-                                  prefer 3 \<comment> \<open> defer wp until corres complete \<close>
-                                  apply (rule corres_split[OF setThreadState_corres], simp)
-                                    apply (rule possibleSwitchTo_corres, simp)
-                                   apply (wpsimp wp: set_thread_state_valid_sched_action)
-                                  apply wpsimp
-                                 apply wpsimp
-                                apply wpsimp
-                               apply clarsimp
-                               apply (frule valid_objs_valid_tcbs)
-                               apply (frule pred_tcb_at_tcb_at)
-                               apply (frule (1) valid_sched_scheduler_act_not_better[OF _ st_tcb_weakenE])
-                                apply (clarsimp simp: is_blocked_on_send_def)
-                               apply (frule (1) not_idle_thread', clarsimp simp: is_blocked_on_send_def)
-                               apply (clarsimp simp: valid_sched_def valid_idle_def
-                                              split: if_splits cong: conj_cong)
-                               apply (subgoal_tac "replyOpt \<noteq> None \<longrightarrow> the replyOpt \<notin> fst ` replies_with_sc s")
-                                apply (prop_tac "st_tcb_at (\<lambda>st. reply_object st = None) sender s")
-                                 apply (fastforce elim!: pred_tcb_weakenE simp: is_blocked_on_send_def)
-                                apply (frule valid_sched_action_weak_valid_sched_action)
-                                apply (clarsimp simp: valid_sched_def split: if_splits cong: conj_cong)
-                                apply fastforce
-                               apply (fastforce simp: image_def)
-                              apply (clarsimp, frule valid_objs'_valid_tcbs')
-                              apply (clarsimp simp: valid_sched_def split: if_splits
-                                              cong: conj_cong)
-                              apply (case_tac replyOpt; simp)
-                             apply wpsimp
-                            apply wpsimp
-                           apply (wpsimp simp: if_cond_refill_unblock_check_def
-                                           wp: refill_unblock_check_valid_sched
-                                               valid_bound_obj_lift hoare_vcg_ball_lift)
-                          apply (wpsimp wp: valid_bound_obj'_lift valid_replies'_sc_asrt_lift)
-                         apply (rule_tac Q'="\<lambda>rv. all_invs_but_sym_refs and valid_sched
-                                                 and current_time_bounded and tcb_at sender
-                                                 and tcb_at thread and st_tcb_at is_blocked_on_send sender
-                                                 and (\<lambda>s. \<forall>r\<in>zobj_refs reply_cap. ex_nonz_cap_to r s)
-                                                 and valid_list and bound_sc_tcb_at ((=) rv) sender
-                                                 and (\<lambda>s. sym_refs
-                                                          (\<lambda>p. if p = sender
-                                                               then tcb_non_st_state_refs_of s sender
-                                                               else state_refs_of s p))
-                                                 and valid_bound_obj (\<lambda>r s. r \<notin> fst ` replies_with_sc s) replyOpt
-                                                 and receive_ipc_preamble_rv reply_cap replyOpt"
-                                in hoare_strengthen_post[rotated])
-                          apply (clarsimp simp: valid_sched_active_scs_valid)
-                          apply (rule conjI)
-                           apply (rename_tac rv s; case_tac rv; simp)
-                           apply (rule context_conjI)
-                            apply (clarsimp simp: obj_at_def is_tcb pred_tcb_at_def)
-                            apply (drule sym[of "Some _"])
-                            apply (erule_tac x=sender in valid_objsE, simp)
-                            apply (clarsimp simp: obj_at_def is_sc_obj valid_tcb_def valid_obj_def)
-                           apply (clarsimp simp: valid_sched_active_scs_valid
-                                                 opt_map_red opt_pred_def obj_at_def is_sc_obj)
-                          apply (clarsimp simp: obj_at_def is_tcb pred_tcb_at_def sc_tcb_sc_at_def
-                                         split: if_split)
-                          apply (drule send_signal_WN_sym_refs_helper)
-                          apply (prop_tac "heap_ref_eq x sender (tcb_scps_of s)")
-                           apply (clarsimp simp: vs_all_heap_simps)
-                          apply (drule_tac p=t and p'=sender in heap_refs_retract_inj_eq; simp)
-                          apply (clarsimp simp: vs_all_heap_simps)
-                          apply (drule_tac t=t in valid_release_q_not_in_release_q_not_runnable
-                                                                   [OF valid_sched_valid_release_q])
-                           apply (clarsimp simp: is_blocked_on_send_def pred_tcb_at_def obj_at_def)
-                          apply clarsimp
-                         apply (wpsimp wp: thread_get_wp')
-                        apply (wpsimp wp: threadGet_wp)
-                       apply (rule_tac Q'="\<lambda>rv. all_invs_but_sym_refs and valid_sched and valid_list
-                                               and current_time_bounded and tcb_at sender
-                                               and tcb_at thread and st_tcb_at is_blocked_on_send sender
-                                               and (\<lambda>s. \<forall>r\<in>zobj_refs reply_cap. ex_nonz_cap_to r s)
-                                               and (\<lambda>s. sym_refs
-                                                        (\<lambda>p. if p = sender
-                                                             then tcb_non_st_state_refs_of s sender
-                                                             else state_refs_of s p))
-                                               and valid_bound_obj (\<lambda>r s. r \<notin> fst ` replies_with_sc s) replyOpt
-                                               and receive_ipc_preamble_rv reply_cap replyOpt"
-                              in hoare_strengthen_post[rotated])
-                        apply (clarsimp simp: valid_sched_active_scs_valid)
-                        apply (rename_tac opt; case_tac opt; clarsimp simp: obj_at_def is_tcb pred_tcb_at_def)
-                       apply (wpsimp wp: do_ipc_transfer_tcb_caps hoare_vcg_ball_lift
-                                         valid_bound_obj_lift)
-                      apply (rule_tac Q'="\<lambda>ya. (\<lambda>s. tcb_at' sender s \<and>
-                                                         tcb_at' thread s \<and>
-                                                         cur_tcb' s \<and>
-                                                         valid_queues s \<and>
-                                                         valid_queues' s \<and>
-                                                         valid_release_queue s \<and>
-                                                         valid_release_queue' s \<and>
-                                                         valid_objs' s \<and>
-                                                         valid_bound_obj' valid_replies'_sc_asrt replyOpt
-                                                          s \<and>
-                                                         cur_tcb' s \<and>
-                                                         sch_act_wf (ksSchedulerAction s) s)"
-                      in hoare_strengthen_post[rotated])
-                       apply (clarsimp simp: sch_act_wf_weak obj_at'_def projectKOs split: option.split)
-                      apply (wpsimp wp: valid_replies'_sc_asrt_lift valid_bound_obj'_lift)
-                     apply (wpsimp wp: gts_st_tcb_at)
-                    apply wpsimp
-                   apply (wpsimp wp: hoare_vcg_ball_lift valid_bound_obj_lift)
-                  apply (clarsimp simp: pred_conj_def cong: conj_cong)
-                  apply (wpsimp wp: valid_replies'_sc_asrt_lift valid_bound_obj'_lift)
-                 apply (clarsimp simp: invs_def valid_state_def st_tcb_at_tcb_at
-                                       valid_ep_def valid_pspace_def live_def)
-                 apply (prop_tac "sender \<noteq> epptr")
-                  apply (fastforce simp: valid_ep_def obj_at_def is_obj_defs)
-                 apply (prop_tac "st_tcb_at (\<lambda>st. \<exists>data. st = Structures_A.BlockedOnSend epptr data) sender s")
-                  apply (drule (1) sym_refs_ko_atD)
-                  apply (fastforce simp: st_tcb_at_refs_of_rev elim: st_tcb_weakenE)
-                 apply (extract_conjunct \<open>rule delta_sym_refs\<close>)
-                 subgoal
-                   apply (erule delta_sym_refs)
-                   by (auto simp: ko_at_state_refs_ofD get_refs_def2
-                                  pred_tcb_at_def obj_at_def valid_ep_def
-                           split: list.splits if_splits)
-                 apply (clarsimp split: list.split)
-                 apply (frule (2) ri_preamble_not_in_sc)
-                 apply (frule_tac y=sender in valid_sched_scheduler_act_not_better)
-                  apply (fastforce simp: st_tcb_at_refs_of_rev elim: st_tcb_weakenE)
-                 apply (prop_tac "ex_nonz_cap_to epptr s")
-                  apply (fastforce simp: live_def obj_at_def is_ep elim!: if_live_then_nonz_capD2)
-                 apply (fastforce simp: st_tcb_at_refs_of_rev elim: st_tcb_weakenE)
-                apply (fastforce simp: valid_ep'_def invs'_def split: list.split)
-               \<comment> \<open>RecvEP\<close>
-               apply (simp add: ep_relation_def)
-               apply (fold dc_def)[1]
-               apply (rule_tac corres_guard_imp)
-                 apply (case_tac isBlocking; simp)
-                  apply (rule corres_split[OF setThreadState_corres], simp)
-                    apply (rule corres_split [where r=dc])
-                       apply (rule corres_when[OF _ replyTCB_update_corres], simp)
-                      apply (rule corres_split[OF tcbEPAppend_corres setEndpoint_corres])
-                        apply (simp add: ep_relation_def)
-                       apply (wpsimp wp: hoare_vcg_ball_lift)+
-                 apply (rule corres_guard_imp[OF doNBRecvFailedTransfer_corres]; clarsimp)
-                apply (clarsimp simp: invs_def valid_pspace_def valid_state_def valid_ep_def)
-                apply (fastforce elim: ri_preamble_vbreply reply_at_ppred_reply_at)
-               apply (clarsimp simp: invs'_def valid_pspace'_def valid_ep'_def)
-               apply fastforce
-              \<comment> \<open> end of ep cases \<close>
-              apply (rule_tac Q'="\<lambda>_. einvs and ?tat and ?tex and
-                               ko_at (Endpoint ep) epptr and current_time_bounded and
-                               receive_ipc_preamble_rv reply_cap replyOpt and ?rrefs"
-                     in hoare_strengthen_post[rotated])
-               apply (clarsimp, intro conjI)
-                apply (clarsimp simp: obj_at_def is_ep)
-               apply (frule (1) valid_objs_ko_at[OF invs_valid_objs])
-               apply (clarsimp simp: valid_obj_def)
-              apply (wpsimp wp: hoare_cte_wp_caps_of_state_lift valid_case_option_post_wp hoare_vcg_ball_lift)
-             apply (wpsimp wp: maybeReturnSc_invs' maybeReturnSc_valid_idle' valid_case_option_post_wp)
-            apply simp
-            apply (wpsimp wp: get_simple_ko_wp)
-           apply simp
-           apply (wpsimp wp: getNotification_wp)
-          apply (wpsimp wp: get_tcb_obj_ref_wp)
-         apply (wpsimp wp: gbn_wp')
-        apply (drule_tac s=reply in sym, simp)
-        apply (wpsimp wp: get_simple_ko_wp)
-       apply (wpsimp wp: getEndpoint_wp)
-      apply simp
-      apply (rule_tac Q'="\<lambda>r. invs and ep_at epptr and valid_list and current_time_bounded
-                             and scheduler_act_not thread and (\<lambda>s. thread \<noteq> idle_thread s)
-                             and valid_sched and ?tat and ?tex
-                             and receive_ipc_preamble_rv reply_cap r
-                             and not_queued thread and not_in_release_q thread and ?rrefs"
-             in hoare_strengthen_post[rotated])
-       apply (subgoal_tac "\<forall>tcb. ko_at (TCB tcb) thread s \<longrightarrow>
-                                   (case tcb_bound_notification tcb of
-                                     None \<Rightarrow> \<lambda>_. True
-                                     | Some x \<Rightarrow> ntfn_at x) s")
-        apply (clarsimp simp: invs_def valid_state_def valid_pspace_def obj_at_def is_ep is_tcb
-                              is_ntfn opt_map_red opt_pred_def valid_sched_def valid_sched_action_def
-                              valid_objs_valid_tcbs current_time_bounded_def
-                       split: if_split)
-       apply (clarsimp, frule (1) valid_objs_ko_at[OF invs_valid_objs])
-       apply (clarsimp simp: valid_obj_def valid_tcb_def valid_bound_obj_def case_option_ext)
-      apply (wpsimp wp: receive_ipc_preamble_invs receive_ipc_preamble_valid_sched
-                        receive_ipc_preamble_rv hoare_vcg_ball_lift)
-     apply (rule_tac Q'="\<lambda>replyOpt. ep_at' epptr and tcb_at' thread and invs' and valid_idle'
-                                   and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and
-                            (\<lambda>_. thread \<noteq> idle_thread_ptr) and valid_bound_reply' replyOpt
-                            and cur_tcb'"
-            in hoare_strengthen_post[rotated])
-      apply (clarsimp simp: invs'_def valid_pspace'_def split: if_split)[1]
-      apply (subgoal_tac "thread \<noteq> ksIdleThread s \<and> (\<forall>ko. ko_at' ko epptr s \<longrightarrow> valid_ep' ko s) \<and>
-                          (\<forall>ntfn. bound_tcb_at' ((=) ntfn) thread s \<longrightarrow> valid_bound_ntfn' ntfn s)",
-             clarsimp)
-       apply (clarsimp simp: valid_bound_ntfn'_def case_option_ext)
-       apply (intro conjI; intro allI impI)
-        apply (intro conjI)
-         apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-        apply fastforce
-       apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-      apply (intro conjI; clarsimp)
-        apply (clarsimp simp: valid_idle'_def)
-       apply (erule ep_ko_at_valid_objs_valid_ep', clarsimp)
-      apply (clarsimp simp: pred_tcb_at'_def, frule obj_at_ko_at'[where p=thread], clarsimp)
-      apply (frule tcb_ko_at_valid_objs_valid_tcb', clarsimp)
-      apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def valid_tcb'_def)
-     apply (wpsimp wp: receiveIPC_preamble_sch_act_wf receiveIPC_preamble_valid_idle')
-    apply clarsimp
-    apply (clarsimp simp: valid_cap_def valid_idle_def invs_def valid_state_def valid_sched_def)
-   apply (clarsimp simp: valid_cap'_def valid_idle'_def)
-  apply (simp add: sym_refs_asrt_def)
-  done
+lemma unique_master_reply_cap':
+  "\<And>c t. isReplyCap c \<and> capReplyMaster c \<and> capTCBPtr c = t \<longleftrightarrow>
+          (\<exists>g . c = capability.ReplyCap t True g)"
+  by (fastforce simp: isCap_simps conj_comms)
 
-lemma scheduleTCB_corres:
-  "corres dc
-          (valid_tcbs and weak_valid_sched_action and pspace_aligned and pspace_distinct
-           and tcb_at tcbPtr and active_scs_valid)
-          (valid_tcbs' and valid_queues and valid_queues' and valid_release_queue_iff)
-          (schedule_tcb tcbPtr)
-          (scheduleTCB tcbPtr)"
-  apply (clarsimp simp: schedule_tcb_def scheduleTCB_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split [OF getCurThread_corres])
-      apply (rule corres_split [OF getSchedulerAction_corres], rename_tac sched_action)
-        apply (rule corres_split [OF isSchedulable_corres])
-          apply (clarsimp simp: when_def)
-          apply (intro conjI impI; (clarsimp simp: sched_act_relation_def)?)
-           apply (rule rescheduleRequired_corres)
-          apply (case_tac sched_act; clarsimp)
-         apply (wpsimp wp: isSchedulable_wp)+
+lemma getSlotCap_cte_wp_at:
+  "\<lbrace>\<top>\<rbrace> getSlotCap sl \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>c. cteCap c = rv) sl\<rbrace>"
+  apply (simp add: getSlotCap_def)
+  apply (wp getCTE_wp)
+  apply (clarsimp simp: cte_wp_at_ctes_of)
   done
 
-lemma as_user_refs_of[wp]:
-  "as_user thread f \<lbrace>\<lambda>s. obj_at (\<lambda>ko. P (refs_of ko)) ptr s\<rbrace>"
-  apply (clarsimp simp: as_user_def)
-  apply (wpsimp wp: set_object_wp)
-  apply (clarsimp simp: obj_at_def)
-  apply (erule rsubst[where P=P])
-  apply (clarsimp simp: get_tcb_def get_refs_def2 tcb_st_refs_of_def
-                 split: Structures_A.kernel_object.splits)
-  done
+crunch setThreadState
+  for no_0_obj'[wp]: no_0_obj'
 
-lemma receiveSignal_corres:
- "\<lbrakk> is_ntfn_cap cap; cap_relation cap cap' \<rbrakk> \<Longrightarrow>
-  corres dc ((invs and weak_valid_sched_action and scheduler_act_not thread and valid_ready_qs
-                   and st_tcb_at active thread and active_scs_valid and valid_release_q
-                   and current_time_bounded and (\<lambda>s. thread = cur_thread s) and not_queued thread
-                   and not_in_release_q thread and ex_nonz_cap_to thread) and valid_cap cap)
-            (invs' and tcb_at' thread and ex_nonz_cap_to' thread and valid_cap' cap')
-            (receive_signal thread cap isBlocking) (receiveSignal thread cap' isBlocking)"
-  (is "\<lbrakk>_;_\<rbrakk> \<Longrightarrow> corres _ (?pred and _) _ _ _")
-  apply (simp add: receive_signal_def receiveSignal_def)
-  apply add_sym_refs
-  apply add_valid_idle'
-  apply (rule corres_stateAssert_assume)
-   apply (rule corres_stateAssert_add_assertion[rotated])
-    apply (clarsimp simp: valid_idle'_asrt_def)
-   apply (case_tac cap, simp_all add: isEndpointCap_def)
-   apply (rename_tac cap_ntfn_ptr badge rights)
-   apply (rule_tac Q="\<lambda>rv. ?pred and tcb_at thread and ntfn_at cap_ntfn_ptr
-                           and valid_ntfn rv and obj_at ((=) (Notification rv)) cap_ntfn_ptr"
-               and Q'="\<lambda>rv'. invs' and valid_release_queue_iff and ex_nonz_cap_to' thread
-                             and tcb_at' thread and ntfn_at' cap_ntfn_ptr
-                             and valid_ntfn' rv' and ko_at' rv' cap_ntfn_ptr"
-                in corres_underlying_split)
-      apply (corresKsimp corres: getNotification_corres
-                          simp: ntfn_at_def2 valid_cap_def st_tcb_at_tcb_at valid_cap'_def)
-     defer
-     apply (wpsimp wp: get_simple_ko_wp)
-     apply (fastforce simp: valid_cap_def obj_at_def valid_obj_def
-                      dest: invs_valid_objs)
-    apply (wpsimp wp: getNotification_wp)
-    apply (fastforce simp: obj_at'_def projectKOs valid_obj'_def
-                     dest: invs_valid_objs')
-   apply (clarsimp simp: sym_refs_asrt_def)
-  apply (case_tac "ntfn_obj rv"; clarsimp simp: ntfn_relation_def)
-    apply (case_tac isBlocking; simp)
-     apply (rule corres_guard_imp)
-       apply (rule corres_split[OF setThreadState_corres])
-          apply (clarsimp simp: thread_state_relation_def)
-         apply (rule corres_split[OF setNotification_corres])
-            apply (clarsimp simp: ntfn_relation_def)
-           apply (rule maybeReturnSc_corres)
-          apply (wpsimp wp: maybe_return_sc_weak_valid_sched_action)
-         apply wpsimp
-        apply wpsimp
-        apply (wpsimp wp: set_thread_state_weak_valid_sched_action)
-       apply wpsimp
-      apply clarsimp
-      apply (rule conjI, fastforce simp: valid_tcb_state_def valid_ntfn_def)+
-      apply (erule delta_sym_refs[OF invs_sym_refs]; clarsimp split: if_split_asm)
-        apply (fastforce simp: state_refs_of_def get_refs_def tcb_st_refs_of_def
-                               pred_tcb_at_def obj_at_def is_obj_defs
-                        split: if_split_asm option.splits)+
-     apply (fastforce simp: valid_tcb_state'_def)
-    apply (corresKsimp corres: doNBRecvFailedTransfer_corres)
-    apply fastforce
-   \<comment> \<open>WaitingNtfn\<close>
-   apply (case_tac isBlocking; simp)
-    apply (rule corres_guard_imp)
-      apply (rule corres_split[OF setThreadState_corres])
-         apply (clarsimp simp: thread_state_relation_def)
-        apply (rule corres_split[OF tcbEPAppend_corres])
-          apply (rule corres_split[OF setNotification_corres])
-             apply (clarsimp simp: ntfn_relation_def)
-            apply (rule maybeReturnSc_corres)
-           apply (wpsimp wp: maybe_return_sc_weak_valid_sched_action)
-          apply wpsimp
-         apply wpsimp
-        apply wpsimp
-       apply (wpsimp wp: set_thread_state_weak_valid_sched_action)
-      apply (wpsimp wp: hoare_vcg_ball_lift2)
-     apply clarsimp
-     apply (rule conjI, fastforce simp: valid_tcb_state_def valid_ntfn_def)+
-     apply (erule delta_sym_refs[OF invs_sym_refs]; clarsimp split: if_split_asm)
-       apply (fastforce simp: state_refs_of_def get_refs_def tcb_st_refs_of_def
-                              pred_tcb_at_def obj_at_def is_obj_defs
-                       split: if_split_asm option.splits)+
-    apply (fastforce simp: valid_tcb_state'_def valid_ntfn'_def)
-   apply (corresKsimp corres: doNBRecvFailedTransfer_corres)
-   apply fastforce
-  \<comment> \<open>ActiveNtfn\<close>
-  apply (rule corres_guard_imp)
-    apply (clarsimp simp: badge_register_def badgeRegister_def)
-    apply (rule corres_split[OF asUser_setRegister_corres])
-      apply (rule corres_split[OF setNotification_corres])
-         apply (clarsimp simp: ntfn_relation_def)
-        apply (rule corres_split[OF maybeDonateSc_corres])
-          apply (rule corres_split_eqr[OF get_tcb_obj_ref_corres])
-             apply (clarsimp simp: tcb_relation_def)
-            apply (rule ifCondRefillUnblockCheck_corres)
-           apply (wpsimp wp: get_tcb_obj_ref_wp)
-          apply (wpsimp wp: threadGet_wp)
-         apply (rule_tac Q'="\<lambda>_. tcb_at thread and active_scs_valid and pspace_distinct
-                                and pspace_aligned and valid_objs"
-                in hoare_strengthen_post[rotated])
-          apply (clarsimp simp: obj_at_def is_tcb)
-          apply (erule (1) valid_objsE)
-          apply (fastforce simp: valid_obj_def valid_tcb_def obj_at_def opt_map_def opt_pred_def is_sc_obj
-                          split: option.splits)
-         apply (wpsimp wp: abs_typ_at_lifts)
-        apply (rule_tac Q'="\<lambda>_. tcb_at' thread and valid_objs'" in hoare_strengthen_post[rotated])
-         apply (clarsimp simp: obj_at'_def projectKOs split: option.split)
-        apply wpsimp
-       apply (wpsimp wp: set_ntfn_minor_invs)
-      apply (wpsimp wp: set_ntfn_minor_invs')
-     apply (wpsimp wp: hoare_vcg_imp_lift' simp: valid_ntfn_def)
-    apply (wpsimp wp: hoare_vcg_imp_lift')
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-   apply (clarsimp simp: obj_at_def live_def live_ntfn_def valid_ntfn_def)
-   apply (frule_tac p=cap_ntfn_ptr in sym_refs_ko_atD[rotated])
-    apply (fastforce simp: obj_at_def)
+lemma setupCallerCap_vp[wp]:
+  "\<lbrace>valid_pspace' and tcb_at' sender and tcb_at' rcvr\<rbrace>
+   setupCallerCap sender rcvr grant \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
+  apply (simp add: valid_pspace'_def setupCallerCap_def getThreadCallerSlot_def
+                   getThreadReplySlot_def locateSlot_conv getSlotCap_def)
+  apply (wp getCTE_wp)
+  apply (rule_tac Q'="\<lambda>_. valid_pspace' and
+                         tcb_at' sender and tcb_at' rcvr"
+                  in hoare_post_imp)
+   apply (clarsimp simp: valid_cap'_def o_def cte_wp_at_ctes_of isCap_simps
+                         valid_pspace'_def)
+   apply (frule(1) ctes_of_valid', simp add: valid_cap'_def capAligned_def)
    apply clarsimp
-   apply (fold fun_upd_def)
-   apply (drule sym[of "state_refs_of _ _"])
-   apply simp
-  apply (fastforce intro!: if_live_then_nonz_capE'
-                     simp: valid_ntfn'_def obj_at'_def projectKOs live_ntfn'_def ko_wp_at'_def)
+  apply (wp | simp add: valid_pspace'_def valid_tcb_state'_def)+
   done
 
-declare lookup_cap_valid' [wp]
-
-lemma thread_set_fault_valid_sched_except_blocked_except_released_ipc_qs[wp]:
-  "thread_set (tcb_fault_update f) t \<lbrace>valid_sched_except_blocked_except_released_ipc_qs\<rbrace>"
-  by (wpsimp wp: thread_set_fault_valid_sched_pred simp: valid_sched_2_def)
+declare haskell_assert_inv[wp del]
 
-lemma sendFaultIPC_corres:
-  assumes "fr f f'"
-  assumes "cap_relation cap cap'"
-  shows
-  "corres (fr \<oplus> (=))
-          (invs and valid_list and valid_sched_action and active_scs_valid
-                and st_tcb_at active thread and scheduler_act_not thread
-                and current_time_bounded
-                and (\<lambda>s. can_donate \<longrightarrow> bound_sc_tcb_at (\<lambda>sc. sc \<noteq> None) thread s)
-                and valid_cap cap and K (valid_fault_handler cap) and K (valid_fault f))
-          (invs' and valid_cap' cap')
-          (send_fault_ipc thread cap f can_donate)
-          (sendFaultIPC thread cap' f' can_donate)"
-  using assms
-  apply (clarsimp simp: send_fault_ipc_def sendFaultIPC_def)
-  apply (rule corres_gen_asm)
-  apply (rule corres_gen_asm)
-  apply (cases cap; simp add: valid_fault_handler_def tcb_relation_def)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split)
-       apply (rule threadset_corres; clarsimp simp: tcb_relation_def fault_rel_optionation_def)
-      apply (rule corres_split)
-         apply (rule sendIPC_corres, clarsimp)
-        apply (rule corres_trivial, clarsimp)
-       apply (wpsimp wp: threadSet_invs_trivial thread_set_invs_but_fault_tcbs
-                         thread_set_no_change_tcb_state thread_set_no_change_tcb_sched_context
-                         thread_set_cte_wp_at_trivial ex_nonz_cap_to_pres hoare_weak_lift_imp
-                   simp: ran_tcb_cap_cases valid_cap_def)+
-   apply (frule pred_tcb_at_tcb_at, clarsimp)
-   apply (erule (1) st_tcb_ex_cap[OF _ invs_iflive])
-   apply (case_tac st; clarsimp)
-  apply (clarsimp, frule pred_tcb_at_tcb_at)
-  apply (frule cross_relF[OF _ tcb_at'_cross_rel[where t=thread]], fastforce)
-  apply (fastforce simp: invs'_def valid_tcb_def valid_release_queue_def
-                         valid_release_queue'_def valid_cap'_def obj_at'_def inQ_def)
-  done
-
-lemma gets_the_noop_corres:
-  assumes P: "\<And>s. P s \<Longrightarrow> f s \<noteq> None"
-  shows "corres dc P P' (gets_the f) (return x)"
-  apply (clarsimp simp: corres_underlying_def gets_the_def
-                        return_def gets_def bind_def get_def)
-  apply (clarsimp simp: assert_opt_def return_def dest!: P)
-  done
+lemma setupCallerCap_iflive[wp]:
+  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' sender and pspace_aligned' and pspace_distinct'\<rbrace>
+   setupCallerCap sender rcvr grant
+   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
+  unfolding setupCallerCap_def getThreadCallerSlot_def
+            getThreadReplySlot_def locateSlot_conv
+  by (wp getSlotCap_cte_wp_at
+          | simp add: unique_master_reply_cap'
+          | strengthen eq_imp_strg
+          | wp (once) hoare_drop_imp[where f="getCTE rs" for rs])+
+
+lemma setupCallerCap_ifunsafe[wp]:
+  "\<lbrace>if_unsafe_then_cap' and valid_objs' and
+    ex_nonz_cap_to' rcvr and tcb_at' rcvr and pspace_aligned' and pspace_distinct'\<rbrace>
+   setupCallerCap sender rcvr grant
+   \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
+  unfolding setupCallerCap_def getThreadCallerSlot_def
+            getThreadReplySlot_def locateSlot_conv
+  apply (wp getSlotCap_cte_wp_at
+       | simp add: unique_master_reply_cap' | strengthen eq_imp_strg
+       | wp (once) hoare_drop_imp[where f="getCTE rs" for rs])+
+   apply (rule_tac Q'="\<lambda>rv. valid_objs' and tcb_at' rcvr and ex_nonz_cap_to' rcvr"
+                in hoare_post_imp)
+    apply (clarsimp simp: ex_nonz_tcb_cte_caps' tcbCallerSlot_def
+                          objBits_def objBitsKO_def dom_def cte_level_bits_def)
+   apply (wp sts_valid_objs' | simp)+
+     apply (clarsimp simp: valid_tcb_state'_def)+
+  done
+
+lemma setupCallerCap_global_refs'[wp]:
+  "\<lbrace>valid_global_refs'\<rbrace>
+     setupCallerCap sender rcvr grant
+   \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
+  unfolding setupCallerCap_def getThreadCallerSlot_def
+            getThreadReplySlot_def locateSlot_conv
+  by (wp
+      | simp add: o_def unique_master_reply_cap'
+      | strengthen eq_imp_strg
+      | wp (once) getCTE_wp
+      | wp (once) hoare_vcg_imp_lift' hoare_vcg_ex_lift | clarsimp simp: cte_wp_at_ctes_of)+
+
+crunch setupCallerCap
+  for valid_arch'[wp]: "valid_arch_state'"
+  (wp: hoare_drop_imps)
 
-end
+crunch setupCallerCap
+  for typ'[wp]: "\<lambda>s. P (typ_at' T p s)"
 
-crunch sendFaultIPC, receiveIPC, receiveSignal
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: crunch_wps hoare_vcg_all_lift simp: crunch_simps)
-
-global_interpretation sendFaultIPC: typ_at_all_props' "sendFaultIPC t cap f d"
-  by typ_at_props'
-global_interpretation receiveIPC: typ_at_all_props' "receiveIPC t cap b r"
-  by typ_at_props'
-global_interpretation receiveSignal: typ_at_all_props' "receiveSignal t cap b"
-  by typ_at_props'
-
-lemma setCTE_valid_queues[wp]:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> setCTE ptr val \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  by (wp valid_queues_lift setCTE_pred_tcb_at')
-
-crunch cteInsert
- for vq[wp]: "Invariants_H.valid_queues"
-  (wp: crunch_wps)
+crunch setupCallerCap
+  for irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+  (wp: hoare_drop_imps)
 
-lemma getSlotCap_cte_wp_at:
-  "\<lbrace>\<top>\<rbrace> getSlotCap sl \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>c. cteCap c = rv) sl\<rbrace>"
-  apply (simp add: getSlotCap_def)
-  apply (wp getCTE_wp)
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  done
+lemma setupCallerCap_irq_handlers'[wp]:
+  "\<lbrace>valid_irq_handlers'\<rbrace>
+   setupCallerCap sender rcvr grant
+   \<lbrace>\<lambda>rv. valid_irq_handlers'\<rbrace>"
+  unfolding setupCallerCap_def getThreadCallerSlot_def
+            getThreadReplySlot_def locateSlot_conv
+  by (wp hoare_drop_imps | simp)+
 
 lemma cteInsert_cap_to':
   "\<lbrace>ex_nonz_cap_to' p and cte_wp_at' (\<lambda>c. cteCap c = NullCap) dest\<rbrace>
@@ -5139,9 +3575,10 @@ lemma cteInsert_cap_to':
    apply (clarsimp simp: cte_wp_at_ctes_of)+
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+crunch setExtraBadge
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
 
-crunch setExtraBadge, doIPCTransfer
+crunch doIPCTransfer
   for cap_to'[wp]: "ex_nonz_cap_to' p"
   (ignore: transferCapsToSlots
        wp: crunch_wps transferCapsToSlots_pres2 cteInsert_cap_to' hoare_vcg_const_Ball_lift
@@ -5152,985 +3589,579 @@ lemma st_tcb_idle':
    (t = ksIdleThread s) \<longrightarrow> P IdleThreadState"
   by (clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def idle_tcb'_def)
 
+crunch getThreadCallerSlot
+  for idle'[wp]: "valid_idle'"
+crunch getThreadReplySlot
+  for idle'[wp]: "valid_idle'"
 
-crunch setExtraBadge, receiveIPC
+crunch setupCallerCap
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (simp: updateObject_cte_inv wp: crunch_wps)
+
+lemma setupCallerCap_idle'[wp]:
+  "\<lbrace>valid_idle' and valid_pspace' and
+    (\<lambda>s. st \<noteq> ksIdleThread s \<and> rt \<noteq> ksIdleThread s)\<rbrace>
+   setupCallerCap st rt gr
+   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
+  by (simp add: setupCallerCap_def capRange_def | wp hoare_drop_imps)+
+
+crunch doIPCTransfer
+  for idle'[wp]: "valid_idle'"
+  (wp: crunch_wps simp: crunch_simps ignore: transferCapsToSlots)
+
+crunch setExtraBadge
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+crunch receiveIPC
   for it[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and irqs_masked' [wp]: "irqs_masked'"
   (ignore: transferCapsToSlots
-       wp: transferCapsToSlots_pres2 crunch_wps hoare_vcg_all_lift
+       wp: transferCapsToSlots_pres2 crunch_wps hoare_vcg_const_Ball_lift
      simp: crunch_simps ball_conj_distrib)
 
-crunch copyMRs, doIPCTransfer
+crunch setupCallerCap
+  for irq_states'[wp]: valid_irq_states'
+  (wp: crunch_wps)
+
+crunch setupCallerCap
+  for pde_mappings'[wp]: valid_pde_mappings'
+  (wp: crunch_wps)
+
+crunch receiveIPC
+  for irqs_masked'[wp]: "irqs_masked'"
+  (wp: crunch_wps rule: irqs_masked_lift)
+
+crunch getThreadCallerSlot
+  for ct_not_inQ[wp]: "ct_not_inQ"
+crunch getThreadReplySlot
+  for ct_not_inQ[wp]: "ct_not_inQ"
+
+lemma setupCallerCap_ct_not_inQ[wp]:
+  "\<lbrace>ct_not_inQ\<rbrace> setupCallerCap sender receiver grant \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+  apply (simp add: setupCallerCap_def)
+  apply (wp hoare_drop_imp setThreadState_ct_not_inQ)
+  done
+
+crunch copyMRs
   for ksQ'[wp]: "\<lambda>s. P (ksReadyQueues s)"
-  and ct'[wp]: "\<lambda>s. P (ksCurThread s)"
   (wp: mapM_wp' hoare_drop_imps simp: crunch_simps)
 
+crunch doIPCTransfer
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  (wp: hoare_drop_imps hoare_vcg_split_case_option
+       mapM_wp'
+   simp: split_def zipWithM_x_mapM)
+
+crunch doIPCTransfer
+  for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
+  (wp: hoare_drop_imps hoare_vcg_split_case_option
+       mapM_wp'
+   simp: split_def zipWithM_x_mapM)
+
 lemma asUser_ct_not_inQ[wp]:
-  "\<lbrace>ct_not_inQ\<rbrace> asUser tptr f \<lbrace>\<lambda>rv. ct_not_inQ\<rbrace>"
+  "\<lbrace>ct_not_inQ\<rbrace> asUser t m \<lbrace>\<lambda>rv. ct_not_inQ\<rbrace>"
   apply (simp add: asUser_def split_def)
   apply (wp hoare_drop_imps threadSet_not_inQ | simp)+
   done
 
-crunch copyMRs, doIPCTransfer
+crunch copyMRs
   for ct_not_inQ[wp]: "ct_not_inQ"
   (wp: mapM_wp' hoare_drop_imps simp: crunch_simps)
 
-lemma ntfn_q_refs_no_bound_refs':
-  "rf : ntfn_q_refs_of' (ntfnObj ob) \<Longrightarrow> rf ~: ntfn_bound_refs' (ntfnBoundTCB ob')"
+crunch doIPCTransfer
+  for ct_not_inQ[wp]: "ct_not_inQ"
+  (ignore: getRestartPC setRegister transferCapsToSlots
+   wp: hoare_drop_imps hoare_vcg_split_case_option
+       mapM_wp'
+   simp: split_def zipWithM_x_mapM)
+
+lemma ntfn_q_refs_no_bound_refs': "rf : ntfn_q_refs_of' (ntfnObj ob) \<Longrightarrow> rf ~: ntfn_bound_refs' (ntfnBoundTCB ob')"
   by (auto simp add: ntfn_q_refs_of'_def ntfn_bound_refs'_def
            split: Structures_H.ntfn.splits)
 
-lemma completeSignal_invs':
-  "\<lbrace>invs' and tcb_at' tcb and ex_nonz_cap_to' tcb\<rbrace>
-   completeSignal ntfnptr tcb
+lemma completeSignal_invs:
+  "\<lbrace>invs' and tcb_at' tcb\<rbrace>
+     completeSignal ntfnptr tcb
    \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: completeSignal_def)
   apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (wpsimp wp: refillUnblockCheck_invs' threadGet_wp)
-      apply (rule hoare_strengthen_post[where Q'="\<lambda>_. invs'"])
-       apply (wpsimp wp: maybeDonateSc_invs')
-      apply (clarsimp simp: obj_at'_def)
-     apply (wpsimp wp: set_ntfn_minor_invs')
-    apply (wpsimp wp: hoare_vcg_ex_lift hoare_weak_lift_imp simp: valid_ntfn'_def)
-   apply wpsimp
-  apply clarsimp
-  apply (intro conjI impI)
-   apply (fastforce dest: ntfn_ko_at_valid_objs_valid_ntfn'
-                    simp: valid_ntfn'_def)
-  apply (fastforce intro: if_live_then_nonz_capE'
-                    simp: ko_wp_at'_def obj_at'_def projectKOs live_ntfn'_def)
-  done
+  apply (rule hoare_pre)
+   apply (wp set_ntfn_minor_invs' | wpc | simp)+
+    apply (rule_tac Q'="\<lambda>_ s. (state_refs_of' s ntfnptr = ntfn_bound_refs' (ntfnBoundTCB ntfn))
+                           \<and> ntfn_at' ntfnptr s
+                           \<and> valid_ntfn' (ntfnObj_update (\<lambda>_. Structures_H.ntfn.IdleNtfn) ntfn) s
+                           \<and> ((\<exists>y. ntfnBoundTCB ntfn = Some y) \<longrightarrow> ex_nonz_cap_to' ntfnptr s)
+                           \<and> ntfnptr \<noteq> ksIdleThread s"
+                          in hoare_strengthen_post)
+     apply ((wp hoare_vcg_ex_lift hoare_weak_lift_imp | wpc | simp add: valid_ntfn'_def)+)[1]
+    apply (clarsimp simp: obj_at'_def state_refs_of'_def typ_at'_def ko_wp_at'_def  projectKOs split: option.splits)
+    apply (blast dest: ntfn_q_refs_no_bound_refs')
+   apply wp
+  apply (subgoal_tac "valid_ntfn' ntfn s")
+   apply (subgoal_tac "ntfnptr \<noteq> ksIdleThread s")
+    apply (fastforce simp: valid_ntfn'_def valid_bound_tcb'_def projectKOs ko_at_state_refs_ofD'
+                     elim: obj_at'_weakenE
+                           if_live_then_nonz_capD'[OF invs_iflive'
+                                                      obj_at'_real_def[THEN meta_eq_to_obj_eq,
+                                                                       THEN iffD1]])
+   apply (fastforce simp: valid_idle'_def pred_tcb_at'_def obj_at'_def projectKOs
+                   dest!: invs_valid_idle')
+  apply (fastforce dest: invs_valid_objs' ko_at_valid_objs'
+                   simp: valid_obj'_def projectKOs)[1]
+  done
+
+lemma setupCallerCap_urz[wp]:
+  "\<lbrace>untyped_ranges_zero' and valid_pspace' and tcb_at' sender\<rbrace>
+    setupCallerCap sender t g \<lbrace>\<lambda>rv. untyped_ranges_zero'\<rbrace>"
+  apply (simp add: setupCallerCap_def getSlotCap_def
+                   getThreadCallerSlot_def getThreadReplySlot_def
+                   locateSlot_conv)
+  apply (wp getCTE_wp')
+  apply (rule_tac Q'="\<lambda>_. untyped_ranges_zero' and valid_mdb' and valid_objs'" in hoare_post_imp)
+   apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def untyped_derived_eq_def
+                         isCap_simps)
+  apply (wp sts_valid_pspace_hangers)
+  apply (clarsimp simp: valid_tcb_state'_def)
+  done
+
+lemmas threadSet_urz = untyped_ranges_zero_lift[where f="cteCaps_of", OF _ threadSet_cteCaps_of]
 
-lemma maybeReturnSc_ex_nonz_cap_to'[wp]:
-  "maybeReturnSc nptr tptr \<lbrace>ex_nonz_cap_to' t\<rbrace>"
-  by (wpsimp wp: hoare_drop_imps threadSet_cap_to'
-           simp: maybeReturnSc_def tcb_cte_cases_def cteCaps_of_def)
-
-lemma maybeReturnSc_st_tcb_at'[wp]:
-  "maybeReturnSc nptr tptr \<lbrace>\<lambda>s. P (st_tcb_at' Q t s)\<rbrace>"
-  by (wpsimp wp: hoare_drop_imps threadSet_cap_to' threadSet_pred_tcb_no_state
-           simp: maybeReturnSc_def tcb_cte_cases_def cteCaps_of_def)
-
-crunch scheduleTCB
-  for invs'[wp]: invs'
-  and ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' p"
-  and valid_ntfn'[wp]: "valid_ntfn' ntfn"
-  and valid_bound_tcb'[wp]: "valid_bound_tcb' tcb"
-  and valid_bound_sc'[wp]: "valid_bound_sc' sc"
-  (wp: hoare_drop_imps)
+crunch doIPCTransfer
+  for urz[wp]: "untyped_ranges_zero'"
+  (ignore: threadSet wp: threadSet_urz crunch_wps simp: zipWithM_x_mapM)
+
+crunch receiveIPC
+  for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  (wp: crunch_wps transferCapsToSlots_pres1 simp: zipWithM_x_mapM ignore: constOnFailure)
+
+crunch possibleSwitchTo
+  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
+  (wp: crunch_wps ignore: constOnFailure)
+lemmas possibleSwitchToTo_cteCaps_of[wp]
+    = cteCaps_of_ctes_of_lift[OF possibleSwitchTo_ctes_of]
+
+crunch asUser
+  for valid_bitmaps[wp]: valid_bitmaps
+  (rule: valid_bitmaps_lift wp: crunch_wps)
+
+crunch setupCallerCap, possibleSwitchTo, doIPCTransfer
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and valid_bitmaps[wp]: valid_bitmaps
+  (rule: sym_heap_sched_pointers_lift wp: crunch_wps simp: crunch_simps)
 
-crunch doNBRecvFailedTransfer
-  for invs'[wp]: invs'
+(* t = ksCurThread s *)
+lemma ri_invs' [wp]:
+  "\<lbrace>invs' and sch_act_not t
+          and ct_in_state' simple'
+          and st_tcb_at' simple' t
+          and ex_nonz_cap_to' t
+          and (\<lambda>s. \<forall>r \<in> zobj_refs' cap. ex_nonz_cap_to' r s)\<rbrace>
+  receiveIPC t cap isBlocking
+  \<lbrace>\<lambda>_. invs'\<rbrace>" (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (clarsimp simp: receiveIPC_def)
+  apply (rule bind_wp [OF _ get_ep_sp'])
+  apply (rule bind_wp [OF _ gbn_sp'])
+  apply (rule bind_wp)
+  (* set up precondition for old proof *)
+   apply (rule_tac P''="ko_at' ep (capEPPtr cap) and ?pre" in hoare_vcg_if_split)
+    apply (wp completeSignal_invs)
+   apply (case_tac ep)
+     \<comment> \<open>endpoint = RecvEP\<close>
+     apply (simp add: invs'_def valid_state'_def)
+     apply (rule hoare_pre, wpc, wp valid_irq_node_lift)
+      apply (simp add: valid_ep'_def)
+      apply (wp sts_sch_act' hoare_vcg_const_Ball_lift valid_irq_node_lift
+                setThreadState_ct_not_inQ
+                asUser_urz
+           | simp add: doNBRecvFailedTransfer_def cteCaps_of_def)+
+     apply (clarsimp simp: valid_tcb_state'_def pred_tcb_at' o_def)
+     apply (rule conjI, clarsimp elim!: obj_at'_weakenE)
+     apply (frule obj_at_valid_objs')
+      apply (clarsimp simp: valid_pspace'_def)
+     apply (drule(1) sym_refs_ko_atD')
+     apply (drule simple_st_tcb_at_state_refs_ofD')
+     apply (drule bound_tcb_at_state_refs_ofD')
+     apply (clarsimp simp: st_tcb_at_refs_of_rev' valid_ep'_def
+                           valid_obj'_def projectKOs tcb_bound_refs'_def
+                    dest!: isCapDs)
+     apply (rule conjI, clarsimp)
+      apply (drule (1) bspec)
+      apply (clarsimp dest!: st_tcb_at_state_refs_ofD')
+      apply (clarsimp simp: set_eq_subset)
+     apply (rule conjI, erule delta_sym_refs)
+       apply (clarsimp split: if_split_asm)
+        apply (rename_tac list one two three fur five six seven eight nine ten eleven)
+        apply (subgoal_tac "set list \<times> {EPRecv} \<noteq> {}")
+         apply (safe ; solves \<open>auto\<close>)
+        apply fastforce
+       apply fastforce
+      apply (clarsimp split: if_split_asm)
+     apply (fastforce simp: valid_pspace'_def global'_no_ex_cap idle'_not_queued)
+   \<comment> \<open>endpoint = IdleEP\<close>
+    apply (simp add: invs'_def valid_state'_def)
+    apply (rule hoare_pre, wpc, wp valid_irq_node_lift)
+     apply (simp add: valid_ep'_def)
+     apply (wp sts_sch_act' valid_irq_node_lift
+               setThreadState_ct_not_inQ
+               asUser_urz
+          | simp add: doNBRecvFailedTransfer_def cteCaps_of_def)+
+    apply (clarsimp simp: pred_tcb_at' valid_tcb_state'_def o_def)
+    apply (rule conjI, clarsimp elim!: obj_at'_weakenE)
+    apply (subgoal_tac "t \<noteq> capEPPtr cap")
+     apply (drule simple_st_tcb_at_state_refs_ofD')
+     apply (drule ko_at_state_refs_ofD')
+     apply (drule bound_tcb_at_state_refs_ofD')
+     apply (clarsimp dest!: isCapDs)
+     apply (rule conjI, erule delta_sym_refs)
+       apply (clarsimp split: if_split_asm)
+      apply (clarsimp simp: tcb_bound_refs'_def
+                      dest: symreftype_inverse'
+                     split: if_split_asm)
+     apply (fastforce simp: global'_no_ex_cap)
+    apply (clarsimp simp: obj_at'_def pred_tcb_at'_def projectKOs)
+   \<comment> \<open>endpoint = SendEP\<close>
+   apply (simp add: invs'_def valid_state'_def)
+   apply (rename_tac list)
+   apply (case_tac list, simp_all split del: if_split)
+   apply (rename_tac sender queue)
+   apply (rule hoare_pre)
+    apply (wp valid_irq_node_lift hoare_drop_imps setEndpoint_valid_mdb'
+              set_ep_valid_objs' sts_st_tcb' sts_sch_act'
+              setThreadState_ct_not_inQ
+              possibleSwitchTo_ct_not_inQ hoare_vcg_all_lift
+              setEndpoint_ksQ setEndpoint_ct'
+         | simp add: valid_tcb_state'_def case_bool_If
+                     case_option_If
+              split del: if_split cong: if_cong
+        | wp (once) sch_act_sane_lift hoare_vcg_conj_lift hoare_vcg_all_lift
+                  untyped_ranges_zero_lift)+
+   apply (clarsimp split del: if_split simp: pred_tcb_at')
+   apply (frule obj_at_valid_objs')
+    apply (clarsimp simp: valid_pspace'_def)
+   apply (frule(1) ct_not_in_epQueue, clarsimp, clarsimp)
+   apply (drule(1) sym_refs_ko_atD')
+   apply (drule simple_st_tcb_at_state_refs_ofD')
+   apply (clarsimp simp: projectKOs valid_obj'_def valid_ep'_def
+                         st_tcb_at_refs_of_rev' conj_ac
+              split del: if_split
+                   cong: if_cong)
+   apply (subgoal_tac "sch_act_not sender s")
+    prefer 2
+    apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
+   apply (drule st_tcb_at_state_refs_ofD')
+   apply (simp only: conj_ac(1, 2)[where Q="sym_refs R" for R])
+   apply (subgoal_tac "distinct (ksIdleThread s # capEPPtr cap # t # sender # queue)")
+    apply (rule conjI)
+     apply (clarsimp simp: ep_redux_simps' cong: if_cong)
+     apply (erule delta_sym_refs)
+      apply (clarsimp split: if_split_asm)
+     apply (fastforce simp: tcb_bound_refs'_def
+                      dest: symreftype_inverse'
+                     split: if_split_asm)
+    apply (clarsimp simp: singleton_tuple_cartesian split: list.split
+            | rule conjI | drule(1) bspec
+            | drule st_tcb_at_state_refs_ofD' bound_tcb_at_state_refs_ofD'
+            | clarsimp elim!: if_live_state_refsE)+
+    apply (case_tac cap, simp_all add: isEndpointCap_def)
+    apply (clarsimp simp: global'_no_ex_cap)
+   apply (rule conjI
+           | clarsimp simp: singleton_tuple_cartesian split: list.split
+           | clarsimp elim!: if_live_state_refsE
+           | clarsimp simp: global'_no_ex_cap idle'_not_queued' idle'_no_refs tcb_bound_refs'_def
+           | drule(1) bspec | drule st_tcb_at_state_refs_ofD'
+           | clarsimp simp: set_eq_subset dest!: bound_tcb_at_state_refs_ofD' )+
+  apply (rule hoare_pre)
+   apply (wp getNotification_wp | wpc | clarsimp)+
+  done
 
 (* t = ksCurThread s *)
 lemma rai_invs'[wp]:
-  "\<lbrace>invs' and st_tcb_at' active' t
+  "\<lbrace>invs' and sch_act_not t
+          and st_tcb_at' simple' t
           and ex_nonz_cap_to' t
           and (\<lambda>s. \<forall>r \<in> zobj_refs' cap. ex_nonz_cap_to' r s)
           and (\<lambda>s. \<exists>ntfnptr. isNotificationCap cap
                  \<and> capNtfnPtr cap = ntfnptr
-                 \<and> obj_at' (\<lambda>ko. ntfnBoundTCB ko = None \<or> ntfnBoundTCB ko = Some t) ntfnptr s)\<rbrace>
-   receiveSignal t cap isBlocking
+                 \<and> obj_at' (\<lambda>ko. ntfnBoundTCB ko = None \<or> ntfnBoundTCB ko = Some t)
+                           ntfnptr s)\<rbrace>
+    receiveSignal t cap isBlocking
    \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: receiveSignal_def doNBRecvFailedTransfer_def valid_idle'_asrt_def)
-  apply (intro bind_wp [OF _ stateAssert_sp])
+  apply (simp add: receiveSignal_def)
   apply (rule bind_wp [OF _ get_ntfn_sp'])
   apply (rename_tac ep)
-  apply (case_tac "ntfnObj ep"; clarsimp)
-    \<comment> \<open>IdleNtfn\<close>
-    apply (wpsimp wp: setNotification_invs' maybeReturnSc_invs' sts_invs_minor' simp: live_ntfn'_def)
-    apply (clarsimp simp: pred_tcb_at' cong: conj_cong)
-    apply (fastforce simp: valid_idle'_def idle_tcb'_def valid_tcb_state'_def  valid_ntfn'_def
-                           valid_bound_obj'_def valid_obj'_def valid_cap'_def isCap_simps
-                           pred_tcb_at'_def obj_at'_def projectKOs
-                     dest: invs_valid_objs' split: option.splits)
-   \<comment> \<open>ActiveNtfn\<close>
-   apply (wpsimp wp: maybeDonateSc_invs' setNotification_invs' hoare_vcg_imp_lift')
-   apply (fastforce simp: valid_obj'_def valid_ntfn'_def isCap_simps
-                          pred_tcb_at'_def obj_at'_def projectKOs
-                    dest: invs_valid_objs')
-  \<comment> \<open>WaitingNtfn\<close>
-  apply (wpsimp wp: setNotification_invs' maybeReturnSc_invs')
-     apply (rule_tac Q'="\<lambda>_ _. ntfnBoundTCB ep = None" in hoare_post_add)
-     apply (clarsimp simp: valid_ntfn'_def cong: conj_cong)
-       apply (wpsimp wp: maybeReturnSc_invs' tcbEPAppend_rv_wf' sts_invs_minor'
-                         hoare_vcg_ball_lift hoare_drop_imps)+
-  apply (frule invs_valid_objs')
-  apply (erule valid_objsE')
-   apply (fastforce simp: obj_at'_def projectKOs)
-  apply (clarsimp simp: valid_obj'_def valid_ntfn'_def valid_tcb_state'_def valid_cap'_def
-                        isCap_simps sym_refs_asrt_def pred_tcb_at'_def obj_at'_def projectKOs)
-  apply (rule conjI, clarsimp)
-  apply (rule conjI, clarsimp)
-  apply (rule conjI, clarsimp)
-  apply (rule context_conjI)
-   apply (drule_tac ko=ep in sym_refs_ko_atD'[rotated])
-    apply (fastforce simp: obj_at'_def projectKOs)
-   apply (fastforce simp: tcb_bound_refs'_def refs_of_rev' get_refs_def ko_wp_at'_def
-                   split: option.splits)
-  apply (intro conjI)
-   apply (drule_tac ko=ep in sym_refs_ko_atD'[rotated])
-    apply (fastforce simp: obj_at'_def projectKOs)
-   apply (fastforce simp: tcb_bound_refs'_def refs_of_rev' get_refs_def ko_wp_at'_def
-                   split: option.splits)
-  apply (clarsimp simp: valid_idle'_def idle_tcb'_def)
-  apply (case_tac "tcbState obj"; clarsimp simp: obj_at_simps)
-  done
-
-lemma updateReply_reply_at'_wp:
-  "\<lbrace>\<lambda>s. P (if p = rptr then True else reply_at' p s)\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>rv s. P (reply_at' p s)\<rbrace>"
-  apply (rule hoare_weaken_pre, rule updateReply_obj_at')
-  apply (clarsimp simp: obj_at'_real_def split: if_splits)
-  done
-
-crunch setThreadState
-  for tcbSCs_of[wp]: "\<lambda>s. P (tcbSCs_of s)"
-  (ignore: threadSet wp: threadSet_tcbSCs_of_inv)
-
-crunch replyUnlink
-  for tcbSCs_of[wp]: "\<lambda>s. P (tcbSCs_of s)"
-  and scs_of'[wp]: "\<lambda>s. P (scs_of' s)"
-
-lemma replyUnlink_misc_heaps[wp]:
-  "replyUnlink rPtr tPtr \<lbrace>\<lambda>s. P (tcbSCs_of s) (scTCBs_of s) (scReplies_of s) (replySCs_of s)\<rbrace>"
-  by (rule hoare_weaken_pre, wps, wp, simp)
-
-lemma schedContextUpdateConsumed_scReplies_of[wp]:
-  "schedContextUpdateConsumed scPtr \<lbrace>\<lambda>s. P (scReplies_of s) \<rbrace>"
-  unfolding schedContextUpdateConsumed_def
-  apply (wpsimp simp: setSchedContext_def)
-  apply (clarsimp simp: opt_map_def if_distrib)
-  apply (erule subst[where P=P, rotated], rule ext)
-  apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def split: option.splits)
-  done
-
-lemma schedContextUpdateConsumed_sc_tcbs_of[wp]:
-  "schedContextUpdateConsumed scPtr \<lbrace>\<lambda>s. P (scTCBs_of s)\<rbrace>"
-  unfolding schedContextUpdateConsumed_def
-  apply (wpsimp simp: setSchedContext_def)
-  apply (clarsimp simp: opt_map_def if_distrib)
-  apply (erule subst[where P=P, rotated], rule ext)
-  apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def split: option.splits)
-  done
-
-crunch schedContextUpdateConsumed
-  for tcbSCs_of[wp]: "\<lambda>s. P (tcbSCs_of s)"
-
-crunch doIPCTransfer
-  for replySCs_of[wp]: "\<lambda>s. P (replySCs_of s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma schedContextUpdateConsumed_misc_heaps[wp]:
-  "schedContextUpdateConsumed scPtr
-   \<lbrace>\<lambda>s. P (scReplies_of s) (replySCs_of s) (tcbSCs_of s) (scTCBs_of s)\<rbrace>"
-  by (rule hoare_weaken_pre, wps, wp, simp)
-
-crunch doIPCTransfer
-  for scs_replies_of[wp]: "\<lambda>s. P (scReplies_of s) (replySCs_of s)"
-  (wp: crunch_wps ignore: setSchedContext simp: zipWithM_x_mapM)
-
-crunch doIPCTransfer
-  for scs_tcbs_of[wp]: "\<lambda>s. P (tcbSCs_of s) (scTCBs_of s)"
-  (wp: crunch_wps threadSet_tcbSCs_of_inv ignore: threadSet simp: zipWithM_x_mapM)
-
-crunch setEndpoint
-  for misc_heaps[wp]: "\<lambda>s. P (scReplies_of s) (replySCs_of s) (tcbSCs_of s) (scTCBs_of s)"
-  (wp: crunch_wps)
-
-lemma replyPush_sym_refs_list_refs_of_replies':
-  "\<lbrace>(\<lambda>s. sym_refs (list_refs_of_replies' s))
-    and valid_replies'
-    and valid_objs'
-    and (\<lambda>s. replyTCBs_of s replyPtr = None) and sym_heap_scReplies\<rbrace>
-   replyPush callerPtr calleePtr replyPtr canDonate
-   \<lbrace>\<lambda>_ s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  supply if_split [split del]
-  unfolding replyPush_def
-  apply wpsimp
-        apply (wpsimp wp: bindsym_heap_scReplies_list_refs_of_replies'
-                          hoare_vcg_if_lift2 hoare_vcg_imp_lift' hoare_vcg_all_lift)
-       apply (rule_tac Q'="(\<lambda>_ s. sym_refs (list_refs_of_replies' s) \<and>
-        (\<forall>rptr scp. (scReplies_of s) scp = Some rptr
-                     \<longrightarrow> replySCs_of s rptr = Some scp) \<and>
-        \<not> is_reply_linked replyPtr s \<and> replySCs_of s replyPtr = None)"
-      in hoare_strengthen_post[rotated])
-        apply (fastforce split: if_splits simp del: comp_apply)
-
-       apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift'
-                         updateReply_list_refs_of_replies'_inv threadGet_wp)+
-  apply (frule valid_replies'_no_tcb_not_linked; clarsimp)
-  apply (intro conjI)
-    apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-   apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-  apply (clarsimp simp: sym_heap_def pred_map_eq)
-  done
-
-lemma replyPush_if_live_then_nonz_cap':
-  "\<lbrace> if_live_then_nonz_cap' and valid_objs' and valid_idle' and
-     ex_nonz_cap_to' replyPtr and ex_nonz_cap_to' callerPtr and ex_nonz_cap_to' calleePtr and
-     sym_heap_tcbSCs and sym_heap_scReplies and (\<lambda>s. callerPtr \<noteq> ksIdleThread s)\<rbrace>
-   replyPush callerPtr calleePtr replyPtr canDonate
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  supply if_split [split del]
-  apply (clarsimp simp: replyPush_def bind_assoc)
-  apply (intro bind_wp[OF _ stateAssert_inv])
-  apply (rule bind_wp[OF _ threadGet_sp'])
-  apply (rule bind_wp[OF _ threadGet_sp'])
-  apply (wpsimp wp: schedContextDonate_if_live_then_nonz_cap' bindScReply_if_live_then_nonz_cap')
-    apply (rule_tac Q'="\<lambda>_. if_live_then_nonz_cap' and ex_nonz_cap_to' replyPtr and
-             valid_objs' and reply_at' replyPtr and ex_nonz_cap_to' calleePtr and
-             (if (\<exists>y. scPtrOptDonated = Some y) \<and> scPtrOptCallee = None \<and> canDonate
-             then \<lambda>s. ex_nonz_cap_to' (the scPtrOptDonated) s \<and>
-                       (\<forall>rp. (scReplies_of s) (the scPtrOptDonated) = Some rp \<longrightarrow>
-                             (replySCs_of s) rp  = Some (the scPtrOptDonated))
-             else \<top>)" in hoare_strengthen_post[rotated], clarsimp split: if_splits simp: pred_map_eq)
-    apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift' hoare_vcg_all_lift)
-   apply (clarsimp cong: conj_cong)
-   apply (wpsimp wp: updateReply_iflive'_weak updateReply_reply_at'_wp updateReply_valid_objs'
-                     hoare_vcg_all_lift hoare_vcg_imp_lift' updateReply_obj_at')
-  apply clarsimp
-  apply (intro conjI)
-   apply (clarsimp simp: valid_reply'_def obj_at'_def)
-  apply (intro allI impI, clarsimp)
-  apply (rename_tac s scp)
-  apply (subgoal_tac "sc_at' scp s \<and> (scTCBs_of s) scp = Some callerPtr \<and> callerPtr \<noteq> idle_thread_ptr")
-   apply (intro conjI)
-    apply (erule if_live_then_nonz_capE')
-    apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKO_sc pred_map_def pred_map_eq_def
-                          live_sc'_def
-                   elim!: opt_mapE)
-   apply (clarsimp simp: sym_heap_def)
-  apply (intro conjI)
-    apply (frule obj_at_ko_at'[where p=callerPtr], clarsimp)
-    apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
-    apply (clarsimp simp: valid_tcb'_def)
-   apply (subgoal_tac "(tcbSCs_of s) callerPtr = Some scp")
-    apply (clarsimp simp: sym_heap_def)
-   apply (clarsimp simp: opt_map_def obj_at'_real_def ko_wp_at'_def projectKOs)
-  apply (clarsimp simp: valid_idle'_def)
-  done
-
-lemma bindScReply_valid_idle':
-  "\<lbrace>valid_idle' and K (scPtr \<noteq> idle_sc_ptr)\<rbrace>
-   bindScReply scPtr replyPtr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  unfolding bindScReply_def
-  by (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift set_reply'.obj_at')
-
-lemma replyPush_valid_idle':
-  "\<lbrace>valid_idle'
-    and valid_pspace'
-    and (\<lambda>s. callerPtr \<noteq> ksIdleThread s)
-    and sym_heap_tcbSCs\<rbrace>
-   replyPush callerPtr calleePtr replyPtr canDonate
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  apply (simp only: replyPush_def)
-  supply if_split [split del]
-  apply wpsimp
-         apply (wpsimp wp: schedContextDonate_valid_idle' bindScReply_valid_idle')+
-       apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
-      apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift')
-     apply (wpsimp wp: threadGet_wp)+
-  apply (clarsimp simp: tcb_at'_ex_eq_all valid_pspace'_def)
-  apply (subgoal_tac "\<forall>kob. valid_reply' kob s \<longrightarrow> valid_reply' (replyTCB_update (\<lambda>_. Some callerPtr) kob) s")
-   apply (subgoal_tac "calleePtr \<noteq> idle_thread_ptr", simp)
-    apply (subgoal_tac "y \<noteq> idle_sc_ptr", simp)
-     apply (erule (3) not_idle_scTCB)
-     apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
-     apply (clarsimp simp: valid_tcb'_def)
-    apply (frule (2) not_idle_tcbSC[where p=callerPtr])
-      apply (clarsimp simp: valid_idle'_def)
-     apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-    apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-   apply (clarsimp simp: valid_idle'_def idle_tcb'_def obj_at'_real_def ko_wp_at'_def)
-  apply (clarsimp simp: valid_reply'_def)
-  done
-
-lemma replyPush_untyped_ranges_zero'[wp]:
-  "replyPush callerPtr calleePtr replyPtr canDonate \<lbrace>untyped_ranges_zero'\<rbrace>"
-  apply (clarsimp simp: untyped_ranges_zero_inv_null_filter_cteCaps_of)
-  apply (rule hoare_lift_Pf[where f="ctes_of"])
-   apply wp+
-  done
-
-lemma replyPush_sch_act_wf:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and> sch_act_not callerPtr s\<rbrace>
-   replyPush callerPtr calleePtr replyPtr canDonate
-   \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding replyPush_def
-  by (wpsimp wp: sts_sch_act' hoare_vcg_all_lift hoare_vcg_if_lift hoare_drop_imps)
-
-lemma replyPush_invs':
-  "\<lbrace>invs' and valid_idle' and sym_heap_tcbSCs and sym_heap_scReplies and
-    st_tcb_at' (Not \<circ> is_replyState) callerPtr and
-    ex_nonz_cap_to' callerPtr and ex_nonz_cap_to' calleePtr and
-    ex_nonz_cap_to' replyPtr and (\<lambda>s. replyTCBs_of s replyPtr = None)\<rbrace>
-   replyPush callerPtr calleePtr replyPtr canDonate
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def valid_pspace'_def
-  apply (wpsimp wp: replyPush_sch_act_wf replyPush_if_live_then_nonz_cap'
-                    replyPush_sym_refs_list_refs_of_replies'
-              simp: valid_pspace'_def)
-  apply (frule global'_no_ex_cap; clarsimp simp: valid_pspace'_def)
-  done
-
-lemma setEndpoint_invs':
-  "\<lbrace>invs' and valid_ep' ep and ex_nonz_cap_to' eptr\<rbrace> setEndpoint eptr ep \<lbrace>\<lambda>_. invs'\<rbrace>"
-  by (wpsimp simp: invs'_def valid_dom_schedule'_def comp_def)
-
-crunch maybeReturnSc, cancelIPC
-  for sch_act_not[wp]: "sch_act_not t"
-  and sch_act_simple[wp]: "sch_act_simple"
-  (wp: crunch_wps hoare_drop_imps simp: crunch_simps)
-
-crunch maybeReturnSc, doIPCTransfer
-  for replyTCB_obj_at'[wp]: "\<lambda>s. P (obj_at' (\<lambda>reply. P' (replyTCB reply)) t s)"
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  (wp: crunch_wps constOnFailure_wp simp: crunch_simps)
-
-lemma replyUnlink_replyTCBs_of_None[wp]:
-  "\<lbrace>\<lambda>s. r \<noteq> rptr \<longrightarrow> replyTCBs_of s rptr = None\<rbrace>
-   replyUnlink r t
-   \<lbrace>\<lambda>_ s. replyTCBs_of s rptr = None\<rbrace>"
-  apply (wpsimp wp: updateReply_wp_all gts_wp' simp: replyUnlink_def)
-  done
-
-lemma cancelIPC_replyTCBs_of_None:
-  "\<lbrace>\<lambda>s. reply_at' rptr s \<and> (replyTCBs_of s rptr \<noteq> None \<longrightarrow> replyTCBs_of s rptr = Some t)\<rbrace>
-   cancelIPC t
-   \<lbrace>\<lambda>rv s. replyTCBs_of s rptr = None\<rbrace>"
-  unfolding cancelIPC_def blockedCancelIPC_def getBlockingObject_def
-  apply (clarsimp simp: sym_refs_asrt_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ gts_sp'])
-  apply (case_tac state; clarsimp)
-         \<comment> \<open>BlockedOnReceive\<close>
-         apply (wpsimp wp: getEndpoint_wp
-                           hoare_vcg_all_lift hoare_vcg_imp_lift')
-         apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-         apply (drule_tac ko="ko :: reply" for ko in sym_refs_ko_atD'[rotated])
-          apply (fastforce simp: obj_at'_def projectKOs)
-         apply (clarsimp simp: tcb_st_refs_of'_def tcb_bound_refs'_def
-                               refs_of_rev' get_refs_def ko_wp_at'_def opt_map_def
-                        split: option.splits if_splits)
-        \<comment> \<open>BlockedOnReply\<close>
-        apply (wp gts_wp' updateReply_obj_at'_inv
-                  hoare_vcg_all_lift hoare_vcg_const_imp_lift hoare_vcg_imp_lift'
-               | rule threadSet_pred_tcb_no_state
-               | simp add: replyRemoveTCB_def cleanReply_def if_fun_split)+
-        apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-        apply (drule_tac p=rptr and ko="ko :: reply" for ko in sym_refs_ko_atD'[rotated])
-         apply (fastforce simp: obj_at'_def projectKOs)
-        apply (clarsimp simp: tcb_st_refs_of'_def tcb_bound_refs'_def
-                              refs_of_rev' get_refs_def ko_wp_at'_def opt_map_def
-                       split: option.splits)
-       \<comment> \<open>Other thread states\<close>
-       apply (all \<open>wpsimp simp: cancelSignal_def sym_refs_asrt_def wp: hoare_drop_imps\<close>)
-       apply (all \<open>clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs\<close>)
-       apply (all \<open>drule_tac p=rptr and ko="ko :: reply" for ko in sym_refs_ko_atD'[rotated]\<close>)
-             apply (fastforce simp: tcb_bound_refs'_def tcb_st_refs_of'_def refs_of_rev'
-                                    get_refs_def ko_wp_at'_def obj_at'_def projectKOs
-                             split: option.splits
-                             elim!: opt_mapE)+
-  done
-
-crunch cancelSignal, replyRemoveTCB, replyUnlink
-  for ep_obj_at'[wp]: "obj_at' (P :: endpoint \<Rightarrow> bool) eptr"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma blockedCancelIPC_notin_epQueue:
-  "\<lbrace>valid_objs' and obj_at' (\<lambda>ep. ep \<noteq> IdleEP \<longrightarrow> t \<notin> set (epQueue ep)) eptr\<rbrace>
-    blockedCancelIPC state tptr reply_opt
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>ep. ep \<noteq> IdleEP \<longrightarrow> t \<notin> set (epQueue ep)) eptr\<rbrace>"
-  unfolding blockedCancelIPC_def getBlockingObject_def
-  apply (wpsimp wp: set_ep'.obj_at' getEndpoint_wp)
-  apply (fastforce simp: valid_obj'_def valid_ep'_def obj_at'_def projectKOs
-                  intro: set_remove1[where y=tptr] split: endpoint.splits list.splits)
-  done
-
-lemma cancelIPC_notin_epQueue:
-  "\<lbrace>valid_objs' and obj_at' (\<lambda>ep. ep \<noteq> IdleEP \<longrightarrow> t \<notin> set (epQueue ep)) eptr\<rbrace>
-    cancelIPC tptr
-   \<lbrace>\<lambda>rv. obj_at' (\<lambda>ep. ep \<noteq> IdleEP \<longrightarrow> t \<notin> set (epQueue ep)) eptr\<rbrace>"
-  unfolding cancelIPC_def
-  by (wpsimp wp: blockedCancelIPC_notin_epQueue hoare_drop_imps threadSet_valid_objs')
-
-crunch rescheduleRequired
-  for scs_tcbs_of[wp]: "\<lambda>s. P (tcbSCs_of s) (scTCBs_of s)"
-  (wp: crunch_wps threadSet_tcbSCs_of_inv ignore: threadSet)
-
-lemma maybeReturnSc_sym_heap_tcbSCs[wp]:
-  "\<lbrace>sym_heap_tcbSCs and valid_objs'\<rbrace>
-   maybeReturnSc y t
-   \<lbrace>\<lambda>_. sym_heap_tcbSCs\<rbrace>"
-  supply opt_mapE [rule del]
-  unfolding maybeReturnSc_def
-  apply (simp add: liftM_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (wpsimp wp: setSchedContext_scTCBs_of threadSet_tcbSCs_of | wps)+
-   apply (wpsimp wp: threadGet_wp)
-  apply (clarsimp simp: tcb_at'_ex_eq_all)
-  apply (drule sym, simp)
-  apply (subgoal_tac "(tcbSCs_of s) t = Some (the (tcbSchedContext tcb))")
-   apply (clarsimp simp: sym_heap_def)
-   apply (subst (asm) sym_heap_symmetric[simplified sym_heap_def], simp)
-  apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def opt_map_def projectKOs)
-  done
-
-lemma maybeReturnSc_sym_heap_scReplies[wp]:
-  "maybeReturnSc y t \<lbrace>sym_heap_scReplies\<rbrace>"
-  unfolding maybeReturnSc_def
-  apply (simp add: liftM_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (wpsimp wp: setSchedContext_scReplies_of | wps)+
-   apply (wpsimp wp: threadGet_wp)
-  apply (clarsimp simp: tcb_at'_ex_eq_all)
-  apply (drule sym, simp)
-  apply (erule back_subst)
-  apply (rule arg_cong2[where f=sym_heap, OF _ refl], rule ext)
-  apply (clarsimp simp: pred_map_eq_def pred_map_def obj_at'_real_def ko_wp_at'_def opt_map_def
-                        projectKOs)
-  done
-
-crunch cleanReply
-  for scTCBs_of[wp]: "\<lambda>s. P (scTCBs_of s)"
-  and tcbSCs_of[wp]: "\<lambda>s. P (tcbSCs_of s)"
-
-lemma replyRemoveTCB_scTCBs_of[wp]:
-  "replyRemoveTCB tptr \<lbrace>\<lambda>s. P (scTCBs_of s)\<rbrace>"
-  unfolding replyRemoveTCB_def
-  apply (wpsimp wp: setSchedContext_scTCBs_of gts_wp')
-  apply (erule back_subst[where P=P], rule ext, clarsimp)
-  by (clarsimp simp: opt_map_def obj_at'_real_def ko_wp_at'_def)
-
-lemma replyRemoveTCB_tcbSCs_of[wp]:
-  "replyRemoveTCB tptr \<lbrace>\<lambda>s. P (tcbSCs_of s)\<rbrace>"
-  unfolding replyRemoveTCB_def
-  by (wpsimp wp: setSchedContext_scTCBs_of gts_wp')
-
-lemma replyRemoveTCB_sym_heap_tcbSCs[wp]:
-  "replyRemoveTCB tptr \<lbrace>sym_heap_tcbSCs\<rbrace>"
-  by (rule hoare_weaken_pre, wps, wpsimp, simp)
-
-crunch cancelIPC
-  for sym_heap_tcbSCs[wp]: sym_heap_tcbSCs
-  (wp: crunch_wps threadSet_tcbSCs_of_inv ignore: setSchedContext threadSet)
-
-lemma cleanReply_sym_heap_scReplies :
-  "\<lbrace>\<lambda>s. sym_heap (scReplies_of s) (\<lambda>a. if a = rptr then None else replySCs_of s a)\<rbrace>
-   cleanReply rptr
-   \<lbrace>\<lambda>_. sym_heap_scReplies\<rbrace>"
-  unfolding cleanReply_def
-  apply (clarsimp simp: bind_assoc updateReply_def)
-  apply (wpsimp wp: hoare_drop_imp | wps)+
-  done
-
-lemma replyRemoveTCB_sym_heap_scReplies [wp]:
-  "\<lbrace>sym_heap_scReplies and (\<lambda>s. sym_refs (list_refs_of_replies' s))\<rbrace>
-   replyRemoveTCB t
-   \<lbrace>\<lambda>_. sym_heap_scReplies\<rbrace>"
-  supply if_split [split del]
-  unfolding replyRemoveTCB_def
-  apply (clarsimp simp: bind_assoc updateReply_def)
-  apply wpsimp
-         apply (wpsimp wp: cleanReply_sym_heap_scReplies)
-        apply wp
-         apply wps
-         apply wpsimp
-        apply (rule_tac Q'="\<lambda>_ s. (replySCs_of s) (the (replyPrev reply)) = None \<and>
-                 sym_heap (scReplies_of s) (\<lambda>a. if a = rptr then None else replySCs_of s a)"
-               in hoare_strengthen_post[rotated], clarsimp)
-        apply wpsimp
-       apply (rule_tac Q'="\<lambda>_ s. (replyPrev reply \<noteq> None \<longrightarrow>
-                reply_at' (the (replyPrev reply)) s \<longrightarrow>
-                (replySCs_of s) (the (replyPrev reply)) = None) \<and>
-                sym_heap (scReplies_of s) (\<lambda>a. if a = rptr then None else replySCs_of s a)"
-              in hoare_strengthen_post[rotated])
-        apply (clarsimp split: if_splits simp: obj_at'_def)
-       apply (wp hoare_vcg_if_lift2 hoare_vcg_imp_lift' hoare_vcg_all_lift)
-         apply wps
-         apply (wpsimp wp: setSchedContext_scReplies_of)
-        apply wpsimp
-       apply wp
-        apply wps
-        apply wpsimp
-       apply wpsimp
-      apply wpsimp
-     apply (rule_tac Q'="\<lambda>replya s. sym_heap_scReplies s \<and> sym_refs (list_refs_of_replies' s)"
-            in hoare_strengthen_post[rotated])
-      apply (rename_tac rv s)
-      apply (clarsimp split: if_splits)
-      apply (intro conjI; intro allI impI)
-       apply clarsimp
-       apply (intro conjI; intro allI impI)
-         apply (clarsimp simp: isHead_to_head)
-         apply (intro conjI; intro allI impI)
-          apply clarsimp
-          apply (rename_tac replyPtr scPtr sc)
-          apply (subgoal_tac "replyPrevs_of s rv = Some replyPtr")
-           apply (rule replyNexts_Some_replySCs_None)
-           apply (simp add: sym_refs_replyNext_replyPrev_sym[symmetric])
-          apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def)
-         apply (intro conjI; intro allI impI)
-          apply clarsimp
-          apply (drule ko_at'_inj, assumption, simp)
-          apply (clarsimp simp: isHead_to_head)
-          apply (rename_tac rPtr)
-          apply (subgoal_tac "replyPrevs_of s rv = Some rPtr")
-           apply (insert replyNexts_Some_replySCs_None)
-           apply (simp add: sym_refs_replyNext_replyPrev_sym[symmetric])
-           apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def)
-          apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def)
-         apply clarsimp
-         apply (rename_tac replyPtr reply rPtr reply')
-         apply (subgoal_tac "replyPrevs_of s rv = Some replyPtr")
-          apply (rule replyNexts_Some_replySCs_None)
-          apply (simp add: sym_refs_replyNext_replyPrev_sym[symmetric])
-         apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def)
-        apply (clarsimp simp: isHead_to_head)
-        apply (erule sym_heap_remove_only)
-        apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def pred_map_eq)
-       apply (clarsimp simp: isHead_to_head)
-       apply (erule rsubst2[where P=sym_heap, OF _ refl])
-       apply (rule ext, clarsimp split: if_split)
-       apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def)
-      apply (intro conjI, intro allI impI)
-       apply clarsimp
-       apply (rename_tac replyPtr)
-       apply (subgoal_tac "replyPrevs_of s rv = Some replyPtr")
-        apply (rule replyNexts_Some_replySCs_None)
-        apply (simp add: sym_refs_replyNext_replyPrev_sym[symmetric])
-       apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def)
-      apply (erule rsubst2[where P=sym_heap, OF _ refl])
-      apply (rule ext, clarsimp split: if_split)
-      apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def)
-     apply (wpsimp wp: hoare_drop_imp)+
+  apply (case_tac "ntfnObj ep")
+    \<comment> \<open>ep = IdleNtfn\<close>
+    apply (simp add: invs'_def valid_state'_def)
+    apply (rule hoare_pre)
+     apply (wp valid_irq_node_lift sts_sch_act' typ_at_lifts
+               setThreadState_ct_not_inQ
+               asUser_urz
+            | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def | wpc)+
+    apply (clarsimp simp: pred_tcb_at' valid_tcb_state'_def)
+    apply (rule conjI, clarsimp elim!: obj_at'_weakenE)
+    apply (subgoal_tac "capNtfnPtr cap \<noteq> t")
+     apply (frule valid_pspace_valid_objs')
+     apply (frule (1) ko_at_valid_objs')
+      apply (clarsimp simp: projectKOs)
+     apply (clarsimp simp: valid_obj'_def valid_ntfn'_def)
+     apply (rule conjI, clarsimp simp: obj_at'_def split: option.split)
+     apply (drule simple_st_tcb_at_state_refs_ofD'
+                  ko_at_state_refs_ofD' bound_tcb_at_state_refs_ofD')+
+     apply (clarsimp dest!: isCapDs)
+     apply (rule conjI, erule delta_sym_refs)
+       apply (clarsimp split: if_split_asm)
+      apply (fastforce simp: tcb_bound_refs'_def symreftype_inverse'
+                      split: if_split_asm)
+     apply (fastforce dest!: global'_no_ex_cap)
+    apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
+   \<comment> \<open>ep = ActiveNtfn\<close>
+   apply (simp add: invs'_def valid_state'_def)
+   apply (rule hoare_pre)
+    apply (wp valid_irq_node_lift sts_valid_objs' typ_at_lifts hoare_weak_lift_imp
+              asUser_urz
+         | simp add: valid_ntfn'_def)+
+   apply (clarsimp simp: pred_tcb_at' valid_pspace'_def)
+   apply (frule (1) ko_at_valid_objs')
+    apply (clarsimp simp: projectKOs)
+   apply (clarsimp simp: valid_obj'_def valid_ntfn'_def isCap_simps)
+   apply (drule simple_st_tcb_at_state_refs_ofD'
+                 ko_at_state_refs_ofD')+
+   apply (erule delta_sym_refs)
+    apply (clarsimp split: if_split_asm simp: global'_no_ex_cap)+
+  \<comment> \<open>ep = WaitingNtfn\<close>
+  apply (simp add: invs'_def valid_state'_def)
+  apply (rule hoare_pre)
+   apply (wp hoare_vcg_const_Ball_lift valid_irq_node_lift sts_sch_act'
+             setThreadState_ct_not_inQ typ_at_lifts
+             asUser_urz
+        | simp add: valid_ntfn'_def doNBRecvFailedTransfer_def | wpc)+
+  apply (clarsimp simp: valid_tcb_state'_def)
+  apply (frule_tac t=t in not_in_ntfnQueue)
+     apply (simp)
+    apply (simp)
+   apply (erule pred_tcb'_weakenE, clarsimp)
+  apply (frule ko_at_valid_objs')
+    apply (clarsimp simp: valid_pspace'_def)
+   apply (simp add: projectKOs)
+  apply (clarsimp simp: valid_obj'_def)
+  apply (clarsimp simp: valid_ntfn'_def pred_tcb_at')
+  apply (rule conjI, clarsimp elim!: obj_at'_weakenE)
+  apply (rule conjI, clarsimp simp: obj_at'_def split: option.split)
+  apply (drule(1) sym_refs_ko_atD')
+  apply (drule simple_st_tcb_at_state_refs_ofD')
+  apply (drule bound_tcb_at_state_refs_ofD')
+  apply (clarsimp simp: st_tcb_at_refs_of_rev'
+                 dest!: isCapDs)
+  apply (rule conjI, erule delta_sym_refs)
+    apply (clarsimp split: if_split_asm)
+    apply (rename_tac list one two three four five six seven eight nine)
+    apply (subgoal_tac "set list \<times> {NTFNSignal} \<noteq> {}")
+     apply safe[1]
+        apply (auto simp: symreftype_inverse' ntfn_bound_refs'_def tcb_bound_refs'_def)[5]
+   apply (fastforce simp: tcb_bound_refs'_def
+                   split: if_split_asm)
+  apply (fastforce dest!: global'_no_ex_cap)
   done
 
-crunch blockedCancelIPC, cancelSignal
-  for sym_heap_scReplies[wp]: sym_heap_scReplies
-  (wp: crunch_wps  ignore: setSchedContext setReply updateReply)
-
-lemma cancelIPC_sym_heap_scReplies [wp]:
-  "\<lbrace>sym_heap_scReplies and (\<lambda>s. sym_refs (list_refs_of_replies' s))\<rbrace>
-   cancelIPC t
-   \<lbrace>\<lambda>_. sym_heap_scReplies\<rbrace>"
-  unfolding cancelIPC_def
-  by (wpsimp wp: gts_wp', simp add: comp_def)
-
-lemma replyTCB_is_not_ksIdleThread:
-  "\<lbrakk>ko_at' reply replyPtr s; the (replyTCB reply) = ksIdleThread s; replyTCB reply = Some tcb;
-    valid_idle' s; sym_refs (state_refs_of' s)\<rbrakk>
-   \<Longrightarrow> False"
-  apply (frule sym_ref_replyTCB_Receive_or_Reply)
-    apply blast
-   apply fastforce
-  apply (clarsimp simp: st_tcb_at'_def obj_at_simps valid_idle'_def idle_tcb'_def)
+lemma getCTE_cap_to_refs[wp]:
+  "\<lbrace>\<top>\<rbrace> getCTE p \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' (cteCap rv). ex_nonz_cap_to' r s\<rbrace>"
+  apply (rule hoare_strengthen_post [OF getCTE_sp])
+  apply (clarsimp simp: ex_nonz_cap_to'_def)
+  apply (fastforce elim: cte_wp_at_weakenE')
   done
 
-lemma refillUnblockCheck_sym_heap_tcbSCs[wp]:
-  "\<lbrace>sym_heap_tcbSCs and valid_objs'\<rbrace>
-   refillUnblockCheck scp
-   \<lbrace>\<lambda>_. sym_heap_tcbSCs\<rbrace>"
-  supply opt_mapE [rule del]
-  unfolding refillUnblockCheck_def refillHeadOverlappingLoop_def mergeRefills_def updateRefillHd_def
-  apply (wpsimp wp: whileLoop_valid_inv updateSchedContext_wp wp_del: use_corresK
-              simp: refillPopHead_def)
-        apply (clarsimp simp: sym_heap_def obj_at'_def projectKOs ps_clear_upd opt_map_red projectKO_opt_tcb)
-       apply (wpsimp wp: updateSchedContext_wp getCurTime_wp refillReady_wp isRoundRobin_wp
-                   simp: setReprogramTimer_def)+
-  apply (clarsimp simp: sym_heap_def obj_at'_def projectKOs ps_clear_upd projectKO_opt_tcb)
-  apply (rule conjI)
-   apply (clarsimp simp: opt_map_red)
-   apply (rule iffI; clarsimp?)
-    apply (clarsimp simp: opt_map_def split: option.split_asm if_split_asm)
-   apply (prop_tac "tcb_at' p s")
-    apply (fastforce simp: valid_obj'_def valid_sched_context'_def)
-   apply (clarsimp simp: obj_at'_def projectKOs opt_map_def)
-  apply (drule_tac x=p and y=p' in spec2)
-  apply (drule sym[of "_ = _"])
-  apply (clarsimp simp: opt_map_def projectKOs split: option.splits)
+lemma lookupCap_cap_to_refs[wp]:
+  "\<lbrace>\<top>\<rbrace> lookupCap t cref \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s\<rbrace>,-"
+  apply (simp add: lookupCap_def lookupCapAndSlot_def split_def
+                   getSlotCap_def)
+  apply (wp | simp)+
   done
 
-lemma refillUnblockCheck_sym_heap_scReplies[wp]:
-  "\<lbrace>sym_heap_scReplies and valid_objs'\<rbrace>
-   refillUnblockCheck scp
-   \<lbrace>\<lambda>_. sym_heap_scReplies\<rbrace>"
-  supply opt_mapE [rule del]
-  unfolding refillUnblockCheck_def refillHeadOverlappingLoop_def mergeRefills_def updateRefillHd_def
-  apply (wpsimp wp: whileLoop_valid_inv updateSchedContext_wp wp_del: use_corresK
-              simp: refillPopHead_def)
-        apply (clarsimp simp: sym_heap_def obj_at'_def projectKOs ps_clear_upd opt_map_red projectKO_opt_reply)
-        apply (drule_tac x=scp and y=p' in spec2)
-        apply (clarsimp simp: opt_map_red)
-       apply (wpsimp wp: updateSchedContext_wp getCurTime_wp refillReady_wp isRoundRobin_wp
-                   simp: setReprogramTimer_def)+
-  apply (clarsimp simp: sym_heap_def obj_at'_def projectKOs ps_clear_upd projectKO_opt_reply)
-  apply (rule conjI; clarsimp)
-   apply (drule_tac x=scp and y=p' in spec2)
-   apply (clarsimp simp: opt_map_def projectKO_opt_reply)
-   apply (drule_tac x=p and y=p' in spec2)
-   apply (clarsimp simp: opt_map_def projectKO_opt_reply)
+lemma arch_stt_objs' [wp]:
+  "\<lbrace>valid_objs'\<rbrace> Arch.switchToThread t \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  apply (simp add: ARM_H.switchToThread_def)
+  apply wp
   done
 
-crunch ifCondRefillUnblockCheck
-  for sym_heap_tcbSCs[wp]: sym_heap_tcbSCs
-  and sym_heap_scReplies[wp]: sym_heap_scReplies
-  and valid_idle'[wp]: valid_idle'
-  (simp: crunch_simps)
+declare zipWithM_x_mapM [simp]
 
-(* t = ksCurThread s *)
-lemma ri_invs' [wp]:
-  "\<lbrace>invs' and st_tcb_at' active' t
-          and ex_nonz_cap_to' t
-          and (\<lambda>s. \<forall>r \<in> zobj_refs' replyCap. ex_nonz_cap_to' r s)
-          and (\<lambda>s. \<forall>r \<in> zobj_refs' cap. ex_nonz_cap_to' r s)
-          and valid_cap' replyCap\<rbrace>
-  receiveIPC t cap isBlocking replyCap
-  \<lbrace>\<lambda>_. invs'\<rbrace>" (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
-  supply if_split [split del]
-  apply (clarsimp simp: receiveIPC_def sym_refs_asrt_def sch_act_wf_asrt_def valid_idle'_asrt_def
-                 split: if_split)
-  apply (intro bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp)
-   apply (rule bind_wp)
-    \<comment> \<open>After getEndpoint, the following holds regardless of the type of ep\<close>
-    apply (rule_tac Q'="\<lambda>ep s. invs' s \<and> valid_idle' s \<and> sch_act_wf (ksSchedulerAction s) s
-                              \<and> ex_nonz_cap_to' t s \<and> ex_nonz_cap_to' (capEPPtr cap) s \<and>
-                              sym_heap_tcbSCs s \<and> sym_heap_scReplies s \<and>
-                              st_tcb_at' simple' t s \<and> t \<noteq> ksIdleThread s \<and>
-                              (\<forall>x. replyOpt = Some x \<longrightarrow> ex_nonz_cap_to' x s \<and>
-                                                         reply_at' x s \<and> replyTCBs_of s x = None) \<and>
-                              ko_at' ep (capEPPtr cap) s \<and>
-                              (ep_at' (capEPPtr cap) s \<longrightarrow>
-                               obj_at' (\<lambda>ep. ep \<noteq> IdleEP \<longrightarrow> t \<notin> set (epQueue ep)) (capEPPtr cap) s)"
-                 in bind_wp)
-     apply (rule_tac P'1="\<lambda>s. \<forall>rptr. replyOpt = Some rptr \<longrightarrow> \<not> is_reply_linked rptr s"
-            in hoare_pre_add[THEN iffD2])
-      apply clarsimp
-      apply (frule valid_replies'_no_tcb; clarsimp)
-     apply (rename_tac ep)
-     apply (case_tac ep; clarsimp)
-       \<comment> \<open>RecvEP\<close>
-       apply (wpsimp wp: completeSignal_invs' setEndpoint_invs' setThreadState_BlockedOnReceive_invs'
-                         maybeReturnSc_invs' updateReply_replyTCB_invs' tcbEPAppend_valid_RecvEP
-                         getNotification_wp gbn_wp' hoare_vcg_all_lift hoare_vcg_const_imp_lift
-                   simp: if_fun_split
-              | wp (once) hoare_false_imp)+
-       apply (clarsimp simp: pred_tcb_at')
-       apply (erule valid_objsE'[OF invs_valid_objs'])
-        apply (fastforce simp: obj_at'_def projectKOs)
-       apply (fastforce simp: valid_obj'_def valid_ep'_def pred_tcb_at'_def obj_at'_def)
-      \<comment> \<open>IdleEP\<close>
-      apply (wpsimp wp: completeSignal_invs' setEndpoint_invs' setThreadState_BlockedOnReceive_invs'
-                        maybeReturnSc_invs' updateReply_replyTCB_invs' getNotification_wp gbn_wp'
-                        hoare_vcg_all_lift hoare_vcg_const_imp_lift
-                  simp: if_fun_split
-             | wp (once) hoare_false_imp)+
-      apply (fastforce simp: valid_obj'_def valid_ep'_def pred_tcb_at'_def obj_at'_def projectKOs)
-     \<comment> \<open>SendEP\<close>
-     apply (wpsimp wp: replyPush_invs' completeSignal_invs' sts_invs' setThreadState_st_tcb
-                       threadGet_wp)
-               apply (rename_tac sender queue senderState badge canGrant canGrantReply scOpt)
-               apply (rule_tac Q'="\<lambda>_. invs' and valid_idle'
-                                      and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' t
-                                      and st_tcb_at' (Not \<circ> is_replyState) sender
-                                      and (\<lambda>s. sender \<noteq> ksIdleThread s)
-                                      and sym_heap_tcbSCs and sym_heap_scReplies
-                                      and ex_nonz_cap_to' sender and ex_nonz_cap_to' t
-                                      and (\<lambda>s. \<forall>x. replyOpt = Some x \<longrightarrow> reply_at' x s \<and>
-                                                     replyTCBs_of s x = None \<and> ex_nonz_cap_to' x s)"
-                      in hoare_strengthen_post[rotated])
-                  apply (clarsimp simp: pred_tcb_at'_eq_commute)
-                  apply (fastforce simp: pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def
-                                         is_BlockedOnReply_def is_BlockedOnReceive_def)
-                 apply (wpsimp wp: ifCondRefillUnblockCheck_invs' hoare_vcg_all_lift hoare_vcg_imp_lift')
-                apply (rule_tac Q'="\<lambda>_. invs' and valid_idle' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-                                       and tcb_at' t and st_tcb_at' (Not \<circ> is_replyState) x21
-                                       and (\<lambda>s. x21 \<noteq> ksIdleThread s) and sym_heap_tcbSCs and sym_heap_scReplies
-                                       and ex_nonz_cap_to' x21 and ex_nonz_cap_to' t
-                                       and (\<lambda>s. \<forall>x. replyOpt = Some x \<longrightarrow> reply_at' x s \<and> replyTCBs_of s x = None \<and> ex_nonz_cap_to' x s)"
-                       in hoare_strengthen_post[rotated])
-                 apply (clarsimp simp: o_def invs_valid_objs')
-                apply (wpsimp wp: hoare_vcg_imp_lift' setEndpoint_invs' maybeReturnSc_invs'
-                                  maybeReturnSc_valid_idle' hoare_vcg_all_lift getNotification_wp gbn_wp')+
-     apply (clarsimp split: if_split cong: conj_cong imp_cong simp: tcb_cte_cases_def)
-     apply (drule pred_tcb_at', clarsimp)
-     apply (rename_tac sender queue ntfna ntfnb ntfnc)
-     apply (frule ep_ko_at_valid_objs_valid_ep', clarsimp)
-     apply (frule invs_valid_objs')
-     apply (subgoal_tac "st_tcb_at' isBlockedOnSend sender s")
-      apply (frule_tac t=sender in pred_tcb_at', clarsimp)
-      apply (subgoal_tac "st_tcb_at' (Not \<circ> is_replyState) sender s")
-       apply (clarsimp simp: o_def)
-       apply (subgoal_tac "sender \<noteq> ksIdleThread s
-                           \<and> ex_nonz_cap_to' sender s \<and>
-                           valid_ep' (case queue of [] \<Rightarrow> Structures_H.endpoint.IdleEP
-                                      | a # list \<Rightarrow> Structures_H.endpoint.SendEP queue) s", clarsimp)
-       apply (intro conjI)
-         apply (frule (1) st_tcb_idle', clarsimp simp: isBlockedOnSend_equiv is_BlockedOnSend_def)
-        apply (erule st_tcb_ex_cap''; clarsimp simp: isBlockedOnSend_equiv is_BlockedOnSend_def)
-       apply (clarsimp simp: valid_ep'_def pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def
-                      split: list.splits)
-      apply (fastforce elim!: pred_tcb'_weakenE
-                        simp: isBlockedOnSend_def is_BlockedOnReply_def
-                              is_BlockedOnReceive_def)
-     apply (clarsimp simp: valid_ep'_def pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def
-                           isSend_equiv isBlockedOnSend_equiv, fastforce)
-    \<comment> \<open>Resolve common precondition\<close>
-    apply (simp (no_asm_use) cong: conj_cong
-           | wpsimp wp: cancelIPC_st_tcb_at'_different_thread cancelIPC_notin_epQueue
-                        cancelIPC_replyTCBs_of_None hoare_vcg_all_lift getEndpoint_wp
-                        hoare_drop_imp[where Q'="\<lambda>_ s. \<exists>ko. ko_at' ko _ s"] hoare_vcg_imp_lift')+
-  apply (rename_tac s)
-  apply (clarsimp simp: comp_def invs'_def valid_pspace'_def if_distribR
-                  cong: conj_cong imp_cong)
-  apply (frule (3) sym_refs_tcbSCs)
-  apply (frule (3) sym_refs_scReplies)
-  apply (prop_tac "\<forall>ep. ko_at' ep (capEPPtr cap) s \<longrightarrow> ep \<noteq> IdleEP \<longrightarrow> t \<notin> set (epQueue ep)")
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-   apply (drule_tac ko="ko :: endpoint" for ko in sym_refs_ko_atD'[rotated])
-    apply (fastforce simp: obj_at'_def projectKOs)
-   apply (fastforce simp: ep_q_refs_of'_def refs_of_rev' ko_wp_at'_def split: endpoint.splits)
-  apply (prop_tac "\<forall>r g. replyCap = ReplyCap r g \<longrightarrow> \<not>obj_at' (\<lambda>a. replyTCB a = Some t) r s")
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-   apply (drule_tac ko="ko :: reply" for ko in sym_refs_ko_atD'[rotated])
-    apply (fastforce simp: obj_at'_def projectKOs)
-   apply (fastforce simp: refs_of_rev' ko_wp_at'_def tcb_bound_refs'_def get_refs_def
-                   split: option.splits)
-  apply (prop_tac "ex_nonz_cap_to' (capEPPtr cap) s \<and> st_tcb_at' simple' t s \<and>
-                      t \<noteq> ksIdleThread s \<and> (ep_at' (capEPPtr cap) s \<longrightarrow>
-                      obj_at' (\<lambda>ep. ep \<noteq> Structures_H.endpoint.IdleEP \<longrightarrow> t \<notin> set (epQueue ep))
-                      (capEPPtr cap) s)")
-   apply (fastforce simp: valid_idle'_def idle_tcb'_def pred_tcb_at'_def obj_at'_def projectKOs
-                          isCap_simps isSend_def)
-  apply (clarsimp split: if_splits)
-  apply (prop_tac "(\<exists>y. replyTCB ko = Some y) \<and> ko_at' ko x s \<longrightarrow> sch_act_not (the (replyTCB ko)) s")
-   apply clarsimp
-   apply (frule_tac tp="the (replyTCB ko)" in sym_ref_replyTCB_Receive_or_Reply)
-     apply blast
-    apply fastforce
-   apply (fastforce simp: st_tcb_at'_def obj_at_simps sch_act_wf_def split: thread_state.splits)
-  apply (fastforce simp: opt_map_def obj_at'_def projectKOs valid_cap'_def
-                 intro!: replyTCB_is_not_ksIdleThread
-                  split: if_split)
-  done
+lemma cteInsert_invs_bits[wp]:
+  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
+      cteInsert a b c
+   \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  "\<lbrace>cur_tcb'\<rbrace> cteInsert a b c \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
+  "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
+      cteInsert a b c
+   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
+apply (wp sch_act_wf_lift valid_queues_lift
+          cur_tcb_lift tcb_in_cur_domain'_lift)+
+done
 
-lemma bindScReply_st_tcb_at'[wp]:
-  "\<lbrace>\<lambda>s. P (st_tcb_at' P' t s)\<rbrace>
-   bindScReply scPtr replyPtr
-   \<lbrace>\<lambda>_ s. P (st_tcb_at' P' t s)\<rbrace>"
-  apply (clarsimp simp: bindScReply_def)
-  by (wpsimp wp: crunch_wps)
-
-lemma replyPush_st_tcb_at'_not_caller:
-  "\<lbrace>\<lambda>s. P (st_tcb_at' P' t s) \<and> t \<noteq> callerPtr\<rbrace>
-   replyPush callerPtr calleePtr replyPtr canDonate
-   \<lbrace>\<lambda>_ s. P (st_tcb_at' P' t s)\<rbrace>"
-  apply (clarsimp simp: replyPush_def)
-  by (wpsimp wp: sts_st_tcb_at'_cases_strong hoare_vcg_imp_lift)
-
-lemma replyUnlink_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> (replyTCBs_of s replyPtr = Some tcbPtr \<longrightarrow> \<not> is_reply_linked replyPtr s)\<rbrace>
-   replyUnlink replyPtr tcbPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding invs'_def valid_dom_schedule'_def
-  by wpsimp
-
-lemma asUser_pred_tcb_at'[wp]:
-  "asUser tptr f \<lbrace>\<lambda>s. P (pred_tcb_at' proj test t s)\<rbrace>"
-  unfolding asUser_def
-  by (wpsimp wp: mapM_wp' threadSet_pred_tcb_no_state crunch_wps
-           simp: tcb_to_itcb'_def)
-
-lemma setCTE_pred_tcb_at':
-  "setCTE ptr val \<lbrace>\<lambda>s. P (pred_tcb_at' proj test t s)\<rbrace> "
-  apply (simp add: setCTE_def pred_tcb_at'_def)
-  apply (rule setObject_cte_obj_at_tcb'; simp add: tcb_to_itcb'_def)
+lemma possibleSwitchTo_sch_act_not:
+  "\<lbrace>sch_act_not t' and K (t \<noteq> t')\<rbrace> possibleSwitchTo t \<lbrace>\<lambda>rv. sch_act_not t'\<rbrace>"
+  apply (simp add: possibleSwitchTo_def setSchedulerAction_def curDomain_def)
+  apply (wp hoare_drop_imps | wpc | simp)+
   done
 
-crunch doIPCTransfer
-  for pred_tcb_at''[wp]: "\<lambda>s. P (pred_tcb_at' proj test t s)"
-  (wp: setCTE_pred_tcb_at' getCTE_wp mapM_wp' simp: cte_wp_at'_def zipWithM_x_mapM)
-
-lemma si_invs'_helper2:
-  "\<lbrace>\<lambda>s. invs' s \<and> valid_idle' s \<and> st_tcb_at' active' t s \<and>
-        st_tcb_at' (Not \<circ> is_BlockedOnReply) d s \<and>
-        ex_nonz_cap_to' t s \<and> ex_nonz_cap_to' d s \<and>
-        sym_heap_tcbSCs s \<and> sym_heap_scReplies s \<and>
-        (\<forall>reply. replyObject recvState = Some reply \<longrightarrow> ex_nonz_cap_to' reply s \<and> reply_at' reply s
-                 \<and> replyTCBs_of s reply = None) \<and>
-        (cd \<and> scOptDest = Nothing \<longrightarrow> bound_sc_tcb_at' ((=) None) d s \<and>
-        (\<exists>scptr. bound_sc_tcb_at' (\<lambda>scp. scp = (Some scptr)) t s \<and> ex_nonz_cap_to' scptr s)) \<and>
-        t \<noteq> d\<rbrace>
-   if call \<or> (\<exists>y. fault = Some y)
-   then if (cg \<or> cgr) \<and> (\<exists>y. replyObject recvState = Some y)
-        then replyPush t d (the (replyObject recvState)) cd
-        else setThreadState Structures_H.thread_state.Inactive t
-   else when (cd \<and> scOptDest = None) (do
-          scOptSrc <- threadGet tcbSchedContext t;
-          schedContextDonate (the scOptSrc) d
-        od)
-  \<lbrace>\<lambda>b s. invs' s \<and> tcb_at' d s \<and> ex_nonz_cap_to' d s
-         \<and> st_tcb_at' (Not \<circ> is_BlockedOnReply) d s\<rbrace>"
-  apply (wpsimp wp: ex_nonz_cap_to_pres' schedContextDonate_invs' replyPush_invs'
-                    replyPush_valid_idle' sts_invs_minor' schedContextDonate_valid_idle'
-                    replyPush_st_tcb_at'_not_caller sts_st_tcb' threadGet_wp)
-  apply (frule_tac P'="(\<lambda>st'. \<forall>rptr. st' \<noteq> BlockedOnReply rptr)" in pred_tcb'_weakenE)
-   apply (clarsimp simp: is_BlockedOnReply_def)
-  apply (frule pred_tcb_at')
-  apply (frule_tac t=d in pred_tcb_at')
-  apply (frule_tac P'="Not \<circ> is_replyState" in pred_tcb'_weakenE)
-   apply (fastforce simp: is_BlockedOnReply_def is_BlockedOnReceive_def)
-  apply (frule invs_valid_objs')
-  apply (clarsimp simp: tcb_at'_ex_eq_all o_def)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def)
-  done
+crunch possibleSwitchTo
+  for vms'[wp]: valid_machine_state'
+crunch possibleSwitchTo
+  for pspace_domain_valid[wp]: pspace_domain_valid
+crunch possibleSwitchTo
+  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
 
-lemma replyUnlink_obj_at_tcb_none:
-  "\<lbrace>K (rptr' = rptr)\<rbrace>
-   replyUnlink rptr tptr
-   \<lbrace>\<lambda>_. obj_at' (\<lambda>reply. replyTCB reply = None) rptr'\<rbrace>"
-  apply (simp add: replyUnlink_def)
-  apply (wpsimp wp: updateReply_wp_all gts_wp')
-  by (auto simp: obj_at'_def projectKOs objBitsKO_def)
+crunch possibleSwitchTo
+  for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
+crunch possibleSwitchTo
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+crunch possibleSwitchTo
+  for irqs_masked'[wp]: "irqs_masked'"
+crunch possibleSwitchTo
+  for urz[wp]: "untyped_ranges_zero'"
+  (simp: crunch_simps unless_def wp: crunch_wps)
 
 crunch possibleSwitchTo
   for pspace_aligned'[wp]: pspace_aligned'
   and pspace_distinct'[wp]: pspace_distinct'
 
 lemma si_invs'[wp]:
-  "\<lbrace>invs' and st_tcb_at' active' t
-          and (\<lambda>s. cd \<longrightarrow> bound_sc_tcb_at' (\<lambda>a. a \<noteq> None) t s)
+  "\<lbrace>invs' and st_tcb_at' simple' t
+          and sch_act_not t
           and ex_nonz_cap_to' ep and ex_nonz_cap_to' t\<rbrace>
-   sendIPC bl call ba cg cgr cd t ep
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  sendIPC bl call ba cg cgr t ep
+  \<lbrace>\<lambda>rv. invs'\<rbrace>"
   supply if_split[split del]
-  apply (simp add: sendIPC_def valid_idle'_asrt_def)
-  apply (intro bind_wp[OF _ stateAssert_sp])
+  apply (simp add: sendIPC_def split del: if_split)
   apply (rule bind_wp [OF _ get_ep_sp'])
-  apply (rename_tac ep')
-  apply (case_tac ep')
-    \<comment> \<open>ep' = RecvEP\<close>
+  apply (case_tac epa)
+    \<comment> \<open>epa = RecvEP\<close>
+    apply simp
     apply (rename_tac list)
-    apply (case_tac list; simp)
-    apply (wpsimp wp: possibleSwitchTo_invs')
-             apply (wpsimp wp: setThreadState_st_tcb setThreadState_Running_invs')
-            apply (wpsimp wp: si_invs'_helper2)
-           apply wpsimp
-          apply (wpsimp wp: threadGet_wp)
-         apply (rule_tac Q'="\<lambda>_ s. invs' s \<and> valid_idle' s \<and> st_tcb_at' active' t s \<and>
-                                  st_tcb_at' (Not \<circ> is_BlockedOnReply) a s \<and>
-                                  ex_nonz_cap_to' t s \<and> ex_nonz_cap_to' a s \<and>
-                                  (\<forall>x. replyObject recvState = Some x \<longrightarrow>
-                                         ex_nonz_cap_to' x s \<and> reply_at' x s \<and>
-                                         replyTCBs_of s x = None) \<and>
-                                  sym_heap_tcbSCs s \<and> sym_heap_scReplies s \<and>
-                                  (cd \<longrightarrow> (\<exists>scptr. bound_sc_tcb_at' (\<lambda>scp. scp = Some scptr) t s \<and>
-                                                   ex_nonz_cap_to' scptr s)) \<and>
-                                  t \<noteq> a"
-                in hoare_strengthen_post[rotated])
-          apply (fastforce simp: obj_at'_def projectKO_eq projectKO_tcb
-                                 pred_tcb_at'_def invs'_def
-                          dest!: global'_no_ex_cap)
-         apply (wpsimp wp: replyUnlink_invs' replyUnlink_st_tcb_at' replyUnlink_obj_at_tcb_none
-                           hoare_vcg_ex_lift hoare_vcg_imp_lift')
-        apply (rule_tac Q'="\<lambda>_ s. invs' s \<and> valid_idle' s \<and> st_tcb_at' active' t s \<and>
-                                 st_tcb_at' is_BlockedOnReceive a s \<and>
-                                 ex_nonz_cap_to' t s \<and> ex_nonz_cap_to' a s \<and> a \<noteq> t \<and>
-                                 sym_heap_tcbSCs s \<and> sym_heap_scReplies s \<and>
-                                 (\<forall>x. replyObject recvState = Some x \<longrightarrow>
-                                        ex_nonz_cap_to' x s \<and> reply_at' x s \<and>
-                                        (replyTCBs_of s x = Some a \<longrightarrow>
-                                         \<not> is_reply_linked x s)) \<and>
-                                 (cd \<longrightarrow> (\<exists>scptr. bound_sc_tcb_at' (\<lambda>scp. scp = Some scptr) t s \<and> ex_nonz_cap_to' scptr s))"
-               in hoare_strengthen_post[rotated])
-         apply (auto simp: obj_at'_def projectKO_eq projectKO_tcb
-                           pred_tcb_at'_def invs'_def
-                           is_BlockedOnReceive_def is_BlockedOnReply_def
-                    dest!: global'_no_ex_cap)[1]
-        apply (wpsimp simp: invs'_def valid_dom_schedule'_def valid_pspace'_def
-                            comp_def sym_refs_asrt_def
-                        wp: hoare_vcg_all_lift hoare_vcg_ex_lift hoare_vcg_imp_lift' gts_wp')+
-    apply (intro conjI; clarsimp?)
-           apply (force simp: obj_at'_def projectKO_eq projectKO_ep valid_obj'_def valid_ep'_def
-                        elim: valid_objsE' split: list.splits)
-          apply (fastforce simp: pred_tcb_at'_eq_commute pred_tcb_at'_def obj_at'_def
-                                 is_BlockedOnReceive_def isReceive_def
-                          split: thread_state.splits)
-         apply (fastforce simp: pred_tcb_at'_def ko_wp_at'_def obj_at'_def
-                                projectKO_eq projectKO_tcb isReceive_def
-                          elim: if_live_then_nonz_capE' split: thread_state.splits)
-        apply (fastforce simp: pred_tcb_at'_def ko_wp_at'_def obj_at'_def
-                               projectKO_eq projectKO_tcb isReceive_def
-                        split: thread_state.splits)
-       apply (erule (3) sym_refs_tcbSCs)
-      apply (erule (3) sym_refs_scReplies)
-     apply (simp flip: conj_assoc, rule conjI)
-      apply (subgoal_tac "ko_wp_at' live' xb s \<and> reply_at' xb s", clarsimp)
-       apply (erule (1) if_live_then_nonz_capE')
-      apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKO_eq projectKO_tcb)
-      apply (drule_tac p=a and ko="obja" in sym_refs_ko_atD'[rotated])
-       apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb)
-      apply (clarsimp simp: isReceive_def refs_of_rev' ko_wp_at'_def live_reply'_def
-                     split: thread_state.splits)
+    apply (case_tac list)
+     apply simp
+    apply (simp split del: if_split add: invs'_def valid_state'_def)
+    apply (rule hoare_pre)
+     apply (rule_tac P="a\<noteq>t" in hoare_gen_asm)
+     apply (wp valid_irq_node_lift
+               sts_valid_objs' set_ep_valid_objs' setEndpoint_valid_mdb' sts_st_tcb' sts_sch_act'
+               possibleSwitchTo_sch_act_not setThreadState_ct_not_inQ
+               possibleSwitchTo_ct_not_inQ hoare_vcg_all_lift
+               hoare_convert_imp [OF doIPCTransfer_sch_act doIPCTransfer_ct']
+               hoare_convert_imp [OF setEndpoint_nosch setEndpoint_ct']
+               hoare_drop_imp [where f="threadGet tcbFault t"]
+             | rule_tac f="getThreadState a" in hoare_drop_imp
+             | wp (once) hoare_drop_imp[where Q'="\<lambda>_ _. call"]
+               hoare_drop_imp[where Q'="\<lambda>_ _. \<not> call"]
+               hoare_drop_imp[where Q'="\<lambda>_ _. cg"]
+             | simp    add: valid_tcb_state'_def case_bool_If
+                            case_option_If
+                      cong: if_cong
+                 split del: if_split
+             | wp (once) sch_act_sane_lift tcb_in_cur_domain'_lift hoare_vcg_const_imp_lift)+
+    apply (clarsimp simp: pred_tcb_at' cong: conj_cong imp_cong
+               split del: if_split)
+    apply (frule obj_at_valid_objs', clarsimp)
+    apply (frule(1) sym_refs_ko_atD')
+    apply (clarsimp simp: projectKOs valid_obj'_def valid_ep'_def
+                          st_tcb_at_refs_of_rev' pred_tcb_at'
+                          conj_comms fun_upd_def[symmetric]
+               split del: if_split)
+    apply (frule pred_tcb_at')
+    apply (drule simple_st_tcb_at_state_refs_ofD' st_tcb_at_state_refs_ofD')+
+    apply (clarsimp simp: valid_pspace'_splits)
+    apply (subst fun_upd_idem[where x=t])
+     apply (clarsimp split: if_split)
+     apply (rule conjI, clarsimp simp: obj_at'_def projectKOs)
+     apply (drule bound_tcb_at_state_refs_ofD')
+     apply (fastforce simp: tcb_bound_refs'_def)
+    apply (subgoal_tac "ex_nonz_cap_to' a s")
+     prefer 2
+     apply (clarsimp elim!: if_live_state_refsE)
+    apply clarsimp
+    apply (rule conjI)
+     apply (drule bound_tcb_at_state_refs_ofD')
+     apply (fastforce simp: tcb_bound_refs'_def set_eq_subset)
+    apply (clarsimp simp: conj_ac)
+    apply (rule conjI, clarsimp simp: idle'_no_refs)
+    apply (rule conjI, clarsimp simp: global'_no_ex_cap)
+    apply (rule conjI)
      apply (rule impI)
-     apply (drule (1) valid_replies'_other_state; clarsimp simp: isReceive_def)
-    apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKO_eq projectKO_tcb)
-    apply (erule if_live_then_nonz_capE')
-    apply (drule_tac ko=obj and p=t in sym_refs_ko_atD'[rotated])
-     apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb)
-    apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKO_eq  projectKO_tcb
-                          refs_of_rev' live_sc'_def valid_idle'_def idle_tcb'_def)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def isReceive_def is_BlockedOnReply_def)
-  \<comment> \<open>epa = IdleEP\<close>
+     apply (frule(1) ct_not_in_epQueue, clarsimp, clarsimp)
+     apply (clarsimp)
+    apply (simp add: ep_redux_simps')
+    apply (rule conjI, clarsimp split: if_split)
+     apply (rule conjI, fastforce simp: tcb_bound_refs'_def set_eq_subset)
+     apply (clarsimp, erule delta_sym_refs;
+            solves\<open>auto simp: symreftype_inverse' tcb_bound_refs'_def split: if_split_asm\<close>)
+    apply (solves\<open>clarsimp split: list.splits\<close>)
+   \<comment> \<open>epa = IdleEP\<close>
    apply (cases bl)
-    apply (wpsimp wp: sts_sch_act' sts_valid_queues setThreadState_ct_not_inQ
-                simp: invs'_def valid_dom_schedule'_def valid_ep'_def)
-    apply (fastforce simp: valid_tcb_state'_def valid_idle'_def pred_tcb_at'_def obj_at'_def
-                           projectKO_eq projectKO_tcb idle_tcb'_def comp_def)
-   apply wpsimp
-  \<comment> \<open>ep' = SendEP\<close>
+    apply (simp add: invs'_def valid_state'_def)
+    apply (rule hoare_pre, wp valid_irq_node_lift)
+     apply (simp add: valid_ep'_def)
+     apply (wp valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
+    apply (clarsimp simp: valid_tcb_state'_def pred_tcb_at')
+    apply (rule conjI, clarsimp elim!: obj_at'_weakenE)
+    apply (subgoal_tac "ep \<noteq> t")
+     apply (drule simple_st_tcb_at_state_refs_ofD' ko_at_state_refs_ofD'
+                  bound_tcb_at_state_refs_ofD')+
+     apply (rule conjI, erule delta_sym_refs)
+       apply (auto simp: tcb_bound_refs'_def symreftype_inverse'
+                  split: if_split_asm)[2]
+     apply (fastforce simp: global'_no_ex_cap)
+    apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
+   apply simp
+   apply wp
+   apply simp
+  \<comment> \<open>epa = SendEP\<close>
   apply (cases bl)
-   apply (wpsimp wp: tcbEPAppend_valid_SendEP sts_sch_act' sts_valid_queues setThreadState_ct_not_inQ
-                     sts'_valid_replies'
-               simp: invs'_def valid_dom_schedule'_def valid_pspace'_def
-                     valid_ep'_def sym_refs_asrt_def)
-   apply (erule valid_objsE'[where x=ep], fastforce simp: obj_at'_def projectKO_eq projectKO_ep)
-   apply (drule_tac ko="SendEP xa" in sym_refs_ko_atD'[rotated])
-    apply (fastforce simp: obj_at'_def projectKO_eq projectKO_ep)
-   apply (clarsimp simp: comp_def obj_at'_def pred_tcb_at'_def valid_idle'_def
-                         valid_tcb_state'_def valid_obj'_def valid_ep'_def
-                         idle_tcb'_def projectKO_eq projectKO_tcb)
-   apply (fastforce simp: ko_wp_at'_def refs_of_rev')
-  apply wpsimp
+   apply (simp add: invs'_def valid_state'_def)
+   apply (rule hoare_pre, wp valid_irq_node_lift)
+    apply (simp add: valid_ep'_def)
+    apply (wp hoare_vcg_const_Ball_lift valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
+   apply (clarsimp simp: valid_tcb_state'_def pred_tcb_at')
+   apply (rule conjI, clarsimp elim!: obj_at'_weakenE)
+   apply (frule obj_at_valid_objs', clarsimp)
+   apply (frule(1) sym_refs_ko_atD')
+   apply (frule pred_tcb_at')
+   apply (drule simple_st_tcb_at_state_refs_ofD')
+   apply (drule bound_tcb_at_state_refs_ofD')
+   apply (clarsimp simp: valid_obj'_def valid_ep'_def
+                         projectKOs st_tcb_at_refs_of_rev')
+   apply (rule conjI, clarsimp)
+    apply (drule (1) bspec)
+    apply (clarsimp dest!: st_tcb_at_state_refs_ofD' bound_tcb_at_state_refs_ofD'
+                     simp: tcb_bound_refs'_def)
+    apply (clarsimp simp: set_eq_subset)
+   apply (rule conjI, erule delta_sym_refs)
+     subgoal by (fastforce simp: obj_at'_def projectKOs symreftype_inverse'
+                     split: if_split_asm)
+    apply (fastforce simp: tcb_bound_refs'_def symreftype_inverse'
+                    split: if_split_asm)
+   apply (fastforce simp: global'_no_ex_cap idle'_not_queued)
+  apply (simp | wp)+
   done
 
 lemma sfi_invs_plus':
-  "\<lbrace>invs' and valid_idle' and st_tcb_at' active' t
+  "\<lbrace>invs' and st_tcb_at' simple' t
           and sch_act_not t
-          and (\<lambda>s. canDonate \<longrightarrow> bound_sc_tcb_at' (\<lambda>a. a \<noteq> None) t s)
-          and ex_nonz_cap_to' t
-          and (\<lambda>s. \<exists>n\<in>dom tcb_cte_cases. \<exists>cte. cte_wp_at' (\<lambda>cte. cteCap cte = cap) (t + n) s)\<rbrace>
-   sendFaultIPC t cap f canDonate
-   \<lbrace>\<lambda>_. invs'\<rbrace>,
-   \<lbrace>\<lambda>_. invs' and valid_idle' and st_tcb_at' active' t
-              and sch_act_not t
-              and (\<lambda>s. canDonate \<longrightarrow> bound_sc_tcb_at' (\<lambda>a. a \<noteq> None) t s)
-              and ex_nonz_cap_to' t
-              and (\<lambda>s. \<exists>n\<in>dom tcb_cte_cases. cte_wp_at' (\<lambda>cte. cteCap cte = cap) (t + n) s)\<rbrace>"
+          and ex_nonz_cap_to' t\<rbrace>
+   sendFaultIPC t f
+   \<lbrace>\<lambda>_. invs'\<rbrace>, \<lbrace>\<lambda>_. invs' and st_tcb_at' simple' t and sch_act_not t and (\<lambda>s. ksIdleThread s \<noteq> t)\<rbrace>"
   apply (simp add: sendFaultIPC_def)
   apply (wp threadSet_invs_trivial threadSet_pred_tcb_no_state
-            threadSet_cap_to' threadSet_idle'
+            threadSet_cap_to'
            | wpc | simp)+
-  apply (intro conjI impI allI; (fastforce simp: inQ_def)?)
-   apply (clarsimp simp: invs'_def valid_release_queue'_def obj_at'_def)
-  apply (fastforce simp: ex_nonz_cap_to'_def cte_wp_at'_def)
+   apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> sch_act_not t s
+                             \<and> st_tcb_at' simple' t s
+                             \<and> ex_nonz_cap_to' t s
+                             \<and> t \<noteq> ksIdleThread s
+                             \<and> (\<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s)"
+                 in hoare_strengthen_postE_R)
+    apply wp
+   apply (clarsimp simp: inQ_def pred_tcb_at')
+  apply (wp | simp)+
+  apply (clarsimp simp: eq_commute)
+  apply (subst(asm) global'_no_ex_cap, auto)
   done
 
 crunch send_fault_ipc
@@ -6139,130 +4170,75 @@ crunch send_fault_ipc
   (simp: crunch_simps wp: crunch_wps)
 
 lemma handleFault_corres:
-  assumes "fr f f'"
-  shows "corres dc (invs and valid_list and valid_sched_action and active_scs_valid
-                         and scheduler_act_not t and st_tcb_at active t and current_time_bounded
-                         and ex_nonz_cap_to t and K (valid_fault f))
-                   (invs' and sch_act_not t and st_tcb_at' active' t and ex_nonz_cap_to' t)
-                   (handle_fault t f) (handleFault t f')"
-  apply add_valid_idle'
-  using assms
+  "fr f f' \<Longrightarrow>
+   corres dc (einvs and  st_tcb_at active thread and ex_nonz_cap_to thread
+                   and (%_. valid_fault f))
+             (invs' and sch_act_not thread
+                    and st_tcb_at' simple' thread and ex_nonz_cap_to' thread)
+             (handle_fault thread f) (handleFault thread f')"
   apply (simp add: handle_fault_def handleFault_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: valid_idle'_asrt_def)
-  apply (rule corres_gen_asm)
   apply (rule corres_guard_imp)
-    apply (rule corres_split)
-       apply (rule getObject_TCB_corres)
-      apply (clarsimp simp: tcb_relation_def)
-      apply (rule corres_split_eqr)
-         apply (simp only: get_tcb_obj_ref_def)
-         apply (rule threadGet_corres, clarsimp simp: tcb_relation_def)
-        apply (rule corres_split_eqr)
-           apply (rule corres_split_catch[OF sendFaultIPC_corres])
-               apply (fastforce simp: tcb_relation_def)+
-          apply (clarsimp simp: handle_no_fault_def handleNoFaultHandler_def unless_def when_def)
-          apply (rule setThreadState_corres, simp)
-         apply (rule_tac Q'="\<lambda>_ s. invs s \<and> tcb_at t s" in hoare_strengthen_post[rotated])
-          apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-         apply wp
-        apply (rule hoare_strengthen_post[OF catch_wp[OF _ sfi_invs_plus']])
-         apply wpsimp
-        apply (clarsimp simp: invs'_def valid_pspace'_def)
-       apply (wp gbn_inv get_tcb_obj_ref_wp)
-      apply (wp hoare_vcg_imp_lift' threadGet_wp)
-     apply wp
-    apply (wp getObject_tcb_wp)
-   apply (clarsimp simp: pred_tcb_at_def obj_at_def is_tcb_def get_tcb_def cong: conj_cong)
-   apply (intro conjI)
-     apply (fastforce dest: invs_valid_objs simp: valid_obj_def valid_tcb_def tcb_cap_cases_def)
-    apply (fastforce dest: invs_valid_objs simp: valid_obj_def valid_tcb_def tcb_cap_cases_def)
-   apply (rule_tac x=3 in exI)
-   apply (fastforce simp: caps_of_state_tcb_index_trans get_tcb_def tcb_cnode_map_def)
-  apply (clarsimp simp: valid_tcb_def ran_tcb_cap_cases)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-  apply (drule_tac p=t and k="ko :: tcb" for ko in ko_at_valid_objs'[rotated, OF invs_valid_objs'])
-    apply (fastforce simp: obj_at'_def projectKOs)+
-  apply (rule conjI)
-   apply (clarsimp simp: valid_obj'_def valid_tcb'_def tcb_cte_cases_def)
-  apply (rule_tac x="0x30" in bexI)
-   apply (auto elim: cte_wp_at_tcbI' simp: objBitsKO_def return_def tcb_cte_cases_def)
+    apply (subst return_bind [symmetric],
+               rule corres_split[where P="tcb_at thread",
+                                  OF gets_the_noop_corres [where x="()"]])
+       apply (simp add: tcb_at_def)
+      apply (rule corres_split_catch)
+         apply (rule_tac F="valid_fault f" in corres_gen_asm)
+         apply (rule sendFaultIPC_corres, assumption)
+         apply simp
+        apply (rule handleDoubleFault_corres)
+       apply wp+
+   apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 invs_def
+                         valid_state_def valid_idle_def)
+  apply auto
   done
 
-lemma handleTimeout_corres:
-  assumes "fr f f'"
-  shows "corres dc (invs and valid_list and valid_sched_action and active_scs_valid
-                         and scheduler_act_not t and st_tcb_at active t and current_time_bounded
-                         and cte_wp_at is_ep_cap (t,tcb_cnode_index 4) and K (valid_fault f))
-                   invs'
-                   (handle_timeout t f) (handleTimeout t f')"
-  (is "corres _ ?G ?G' _ _")
-  apply add_valid_idle'
-  using assms
-  apply (clarsimp simp: handle_timeout_def handleTimeout_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: valid_idle'_asrt_def)
-  apply (rule corres_gen_asm)
-  apply (rule_tac Q="?G" and Q'="?G' and obj_at' (isEndpointCap \<circ> cteCap \<circ> tcbTimeoutHandler) t"
-               in stronger_corres_guard_imp)
-    apply (rule corres_symb_exec_r)
-       apply (rule corres_assert_assume_r)
-       apply (rule corres_guard_imp)
-         apply (rule corres_split[OF getObject_TCB_corres])
-           apply (rule corres_assert_assume_l)
-           apply (rule corres_split)
-              apply (rule corres_split_catch[OF sendFaultIPC_corres])
-                  apply fastforce
-                 apply (fastforce simp: tcb_relation_def)
-                apply (rule corres_trivial, clarsimp)
-               apply wp+
-             apply (rule corres_trivial, clarsimp)
-            apply (wp getTCB_wp)+
-        apply (fastforce simp: pred_tcb_at_def cte_wp_at_def obj_at_def is_tcb_def get_cap_def gets_the_def
-                               get_object_def get_tcb_def valid_obj_def valid_tcb_def bind_def
-                               return_def tcb_cap_cases_def tcb_cnode_map_def simpler_gets_def
-                         dest: invs_valid_objs)
-       apply assumption
-      apply (wpsimp wp: getTCB_wp simp: isValidTimeoutHandler_def)
-      apply (fastforce simp: isCap_simps pred_tcb_at'_def obj_at'_def projectKOs
-                             valid_obj'_def valid_tcb'_def tcb_cte_cases_def
-                       dest: invs_valid_objs')
-     apply (wpsimp wp: hoare_drop_imps simp: isValidTimeoutHandler_def)+
-  apply (frule cross_relF[OF _ tcb_at'_cross_rel[where t=t]], fastforce)
-  apply (clarsimp simp: pred_tcb_at_def pred_tcb_at'_def obj_at_def obj_at'_def
-                        is_tcb_def projectKOs state_relation_def pspace_relation_def)
-  apply (erule_tac x=t in ballE)
-   apply (auto simp: other_obj_relation_def tcb_relation_def cap_relation_def
-                     cte_wp_at_caps_of_state caps_of_state_def tcb_cnode_map_def
-                     get_object_def get_tcb_def get_cap_def simpler_gets_def
-                     return_def bind_def is_cap_simps isCap_simps gets_the_def)
+lemma sts_invs_minor'':
+  "\<lbrace>st_tcb_at' (\<lambda>st'. tcb_st_refs_of' st' = tcb_st_refs_of' st
+                   \<and> (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow>
+                      st' \<noteq> Inactive \<and> \<not> idle' st')) t
+      and (\<lambda>s. t = ksIdleThread s \<longrightarrow> idle' st)
+      and (\<lambda>s. \<not> runnable' st \<longrightarrow> sch_act_not t s)
+      and invs'\<rbrace>
+     setThreadState st t
+   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def)
+  apply (rule hoare_pre)
+   apply (wp valid_irq_node_lift sts_sch_act' setThreadState_ct_not_inQ)
+  apply clarsimp
+  apply (rule conjI)
+   apply fastforce
+  apply (rule conjI)
+   apply (clarsimp simp: pred_tcb_at'_def)
+   apply (drule obj_at_valid_objs')
+    apply (clarsimp simp: valid_pspace'_def)
+   apply (clarsimp simp: valid_obj'_def valid_tcb'_def projectKOs)
+   subgoal by (cases st, auto simp: valid_tcb_state'_def
+                        split: Structures_H.thread_state.splits)[1]
+  apply (rule conjI)
+   apply (clarsimp dest!: st_tcb_at_state_refs_ofD'
+                   elim!: rsubst[where P=sym_refs]
+                  intro!: ext)
+  apply (fastforce elim!: st_tcb_ex_cap'')
   done
 
 lemma hf_invs' [wp]:
-  "\<lbrace>invs'
-          and st_tcb_at' active' t
-          and ex_nonz_cap_to' t\<rbrace>
-   handleFault t f
-   \<lbrace>\<lambda>r. invs'\<rbrace>"
-  apply (simp add: handleFault_def handleNoFaultHandler_def sendFaultIPC_def valid_idle'_asrt_def)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (wpsimp wp: sts_invs_minor' threadSet_invs_trivialT threadSet_pred_tcb_no_state getTCB_wp
-                    threadGet_wp threadSet_cap_to' hoare_vcg_all_lift hoare_vcg_imp_lift' threadSet_idle'
-        | fastforce simp: tcb_cte_cases_def)+
-  apply (clarsimp simp: invs'_def inQ_def)
-  apply (subgoal_tac "st_tcb_at' (\<lambda>st'. tcb_st_refs_of' st' = {}) t s")
-   apply (rule_tac x=ko in exI)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-   apply (intro conjI impI allI; clarsimp?)
-    apply (clarsimp simp: valid_release_queue'_def obj_at'_def)
-   apply (clarsimp simp: ex_nonz_cap_to'_def return_def fail_def oassert_opt_def
-                         projectKO_def projectKO_tcb
-                  split: option.splits)
-   apply (rule_tac x="t+0x30" in exI)
-   apply (fastforce elim: cte_wp_at_tcbI' simp: objBitsKO_def)
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def valid_idle'_def idle_tcb'_def)
+  "\<lbrace>invs' and sch_act_not t
+          and st_tcb_at' simple' t
+          and ex_nonz_cap_to' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
+   handleFault t f \<lbrace>\<lambda>r. invs'\<rbrace>"
+  apply (simp add: handleFault_def)
+  apply wp
+   apply (simp add: handleDoubleFault_def)
+   apply (wp sts_invs_minor'' dmo_invs')+
+  apply (rule hoare_strengthen_postE, rule sfi_invs_plus',
+         simp_all)
+  apply (strengthen no_refs_simple_strg')
+  apply clarsimp
   done
 
+declare zipWithM_x_mapM [simp del]
+
 lemma gts_st_tcb':
   "\<lbrace>\<top>\<rbrace> getThreadState t \<lbrace>\<lambda>r. st_tcb_at' (\<lambda>st. st = r) t\<rbrace>"
   apply (rule hoare_strengthen_post)
@@ -6270,356 +4246,69 @@ lemma gts_st_tcb':
   apply simp
   done
 
-crunch replyRemove
-  for ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  (simp: crunch_simps)
+declare setEndpoint_ct' [wp]
+
+lemma setupCallerCap_pred_tcb_unchanged:
+  "\<lbrace>pred_tcb_at' proj P t and K (t \<noteq> t')\<rbrace>
+     setupCallerCap t' t'' g
+   \<lbrace>\<lambda>rv. pred_tcb_at' proj P t\<rbrace>"
+  apply (simp add: setupCallerCap_def getThreadCallerSlot_def
+                   getThreadReplySlot_def)
+  apply (wp sts_pred_tcb_neq' hoare_drop_imps)
+  apply clarsimp
+  done
+
+lemma si_blk_makes_simple':
+  "\<lbrace>st_tcb_at' simple' t and K (t \<noteq> t')\<rbrace>
+     sendIPC True call bdg x x' t' ep
+   \<lbrace>\<lambda>rv. st_tcb_at' simple' t\<rbrace>"
+  apply (simp add: sendIPC_def)
+  apply (rule bind_wp [OF _ get_ep_inv'])
+  apply (case_tac rv, simp_all)
+    apply (rename_tac list)
+    apply (case_tac list, simp_all add: case_bool_If case_option_If
+                             split del: if_split cong: if_cong)
+    apply (rule hoare_pre)
+     apply (wp sts_st_tcb_at'_cases setupCallerCap_pred_tcb_unchanged
+               hoare_drop_imps)
+    apply (clarsimp simp: pred_tcb_at' del: disjCI)
+   apply (wp sts_st_tcb_at'_cases)
+   apply clarsimp
+  apply (wp sts_st_tcb_at'_cases)
+  apply clarsimp
+  done
 
-crunch getSanitiseRegisterInfo
- for inv[wp]: P
+lemma si_blk_makes_runnable':
+  "\<lbrace>st_tcb_at' runnable' t and K (t \<noteq> t')\<rbrace>
+     sendIPC True call bdg x x' t' ep
+   \<lbrace>\<lambda>rv. st_tcb_at' runnable' t\<rbrace>"
+  apply (simp add: sendIPC_def)
+  apply (rule bind_wp [OF _ get_ep_inv'])
+  apply (case_tac rv, simp_all)
+    apply (rename_tac list)
+    apply (case_tac list, simp_all add: case_bool_If case_option_If
+                             split del: if_split cong: if_cong)
+    apply (rule hoare_pre)
+     apply (wp sts_st_tcb_at'_cases setupCallerCap_pred_tcb_unchanged
+               hoare_vcg_const_imp_lift hoare_drop_imps
+              | simp)+
+    apply (clarsimp del: disjCI simp: pred_tcb_at' elim!: pred_tcb'_weakenE)
+   apply (wp sts_st_tcb_at'_cases)
+   apply clarsimp
+  apply (wp sts_st_tcb_at'_cases)
+  apply clarsimp
+  done
 
-lemma handleFaultReply_invs[wp]:
-  "\<lbrace>invs' and tcb_at' t\<rbrace> handleFaultReply x t label msg \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  unfolding handleFaultReply_def
-  by (cases x; wpsimp simp: handleArchFaultReply_def split: arch_fault.split)
+crunch possibleSwitchTo, completeSignal
+  for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
 
-lemma doReplyTransfer_corres:
-  "corres dc
-     (einvs and reply_at reply and tcb_at sender and current_time_bounded)
-     invs'
-     (do_reply_transfer sender reply grant)
-     (doReplyTransfer sender reply grant)"
-  apply add_cur_tcb'
-  supply if_split [split del] subst_all[simp del]
-  apply (simp add: do_reply_transfer_def doReplyTransfer_def cong: option.case_cong)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split [OF getReply_TCB_corres])
-      apply (simp add: maybeM_def)
-      apply (rule corres_option_split [OF refl corres_return_trivial])
-      apply (rename_tac recv_opt receiverOpt recvr)
-      apply (rule_tac Q="\<lambda>s. einvs s \<and> tcb_at sender s \<and> tcb_at recvr s \<and> current_time_bounded s \<and>
-                             reply_tcb_reply_at (\<lambda>xa. xa = Some recvr) reply s" and
-                      Q'="invs' and cur_tcb'"
-             in corres_split [OF _ _ gts_sp gts_sp' ])
-       apply (rule getThreadState_corres, simp, rename_tac ts ts')
-      apply (case_tac ts; simp add: isReply_def)
-      apply (rule stronger_corres_guard_imp)
-        apply (rule corres_assert_assume_l)
-        apply (rule corres_split [OF replyRemove_corres], (rule refl)+)
-          apply (rule corres_split_eqr[OF get_tcb_obj_ref_corres])
-             apply (clarsimp simp: tcb_relation_def)
-            apply (rule corres_split [OF ifCondRefillUnblockCheck_corres])
-              apply (rule corres_split [OF threadget_fault_corres])
-                apply (rule corres_split)
-                   apply (rule_tac P="tcb_at sender and tcb_at recvr and valid_objs and pspace_aligned and
-                                      valid_list and pspace_distinct and valid_mdb and cur_tcb
-                                      and current_time_bounded" and
-                                   P'="tcb_at' sender and tcb_at' recvr and valid_pspace' and cur_tcb' and
-                                       valid_release_queue and valid_release_queue'"
-                          in corres_guard_imp)
-                     apply (simp add: fault_rel_optionation_def)
-                     apply (rule corres_option_split; simp)
-                      apply (rule corres_split [OF doIPCTransfer_corres setThreadState_corres])
-                        apply (clarsimp simp: thread_state_relation_def)
-                       prefer 3
-                       apply (rule corres_split_mapr[OF getMessageInfo_corres])
-                         apply (rule corres_split_eqr[OF lookupIPCBuffer_corres'])
-                           apply (rule corres_split_eqr[OF getMRs_corres], simp)
-                             apply (simp (no_asm) del: dc_simp)
-                             apply (rule corres_split_eqr[OF handleFaultReply_corres], simp)
-                               apply (rule corres_split [OF threadset_corresT setThreadState_corres])
-                                    apply (clarsimp simp: tcb_relation_def fault_rel_optionation_def)
-                                   apply (clarsimp simp: tcb_cap_cases_def)
-                                  apply (clarsimp simp: tcb_cte_cases_def)
-                                 apply (clarsimp simp: thread_state_relation_def split: if_split)
-                                (* solving hoare_triples *)
-                                apply (clarsimp simp: valid_tcb_state_def)
-                                apply (rule_tac Q="\<lambda>_. valid_objs and pspace_aligned and
-                                                       pspace_distinct and tcb_at recvr
-                                                       and current_time_bounded" in
-                                        hoare_strengthen_post[rotated])
-                                 apply (clarsimp simp: valid_objs_valid_tcbs)
-                                apply (wpsimp wp: thread_set_fault_valid_objs)
-                               apply (wpsimp wp: threadSet_valid_tcbs' threadSet_valid_release_queue_inv
-                                                 threadSet_valid_release_queue'_inv)
-                              apply (clarsimp simp: pred_conj_def cong: conj_cong)
-                              apply wpsimp+
-                             apply (strengthen valid_objs'_valid_tcbs')
-                             apply wpsimp+
-                      apply (strengthen valid_objs_valid_tcbs)
-                      apply wpsimp+
-                     apply (strengthen valid_objs'_valid_tcbs')
-                     apply wpsimp
-                    apply (clarsimp split: option.splits)
-                   apply (clarsimp split: option.splits simp: valid_pspace'_def)
-                  apply (clarsimp simp: isRunnable_def get_tcb_obj_ref_def)
-                  (* solve remaining corres goals *)
-                  apply (rule corres_split [OF getThreadState_corres])
-                    apply (rule corres_split [OF threadGet_corres[where r="(=)"]])
-                       apply (simp add: tcb_relation_def)
-                      apply (rename_tac scopt scopt')
-                      apply (rule corres_when)
-                       apply (case_tac state; simp add: thread_state_relation_def)
-                      apply (rule corres_assert_opt_assume_l)
-                      apply (rule_tac Q="valid_sched_action and tcb_at recvr
-                                         and sc_tcb_sc_at (\<lambda>a. a \<noteq> None) (the scopt) and
-                                         active_sc_at (the scopt) and valid_refills (the scopt) and
-                                         valid_release_q and active_scs_valid and
-                                         (\<lambda>s. sc_tcb_sc_at (\<lambda>sc. \<exists>t. sc = Some t \<and> not_queued t s) (the scopt) s) and
-                                         invs and valid_list and scheduler_act_not recvr
-                                         and current_time_bounded and st_tcb_at active recvr"
-                                  and Q'="invs' and tcb_at' recvr and sc_at' (the scopt) and cur_tcb'"
-                                  and P'="invs' and sc_at' (the scopt') and tcb_at' recvr and cur_tcb'"
-                                  and P="valid_sched_action and tcb_at recvr and current_time_bounded and
-                                         sc_tcb_sc_at (\<lambda>a. a \<noteq> None) (the scopt) and
-                                         active_sc_at (the scopt) and valid_refills (the scopt) and
-                                         valid_release_q and active_scs_valid and
-                                         (\<lambda>s. sc_tcb_sc_at (\<lambda>sc. \<exists>t. sc = Some t \<and> not_queued t s) (the scopt) s) and
-                                         invs and valid_list and scheduler_act_not recvr and st_tcb_at active recvr"
-                             in stronger_corres_guard_imp)
-
-                        (* this next section by somewhat complicated symbolic executions *)
-                        apply (rule corres_symb_exec_l [OF _ _ get_sched_context_sp], rename_tac sc)
-                          apply (rule corres_symb_exec_l [OF _ _ gets_sp], rename_tac ct)
-                            apply (rule corres_symb_exec_r [OF _ refillReady_sp], rename_tac ready)
-                              apply (rule corres_symb_exec_r [OF _ refillSufficient_sp], rename_tac suff)
-                                apply (rule_tac Q="\<lambda>_. ready = sc_refill_ready ct sc \<and> suff = sc_refill_sufficient 0 sc" in corres_cross_add_guard[rotated])
-                                 apply (rule_tac corres_gen_asm2)
-                                 apply (rule stronger_corres_guard_imp)
-                                   apply (rule corres_if, simp)
-                                    apply (rule possibleSwitchTo_corres; (solves simp)?)
-                                   apply (rule corres_symb_exec_r[OF _ get_sc_sp'], rename_tac sc')
-                                     apply (rule_tac Q="\<lambda>_. sc_badge sc = scBadge sc'" in corres_cross_add_guard[rotated])
-                                      apply (rule_tac corres_gen_asm2)
-                                      apply (rule_tac Q="\<lambda>s. active_scs_valid s \<and>
-                                               is_active_sc (the scopt') s \<and> current_time_bounded s \<and>
-                                               sc_tcb_sc_at (\<lambda>sc. \<exists>t. sc = Some t \<and> not_queued t s) (the scopt) s \<and>
-                                               invs s \<and> valid_release_q s \<and> tcb_at recvr s \<and>
-                                               valid_list s \<and> valid_sched_action s \<and>
-                                               scheduler_act_not recvr s \<and> st_tcb_at active recvr s"
-                                             in corres_guard_imp)
-                                        apply (rule corres_symb_exec_l [OF _ _ gets_the_get_tcb_sp], rename_tac tcb)
-                                          apply (rule_tac Q'="\<lambda>s. invs' s \<and> (\<forall>ko. ko_at' ko recvr s \<longrightarrow>
-                                                   capability.is_EndpointCap (cteCap (tcbTimeoutHandler ko)) =
-                                                   is_ep_cap (tcb_timeout_handler tcb)) \<and> tcb_at' recvr s \<and> cur_tcb' s"
-                                                 and P'="\<lambda>s. invs' s \<and> tcb_at' recvr s \<and> cur_tcb' s"
-                                                 in stronger_corres_guard_imp)
-                                            apply (rule corres_symb_exec_r [OF _ isValidTimeoutHandler_sp], rename_tac isHV)
-                                              apply (rule corres_symb_exec_r, rename_tac isT)
-                                                 apply (rule_tac F="isHV = is_ep_cap (tcb_timeout_handler tcb) \<and>
-                                                          isT = (case fault of None \<Rightarrow> False | Some a \<Rightarrow> is_timeout_fault a)"
-                                                        in corres_gen_asm2)
-                                                 apply (rule corres_if2[OF _ handleTimeout_corres, rotated])
-                                                   apply (clarsimp)
-                                                  apply (simp, rule postpone_corres)
-                                                 apply simp
-                                                apply wpsimp
-                                                apply (clarsimp simp: fault_rel_optionation_def if_distribR)
-                                                apply (clarsimp simp: invs'_def valid_pspace'_def)
-                                                apply (auto simp: is_timeout_fault_def fault_map_def split: ExceptionTypes_A.fault.splits)[1]
-
-                                               (* solve final hoare triple goals *)
-                                               apply wpsimp
-                                              apply wpsimp
-                                             apply (wpsimp wp: hoare_drop_imp simp: isValidTimeoutHandler_def)
-                                            apply (wpsimp simp: isValidTimeoutHandler_def)
-                                           apply (clarsimp split: if_split simp: valid_fault_def invs_def valid_state_def valid_pspace_def)
-                                           apply (clarsimp simp: tcb_cnode_map_def obj_at_def TCB_cte_wp_at_obj_at)
-                                          apply (clarsimp simp: obj_at_def)
-                                          apply (frule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-                                          apply (clarsimp simp: other_obj_relation_def obj_at'_def projectKOs tcb_relation_def)
-                                          apply (case_tac "cteCap (tcbTimeoutHandler ko)";
-                                                 case_tac "tcb_timeout_handler tcb"; simp)
-                                         apply (wpsimp simp: tcb_at_def)
-                                        apply (wpsimp simp: tcb_at_def)
-                                       apply (assumption)
-                                      apply clarsimp
-                                      apply (subgoal_tac "invs' s \<and> tcb_at' recvr s \<and> cur_tcb' s
-                                                          \<and> obj_at' (\<lambda>sc'. sc_badge sc = scBadge sc') (the scopt') s")
-                                       apply (clarsimp simp: obj_at'_def)
-                                      apply (assumption)
-                                     apply (clarsimp simp: obj_at'_def)
-                                    apply wpsimp
-                                   apply wpsimp
-
-                                  apply (clarsimp simp: invs_def valid_state_def valid_pspace_def active_sc_at_equiv
-                                                 split: if_split)
-                                 apply (clarsimp simp: invs_def valid_state_def valid_pspace_def invs'_def
-                                                       valid_pspace'_def
-                                                split: if_split)
-                                 apply (frule (1) valid_objs_ko_at, clarsimp simp: valid_obj_def)
-                                 apply (clarsimp simp: obj_at_def)
-                                 apply (frule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-                                 apply (clarsimp simp: other_obj_relation_def obj_at'_def projectKOs sc_relation_def)
-                                apply (clarsimp simp: invs_def valid_state_def valid_pspace_def invs'_def valid_pspace'_def)
-                                apply (frule (1) valid_objs_ko_at, clarsimp simp: valid_obj_def)
-                                apply (prop_tac "sc_relation sc n ko")
-                                 apply (clarsimp simp: obj_at_def)
-                                 apply (frule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-                                 apply (clarsimp simp: other_obj_relation_def obj_at'_def projectKOs )
-                                apply (frule (1) sc_ko_at_valid_objs_valid_sc', clarsimp)
-                                apply (subgoal_tac "0 < scRefillMax ko")
-                                 apply (subgoal_tac "sc_valid_refills sc")
-                                  apply (prop_tac "koa=ko", erule (1) ko_at'_inj, simp only:)
-                                  apply (subgoal_tac "sc_valid_refills' ko")
-                                   apply (simp add: sc_refill_ready_relation sc_refill_sufficient_relation state_relation_def active_sc_at_equiv)
-                                  apply (metis valid_sched_context'_def sc_valid_refills_scRefillCount)
-                                 apply (subst (asm) active_sc_at_equiv)
-                                 apply (frule (1) active_scs_validE)
-                                 apply (clarsimp simp: valid_refills_def2 obj_at_def)
-                                apply (clarsimp simp: obj_at_def vs_all_heap_simps active_sc_def
-                                                      sc_relation_def)
-                               apply wpsimp
-                              apply (wpsimp simp: refillSufficient_def getRefills_def obj_at'_def)
-                             apply (wpsimp wp: refillReady_wp)
-                            apply (simp add: refillReady_def, rule no_ofail_gets_the)
-                            apply wpsimp
-                           apply wpsimp
-                          apply (clarsimp simp: obj_at_def sc_at_pred_n_def get_sched_context_exs_valid)
-                         apply (rule get_sched_context_exs_valid)
-                         apply (clarsimp simp: sc_at_pred_n_def obj_at_def)
-                        apply ((wpsimp simp: obj_at_def is_sc_obj_def
-                               | clarsimp split: Structures_A.kernel_object.splits)+)[1]
-                       apply simp
-                      apply clarsimp
-                     apply (wpsimp wp: thread_get_wp')
-                    apply (wpsimp wp: threadGet_wp)
-                   apply (wpsimp wp: gts_wp)
-                  apply (wpsimp wp: gts_wp')
-                 apply (rule_tac Q'="\<lambda>_. tcb_at recvr and valid_sched_action and invs and valid_list
-                                        and valid_release_q and scheduler_act_not recvr
-                                        and active_scs_valid and current_time_bounded
-                                        and active_if_bound_sc_tcb_at recvr
-                                        and not_queued recvr"
-                        in hoare_strengthen_post[rotated])
-                  apply (clarsimp simp: obj_at_def is_tcb)
-                  apply (subgoal_tac "pred_map (\<lambda>a. a = Some y) (tcb_scps_of s) recvr")
-                   apply (subgoal_tac "pred_map (\<lambda>a. a = Some recvr) (sc_tcbs_of s) y")
-                    apply (intro conjI)
-                        apply (clarsimp simp: vs_all_heap_simps sc_at_kh_simps)
-                       apply (clarsimp simp: vs_all_heap_simps)
-                      apply (erule active_scs_validE[rotated], clarsimp simp: vs_all_heap_simps)
-                     apply (clarsimp simp: vs_all_heap_simps sc_at_kh_simps)
-                    apply (clarsimp simp: vs_all_heap_simps pred_tcb_at_def obj_at_def runnable_eq)
-                   apply (simp add: sc_at_kh_simps pred_map_eq_normalise heap_refs_inv_def2)
-                   apply (erule heap_refs_retractD[rotated], clarsimp)
-                  apply (clarsimp simp: vs_all_heap_simps)
-                 apply (wpsimp wp: set_thread_state_valid_sched_action set_thread_state_valid_release_q
-                                   sts_invs_minor2)
-                     apply (rule_tac Q'="\<lambda>_ s.
-                               st_tcb_at inactive recvr s \<and>
-                               invs s \<and> valid_list s \<and> scheduler_act_not recvr s \<and>
-                               ex_nonz_cap_to recvr s \<and> current_time_bounded s \<and>
-                               recvr \<noteq> idle_thread s \<and>
-                               fault_tcb_at ((=) None) recvr s \<and>
-                               valid_release_q s \<and>
-                               active_scs_valid s \<and>
-                               heap_refs_inv (sc_tcbs_of s) (tcb_scps_of s) \<and>
-                               (pred_map_eq None (tcb_scps_of s) recvr \<or> active_sc_tcb_at recvr s) \<and>
-                               not_queued recvr s \<and> not_in_release_q recvr s"
-                            in hoare_strengthen_post[rotated])
-                      apply (clarsimp split: if_split simp: pred_tcb_at_def obj_at_def)
-                     apply (wpsimp wp: thread_set_no_change_tcb_state thread_set_cap_to
-                                       thread_set_no_change_tcb_state
-                                       thread_set_pred_tcb_at_sets_true simp: ran_tcb_cap_cases)
-                    apply simp
-                    apply (wpsimp wp: hoare_drop_imp)
-                   apply wpsimp
-                  apply wpsimp
-                 apply wpsimp
-                apply (rule_tac Q'="\<lambda>_. tcb_at' recvr and invs' and cur_tcb'" in hoare_strengthen_post[rotated])
-                 apply (clarsimp simp: tcb_at'_ex_eq_all invs'_def valid_pspace'_def)
-                 apply (frule (1) tcb_ko_at_valid_objs_valid_tcb', clarsimp simp: valid_tcb'_def)
-                apply (wpsimp wp: sts_invs')
-                 apply (rule_tac Q'="\<lambda>_. invs' and ex_nonz_cap_to' recvr and tcb_at' recvr
-                                        and (st_tcb_at' (\<lambda>st. st = Inactive) recvr) and cur_tcb'"
-                        in hoare_strengthen_post[rotated])
-                  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-                 apply wpsimp
-                apply (wpsimp wp: sts_invs')
-                    apply (rule_tac Q'="\<lambda>_. invs' and sch_act_not recvr and ex_nonz_cap_to' recvr and tcb_at' recvr
-                                           and (st_tcb_at' (\<lambda>st. st = Inactive) recvr) and cur_tcb'"
-                           in hoare_strengthen_post[rotated])
-                     apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
-                     apply (fastforce dest: global'_no_ex_cap simp: invs'_def split: if_split)
-                    apply (wpsimp wp: threadSet_fault_invs' threadSet_pred_tcb_no_state threadSet_cur)
-                   apply wpsimp+
-               apply (wpsimp wp: thread_get_wp')
-              apply (wpsimp wp: threadGet_wp)
-             apply (rule_tac Q'="\<lambda>_. tcb_at sender and tcb_at recvr and invs and valid_list and
-                       valid_sched and scheduler_act_not recvr and not_in_release_q recvr and
-                       active_if_bound_sc_tcb_at recvr and st_tcb_at inactive recvr and
-                       ex_nonz_cap_to recvr and not_queued recvr and current_time_bounded"
-                    in hoare_strengthen_post[rotated])
-              apply (clarsimp simp: valid_sched_def invs_def valid_state_def valid_pspace_def
-                                    pred_tcb_at_def obj_at_def
-                             dest!: idle_no_ex_cap)
-             apply (wpsimp wp: refill_unblock_check_valid_sched
-                         simp: if_cond_refill_unblock_check_def)
-            apply (rule_tac Q'="\<lambda>_. tcb_at' recvr and invs' and cur_tcb' and tcb_at' sender
-            and ex_nonz_cap_to' recvr and sch_act_not recvr and st_tcb_at' ((=) Inactive) recvr"
-                   in hoare_strengthen_post[rotated])
-             apply (clarsimp simp: op_equal invs'_def obj_at'_def)
-            apply wpsimp
-           apply (wpsimp wp: get_tcb_obj_ref_wp)
-          apply (wpsimp wp: threadGet_wp)
-         apply (rule_tac Q'="\<lambda>_. tcb_at sender and tcb_at recvr and invs and valid_list and
-                   valid_sched and scheduler_act_not recvr and not_in_release_q recvr and
-                   active_if_bound_sc_tcb_at recvr and st_tcb_at inactive recvr and
-                   ex_nonz_cap_to recvr and not_queued recvr and current_time_bounded"
-                in hoare_strengthen_post[rotated])
-          apply (clarsimp simp: valid_sched_def invs_def valid_state_def valid_pspace_def
-                         dest!: idle_no_ex_cap)
-          apply (erule disjE;
-                 clarsimp simp: vs_all_heap_simps obj_at_def is_sc_obj opt_map_red opt_pred_def)
-          apply (rule conjI)
-           apply (erule (1) valid_sched_context_size_objsI)
-          apply (clarsimp split: if_split)
-          apply (drule sym_refs_inv_tcb_scps, rename_tac scp sc n t tcb')
-          apply (prop_tac "heap_ref_eq scp t (tcb_scps_of s) \<and> heap_ref_eq scp recvr (tcb_scps_of s)")
-           apply (clarsimp simp: vs_all_heap_simps)
-          apply (clarsimp simp: heap_refs_inv_def2 vs_all_heap_simps)
-
-         apply (wpsimp wp: reply_remove_valid_sched reply_remove_active_if_bound_sc_tcb_at reply_remove_invs)
-        apply (rule_tac Q'="\<lambda>_. tcb_at' sender and invs' and sch_act_not recvr and ex_nonz_cap_to' recvr and tcb_at' recvr
-                               and st_tcb_at' (\<lambda>a. a = Structures_H.thread_state.Inactive) recvr and cur_tcb'"
-               in hoare_strengthen_post[rotated])
-         apply (clarsimp simp: obj_at'_def invs'_def valid_pspace'_def op_equal split: option.split)
-        apply (wpsimp simp: valid_pspace'_def wp: replyRemove_invs')
-       apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_def
-                             valid_sched_action_weak_valid_sched_action
-                       cong: conj_cong)
-       apply (rename_tac recvr ts_reply s s')
-       apply (subgoal_tac "ts_reply = reply", simp)
-        apply (rule conjI, fastforce)
-        apply (rule context_conjI)
-         apply (clarsimp simp: tcb_at_kh_simps pred_map_def)
-        apply (subgoal_tac "\<not> pred_map runnable (tcb_sts_of s) recvr")
-         apply (intro conjI)
-             apply (rule weak_valid_sched_action_contrap; simp add: valid_sched_action_def)
-            apply (rule valid_release_q_not_in_release_q_not_runnable; clarsimp simp: tcb_at_kh_simps pred_map_def)
-           apply (erule (1) released_ipc_queuesE1)
-          apply (erule (1) st_tcb_ex_cap, clarsimp)
-         apply (erule valid_ready_qs_not_queued_not_runnable, clarsimp)
-         apply (clarsimp simp: tcb_at_kh_simps pred_map_def)
-        apply (clarsimp simp: tcb_at_kh_simps pred_map_def)
-       apply (erule (2) reply_tcb_sym_refsD)
-      apply (clarsimp simp: invs'_def valid_pspace'_def cong: conj_cong)
-      apply (intro conjI)
-         apply (erule cross_relF[OF _ tcb_at'_cross_rel[where t=sender]], fastforce)
-        apply (erule (1) st_tcb_ex_cap'', simp)
-       apply (prop_tac "sch_act_wf (ksSchedulerAction s') s'")
-        apply (fastforce dest: sch_act_wf_cross)
-       apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-      apply (wpsimp wp: get_simple_ko_wp)+
-   apply (clarsimp split: option.split simp: invs_def valid_state_def valid_pspace_def)
-   apply (frule (1) valid_objs_ko_at)
-   apply (clarsimp simp: valid_obj_def valid_reply_def obj_at_def reply_tcb_reply_at_def)
-  apply (clarsimp split: option.split
-                   simp: invs_def valid_state_def valid_pspace_def invs'_def
-                         valid_pspace'_def)
-  apply (frule cross_relF[OF _ reply_at'_cross_rel[where t=reply]]; clarsimp)
-  apply (frule (1) reply_ko_at_valid_objs_valid_reply')
-  apply (clarsimp simp: valid_reply'_def)
+lemma sendSignal_st_tcb'_Running:
+  "\<lbrace>st_tcb_at' (\<lambda>st. st = Running \<or> P st) t\<rbrace>
+     sendSignal ntfnptr bdg
+   \<lbrace>\<lambda>_. st_tcb_at' (\<lambda>st. st = Running \<or> P st) t\<rbrace>"
+  apply (simp add: sendSignal_def)
+  apply (wp sts_st_tcb_at'_cases cancelIPC_st_tcb_at' gts_wp' getNotification_wp hoare_weak_lift_imp
+       | wpc | clarsimp simp: pred_tcb_at')+
   done
 
 end
diff --git a/proof/refine/ARM/KHeap_R.thy b/proof/refine/ARM/KHeap_R.thy
index ca287174fe..9473f54f06 100644
--- a/proof/refine/ARM/KHeap_R.thy
+++ b/proof/refine/ARM/KHeap_R.thy
@@ -1,5 +1,4 @@
 (*
- * Copyright 2022, Proofcraft Pty Ltd
  * Copyright 2014, General Dynamics C4 Systems
  *
  * SPDX-License-Identifier: GPL-2.0-only
@@ -7,84 +6,22 @@
 
 theory KHeap_R
 imports
-  "AInvs.AInvs"
+  "AInvs.ArchDetSchedSchedule_AI"
   Machine_R
 begin
 
-lemma obj_at_replyTCBs_of:
-  "obj_at' (\<lambda>reply. replyTCB reply = tptr_opt) rptr s
-   \<Longrightarrow> replyTCBs_of s rptr = tptr_opt"
-  by (clarsimp simp: obj_at'_def projectKOs opt_map_def)
-
-abbreviation
-  "valid_replies'_alt s \<equiv>
-     (\<forall>rptr rp. ko_at' rp rptr s \<and> ((\<exists>rp'. replyNext rp = Some (Next rp')) \<or> replyPrev rp \<noteq> None)
-                \<longrightarrow> (\<exists>tptr. replyTCB rp = Some tptr
-                            \<and> st_tcb_at' ((=) (BlockedOnReply (Some rptr))) tptr s))"
-
-lemma valid_replies'_def2:
-  "pspace_distinct' s \<Longrightarrow> pspace_aligned' s \<Longrightarrow>
-   valid_replies' s = valid_replies'_alt s"
-  unfolding valid_replies'_def
-  apply (rule iffI; clarsimp simp: obj_at'_def projectKOs valid_sz_simps)
-   apply (drule_tac x=rptr in spec, clarsimp simp: opt_map_def)
-  apply (clarsimp simp: pspace_alignedD' pspace_distinctD' opt_map_def projectKOs
-                  split: option.splits)
-  done
-
-primrec
-  same_caps' :: "Structures_H.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
-where
-  "same_caps' val (KOTCB tcb) = (\<exists>tcb'. val = KOTCB tcb' \<and>
-                                        (\<forall>(getF, t) \<in> ran tcb_cte_cases. getF tcb' = getF tcb))"
-| "same_caps' val (KOCTE cte) = (val = KOCTE cte)"
-| "same_caps' val (KOEndpoint ep) = (\<exists>ep'. val = KOEndpoint ep')"
-| "same_caps' val (KONotification ntfn) = (\<exists>ntfn'. val = KONotification ntfn')"
-| "same_caps' val (KOKernelData) = (val = KOKernelData)"
-| "same_caps' val (KOUserData) = (val = KOUserData)"
-| "same_caps' val (KOUserDataDevice) = (val = KOUserDataDevice)"
-| "same_caps' val (KOArch ao) = (\<exists>ao'. val = KOArch ao')"
-| "same_caps' val (KOSchedContext sc) = (\<exists>sc'. val = KOSchedContext sc')"
-| "same_caps' val (KOReply r) = (\<exists>r'. val = KOReply r')"
-
-lemma same_caps'_more_simps[simp]:
-  "same_caps' (KOTCB tcb) val = (\<exists>tcb'. val = KOTCB tcb' \<and>
-                                        (\<forall>(getF, t) \<in> ran tcb_cte_cases. getF tcb' = getF tcb))"
-  "same_caps' (KOCTE cte) val = (val = KOCTE cte)"
-  "same_caps' (KOEndpoint ep) val = (\<exists>ep'. val = KOEndpoint ep')"
-  "same_caps' (KONotification ntfn) val = (\<exists>ntfn'. val = KONotification ntfn')"
-  "same_caps' (KOKernelData) val = (val = KOKernelData)"
-  "same_caps' (KOUserData) val = (val = KOUserData)"
-  "same_caps' (KOUserDataDevice) val = (val = KOUserDataDevice)"
-  "same_caps' (KOArch ao) val = (\<exists>ao'. val = KOArch ao')"
-  "same_caps' (KOSchedContext sc) val = (\<exists>sc'. val = KOSchedContext sc')"
-  "same_caps' (KOReply r) val = (\<exists>r'. val = KOReply r')"
-  by (cases val; fastforce)+
-
 lemma lookupAround2_known1:
   "m x = Some y \<Longrightarrow> fst (lookupAround2 x m) = Some (x, y)"
   by (fastforce simp: lookupAround2_char1)
 
-abbreviation (input)
-  set_ko' :: "machine_word \<Rightarrow> kernel_object \<Rightarrow> kernel_state \<Rightarrow> kernel_state"
-where
-  "set_ko' ptr ko s \<equiv> s\<lparr>ksPSpace := (ksPSpace s)(ptr := Some ko)\<rparr>"
-
-abbreviation (input)
-  set_obj' :: "machine_word \<Rightarrow> ('a :: pspace_storable) \<Rightarrow> kernel_state \<Rightarrow> kernel_state"
-where
-  "set_obj' ptr obj s \<equiv> set_ko' ptr (injectKO obj) s"
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemma koTypeOf_injectKO:
+  fixes v :: "'a :: pspace_storable"
+  shows "koTypeOf (injectKO v) = koType TYPE('a)"
+  apply (cut_tac v1=v in iffD2 [OF project_inject, OF refl])
+  apply (simp add: project_koType[symmetric])
+  done
 
-lemma ovalid_readObject[wp]:
-  assumes R:
-  "\<And>a n ko s obj::'a::pspace_storable.
-  \<lbrakk> loadObject t t n ko s = Some a; projectKO_opt ko = Some obj \<rbrakk> \<Longrightarrow> a = obj"
-  shows "ovalid (obj_at' P t) (readObject t) (\<lambda>(rv::'a::pspace_storable) _. P rv)"
-  by (auto simp: obj_at'_def readObject_def split_def omonad_defs obind_def
-                 lookupAround2_known1 projectKOs ovalid_def
-           dest: R)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma setObject_modify_variable_size:
   fixes v :: "'a :: pspace_storable" shows
@@ -118,90 +55,69 @@ lemma setObject_modify:
 
 lemma obj_at_getObject:
   assumes R:
-  "\<And>a n ko s obj::'a::pspace_storable.
-  \<lbrakk> loadObject t t n ko s = Some a; projectKO_opt ko = Some obj \<rbrakk> \<Longrightarrow> a = obj"
+  "\<And>a b n ko s obj::'a::pspace_storable.
+  \<lbrakk> (a, b) \<in> fst (loadObject t t n ko s); projectKO_opt ko = Some obj \<rbrakk> \<Longrightarrow> a = obj"
   shows "\<lbrace>obj_at' P t\<rbrace> getObject t \<lbrace>\<lambda>(rv::'a::pspace_storable) s. P rv\<rbrace>"
-  unfolding getObject_def
-  apply wpsimp
-  using R use_ovalid[OF ovalid_readObject] by blast
+  by (auto simp: getObject_def obj_at'_def in_monad valid_def
+                 split_def projectKOs lookupAround2_known1
+           dest: R)
 
 declare projectKO_inv [wp]
 
+lemma loadObject_default_inv:
+  "\<lbrace>P\<rbrace> loadObject_default addr addr' next obj \<lbrace>\<lambda>rv. P\<rbrace>"
+  apply (simp add: loadObject_default_def magnitudeCheck_def
+                   alignCheck_def unless_def alignError_def
+          | wp hoare_vcg_split_case_option
+               hoare_drop_imps hoare_vcg_all_lift)+
+  done
+
 lemma getObject_inv:
-  "\<lbrace>P\<rbrace> getObject p \<lbrace>\<lambda>(rv :: 'a :: pspace_storable). P\<rbrace>"
-  unfolding getObject_def by wpsimp
-
-lemma getObject_tcb_inv [wp]: "\<lbrace>P\<rbrace> getObject l \<lbrace>\<lambda>(rv :: Structures_H.tcb). P\<rbrace>"
-  by (rule getObject_inv)
-
-lemma loadObject_default_Some [simp]:
-  "\<lbrakk>projectKO_opt ko = Some (obj::'a);
-                      is_aligned p (objBits obj); objBits obj < word_bits;
-                      case_option True (\<lambda>x. 2 ^ (objBits obj) \<le> x - p) n; q = p\<rbrakk>
-       \<Longrightarrow> bound (loadObject_default p q n ko s:: ('a::pre_storable) option)"
-  by (clarsimp simp: loadObject_default_def split_def projectKO_def obind_def
-                        alignCheck_def alignError_def magnitudeCheck_def projectKOs
-                        read_alignCheck_def read_alignError_def read_magnitudeCheck_def
-                        unless_def gets_the_def is_aligned_mask omonad_defs
-             split: option.splits) simp
-
-lemmas loadObject_default_Some'[simp, intro!] = loadObject_default_Some[simplified]
-lemmas loadObject_default_Some''[simp, intro!]
-        = loadObject_default_Some[where p=p and s=s and n="snd (lookupAround2 p (ksPSpace s))" for p s,
-                                 simplified]
-
-lemma no_ofail_loadObject_default [simp]:
-  "no_ofail (\<lambda>s. \<exists>obj. projectKO_opt ko = Some (obj::'a) \<and> objBits obj < word_bits \<and>
+  assumes x: "\<And>p q n ko. \<lbrace>P\<rbrace> loadObject p q n ko \<lbrace>\<lambda>(rv :: 'a :: pspace_storable). P\<rbrace>"
+  shows      "\<lbrace>P\<rbrace> getObject p \<lbrace>\<lambda>(rv :: 'a :: pspace_storable). P\<rbrace>"
+  by (simp add: getObject_def split_def | wp x)+
+
+lemma getObject_inv_tcb [wp]: "\<lbrace>P\<rbrace> getObject l \<lbrace>\<lambda>(rv :: Structures_H.tcb). P\<rbrace>"
+  apply (rule getObject_inv)
+  apply simp
+  apply (rule loadObject_default_inv)
+  done
+end
+(* FIXME: this should go somewhere in spec *)
+translations
+  (type) "'a kernel" <=(type) "kernel_state \<Rightarrow> ('a \<times> kernel_state) set \<times> bool"
+
+context begin interpretation Arch . (*FIXME: arch-split*)
+
+lemma no_fail_loadObject_default [wp]:
+  "no_fail (\<lambda>s. \<exists>obj. projectKO_opt ko = Some (obj::'a) \<and>
                       is_aligned p (objBits obj) \<and> q = p
                       \<and> case_option True (\<lambda>x. 2 ^ (objBits obj) \<le> x - p) n)
-           (loadObject_default p q n ko :: ('a::pre_storable) kernel_r)"
-  by (clarsimp simp: no_ofail_def)
-
-method no_ofail_readObject_method =
-  clarsimp simp: obj_at'_def readObject_def obind_def omonad_defs split_def projectKO_eq no_ofail_def,
-  rule ps_clear_lookupAround2, assumption+, simp,
-  blast intro: is_aligned_no_overflow,
-  clarsimp simp: objBits_simps' project_inject word_bits_def split: option.splits
-
-lemma no_ofail_obj_at'_readObject_tcb[simp]:
-  "no_ofail (obj_at' (P::tcb \<Rightarrow> bool) p) (readObject p::tcb kernel_r)"
-  by no_ofail_readObject_method
-
-lemma no_ofail_obj_at'_readObject_ep[simp]:
-  "no_ofail (obj_at' (P::endpoint \<Rightarrow> bool) p) (readObject p::endpoint kernel_r)"
-  by no_ofail_readObject_method
-
-lemma no_ofail_obj_at'_readObject_ntfn[simp]:
-  "no_ofail (obj_at' (P::notification \<Rightarrow> bool) p) (readObject p::notification kernel_r)"
-  by no_ofail_readObject_method
-
-lemma no_ofail_obj_at'_readObject_reply[simp]:
-  "no_ofail (obj_at' (P::reply \<Rightarrow> bool) p) (readObject p::reply kernel_r)"
-  by no_ofail_readObject_method
-
-lemma no_ofail_obj_at'_readObject_sc[simp]:
-  "no_ofail (obj_at' (P::sched_context \<Rightarrow> bool) p) (readObject p::sched_context kernel_r)"
-  by no_ofail_readObject_method
-
-lemmas no_ofail_tcb_at'_readObject[wp] = no_ofail_obj_at'_readObject_tcb[where P=\<top>]
-lemmas no_ofail_ep_at'_readObject[wp] = no_ofail_obj_at'_readObject_ep[where P=\<top>]
-lemmas no_ofail_ntfn_at'_readObject[wp] = no_ofail_obj_at'_readObject_ntfn[where P=\<top>]
-lemmas no_ofail_reply_at'_readObject[wp] = no_ofail_obj_at'_readObject_reply[where P=\<top>]
-lemmas no_ofail_sc_at'_readObject[wp] = no_ofail_obj_at'_readObject_sc[where P=\<top>]
-
-lemma no_fail_getObject_misc[wp]:
-  "no_fail (tcb_at' t) (getObject t :: tcb kernel)"
-  "no_fail (sc_at' t) (getObject t :: sched_context kernel)"
-  "no_fail (ep_at' t) (getObject t :: endpoint kernel)"
-  "no_fail (ntfn_at' t) (getObject t :: notification kernel)"
-  "no_fail (reply_at' t) (getObject t :: reply kernel)"
-  by (wpsimp simp: getObject_def wp: no_ofail_gets_the)+
+           (loadObject_default p q n ko :: ('a::pre_storable) kernel)"
+  apply (simp add: loadObject_default_def split_def projectKO_def
+                   alignCheck_def alignError_def magnitudeCheck_def
+                   unless_def)
+  apply (rule no_fail_pre)
+   apply (wp case_option_wp)
+  apply (clarsimp simp: is_aligned_mask)
+  apply (clarsimp split: option.split_asm)
+  apply (clarsimp simp: is_aligned_mask[symmetric])
+  apply simp
+  done
 
-lemma lookupAround2_same1[simp]:
-  "(fst (lookupAround2 x s) = Some (x, y)) = (s x = Some y)"
-  apply (rule iffI)
-   apply (simp add: lookupAround2_char1)
-  apply (simp add: lookupAround2_known1)
+lemma no_fail_getObject_tcb [wp]:
+  "no_fail (tcb_at' t) (getObject t :: tcb kernel)"
+  apply (simp add: getObject_def split_def)
+  apply (rule no_fail_pre)
+   apply wp
+  apply (clarsimp simp add: obj_at'_def projectKOs objBits_simps'
+                      cong: conj_cong)
+  apply (rule ps_clear_lookupAround2, assumption+)
+    apply simp
+   apply (simp add: field_simps)
+   apply (erule is_aligned_no_wrap')
+   apply simp
+  apply (fastforce split: option.split_asm simp: objBits_simps' archObjSize_def)
   done
 
 lemma typ_at_to_obj_at':
@@ -211,7 +127,7 @@ lemma typ_at_to_obj_at':
 
 lemmas typ_at_to_obj_at_arches
   = typ_at_to_obj_at'[where 'a=pte, simplified]
-    typ_at_to_obj_at'[where 'a=pde, simplified]
+    typ_at_to_obj_at' [where 'a=pde, simplified]
     typ_at_to_obj_at'[where 'a=asidpool, simplified]
     typ_at_to_obj_at'[where 'a=user_data, simplified]
     typ_at_to_obj_at'[where 'a=user_data_device, simplified]
@@ -219,126 +135,55 @@ lemmas typ_at_to_obj_at_arches
 lemmas page_table_at_obj_at'
   = page_table_at'_def[unfolded typ_at_to_obj_at_arches]
 
-method readObject_obj_at'_method
-  =  clarsimp simp: readObject_def obind_def omonad_defs split_def loadObject_default_def
-                    obj_at'_def objBits_simps' scBits_pos_power2 projectKOs
-             split: option.splits if_split_asm
-
-lemma readObject_misc_ko_at'[simp]:
-  shows
-  readObject_ko_at'_tcb: "readObject p s = Some (tcb :: tcb) \<Longrightarrow> ko_at' tcb p s" and
-  readObject_ko_at'_ep: "readObject p s = Some (ep :: endpoint) \<Longrightarrow> ko_at' ep p s" and
-  readObject_ko_at'_ntfn: "readObject p s = Some (ntfn :: notification) \<Longrightarrow> ko_at' ntfn p s" and
-  readObject_ko_at'_reply: "readObject p s = Some (reply :: reply) \<Longrightarrow> ko_at' reply p s" and
-  readObject_ko_at'_sc: "readObject p s = Some (sc :: sched_context) \<Longrightarrow> ko_at' sc p s"
-  by readObject_obj_at'_method+
-
-lemma readObject_misc_obj_at'[simplified, simp]:
-  shows
-  readObject_tcb_at': "bound (readObject p s :: tcb option) \<Longrightarrow> tcb_at' p s" and
-  readObject_ep_at': "bound (readObject p s :: endpoint option) \<Longrightarrow> ep_at' p s" and
-  readObject_ntfn_at': "bound (readObject p s :: notification option) \<Longrightarrow> ntfn_at' p s" and
-  readObject_reply_at': "bound (readObject p s :: reply option) \<Longrightarrow> reply_at' p s" and
-  readObject_sc_at': "bound (readObject p s :: sched_context option) \<Longrightarrow> sc_at' p s"
-  by readObject_obj_at'_method+
-
-lemma getObject_tcb_at':
-  "\<lbrace> \<top> \<rbrace> getObject t \<lbrace>\<lambda>r::tcb. tcb_at' t\<rbrace>"
-  unfolding getObject_def by wpsimp
-
-lemma koType_objBitsKO:
-  "\<lbrakk>koTypeOf k' = koTypeOf k; koTypeOf k = SchedContextT \<longrightarrow> objBitsKO k' = objBitsKO k\<rbrakk>
-     \<Longrightarrow> objBitsKO k' = objBitsKO k"
-  by (auto simp: objBitsKO_def archObjSize_def
-          split: Structures_H.kernel_object.splits
-                 ARM_H.arch_kernel_object.splits)
-
-lemma get_object_def2:
-  "get_object p = do
-     kh \<leftarrow> gets kheap;
-     assert (kh p \<noteq> None);
-     return $ the $ kh p
-   od"
-  apply (rule ext)
-  apply (rule monad_state_eqI)
-    apply ((clarsimp simp: get_object_def gets_the_def gets_def assert_opt_def in_monad
-                    split: option.splits)+)[2]
-  by (clarsimp simp: snd_bind get_object_def snd_gets_the assert_def exec_gets return_def)
-
-lemma getObject_def2:
-  "getObject ptr = do
-     map \<leftarrow> gets $ psMap \<circ> ksPSpace;
-     (before, after) \<leftarrow> return (lookupAround2 (fromPPtr ptr) map);
-     (ptr', val) \<leftarrow> assert_opt before;
-     gets_the $ loadObject (fromPPtr ptr) ptr' after val
-   od"
-  apply (rule ext)
-  apply (rule monad_state_eqI)
-    apply (force simp: getObject_def readObject_def gets_the_def exec_gets obind_def split_def
-                       omonad_defs assert_opt_def fail_def return_def in_monad ARM_H.fromPPtr_def
-                split: option.splits)+
-  by (clarsimp simp: snd_bind split_def getObject_def gets_the_def exec_gets assert_opt_def
-                     readObject_def obind_def omonad_defs return_def fail_def
-              split: option.splits)
-
-lemma loadObject_default_def2:
-  "(gets_the $ loadObject_default ptr ptr' next obj) = do
-     assert (ptr = ptr');
-     val \<leftarrow> (case projectKO_opt obj of None \<Rightarrow> fail | Some k \<Rightarrow> return k);
-     alignCheck ptr (objBits val);
-     assert (objBits val < word_bits);
-     magnitudeCheck ptr next (objBits val);
-     return val
-   od"
-  apply (rule ext)
-  apply (rule monad_state_eqI)
-    apply (force simp: loadObject_default_def gets_the_def exec_gets obind_def split_def
-                       omonad_defs assert_opt_def fail_def return_def in_monad ARM_H.fromPPtr_def
-                       read_magnitudeCheck_assert magnitudeCheck_assert projectKOs
-                split: option.splits if_splits)+
-  by (force simp: snd_bind split_def loadObject_default_def gets_the_def exec_gets assert_opt_def
-                  obind_def omonad_defs return_def fail_def projectKO_def assert_def
-                  read_magnitudeCheck_assert magnitudeCheck_assert
-                  read_alignError_def is_aligned_mask  alignCheck_def read_alignCheck_def
-           split: option.splits)
-
-lemma pspace_relation_tcb_at:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes t: "tcbs_of' s' t \<noteq> None"
-  shows "tcb_at t s" using assms
-  by (fastforce elim!: pspace_dom_relatedE obj_relation_cutsE opt_mapE
-                 simp: other_obj_relation_def obj_at_def projectKOs is_tcb_def
-                split: Structures_A.kernel_object.split_asm if_split_asm
-                       ARM_A.arch_kernel_obj.split_asm kernel_object.splits)
-
-lemma pspace_relation_sc_at:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes t: "scs_of' s' scp \<noteq> None"
-  shows "sc_at scp s" using assms
-  by (fastforce elim!: pspace_dom_relatedE obj_relation_cutsE opt_mapE
-                 simp: other_obj_relation_def is_sc_obj obj_at_def projectKOs
-                split: Structures_A.kernel_object.split_asm if_split_asm
-                       ARM_A.arch_kernel_obj.split_asm)
 
 lemma corres_get_tcb [corres]:
   "corres (tcb_relation \<circ> the) (tcb_at t) (tcb_at' t) (gets (get_tcb t)) (getObject t)"
   apply (rule corres_no_failI)
    apply wp
-  apply (simp add: get_object_def get_tcb_def gets_def gets_the_def getObject_def)
-  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def
-                        assert_def fail_def obj_at_def is_tcb
-                 dest!: readObject_misc_ko_at')
-  apply (clarsimp simp: state_relation_def pspace_relation_def obj_at'_def projectKOs)
+  apply (clarsimp simp add: gets_def get_def return_def bind_def get_tcb_def)
+  apply (frule in_inv_by_hoareD [OF getObject_inv_tcb])
+  apply (clarsimp simp add: obj_at_def is_tcb obj_at'_def projectKO_def
+                            projectKO_opt_tcb split_def
+                            getObject_def loadObject_default_def in_monad)
+  apply (case_tac koa)
+   apply (simp_all add: fail_def return_def)
+  apply (case_tac bb)
+   apply (simp_all add: fail_def return_def)
+  apply (clarsimp simp add: state_relation_def pspace_relation_def)
   apply (drule bspec)
+   apply clarsimp
    apply blast
-  apply (simp add: other_obj_relation_def)
+  apply (clarsimp simp: tcb_relation_cut_def lookupAround2_known1)
+  done
+
+lemma lookupAround2_same1[simp]:
+  "(fst (lookupAround2 x s) = Some (x, y)) = (s x = Some y)"
+  apply (rule iffI)
+   apply (simp add: lookupAround2_char1)
+  apply (simp add: lookupAround2_known1)
   done
 
-lemmas tcbSlot_defs = tcbCTableSlot_def tcbVTableSlot_def tcbIPCBufferSlot_def
-                      tcbFaultHandlerSlot_def tcbTimeoutHandlerSlot_def
+lemma getObject_tcb_at':
+  "\<lbrace> \<top> \<rbrace> getObject t \<lbrace>\<lambda>r::tcb. tcb_at' t\<rbrace>"
+  by (clarsimp simp: valid_def getObject_def in_monad
+                     loadObject_default_def obj_at'_def projectKOs split_def
+                     in_magnitude_check objBits_simps')
 
 text \<open>updateObject_cte lemmas\<close>
 
+lemma koType_objBitsKO:
+  "koTypeOf k = koTypeOf k' \<Longrightarrow> objBitsKO k = objBitsKO k'"
+  by (auto simp: objBitsKO_def archObjSize_def
+          split: Structures_H.kernel_object.splits
+                 ARM_H.arch_kernel_object.splits)
+
+lemma updateObject_objBitsKO:
+    "(ko', t') \<in> fst (updateObject (val :: 'a :: pspace_storable) ko p q n t)
+         \<Longrightarrow> objBitsKO ko' = objBitsKO ko"
+  apply (drule updateObject_type)
+  apply (erule koType_objBitsKO)
+  done
+
 lemma updateObject_cte_is_tcb_or_cte:
   fixes cte :: cte and ptr :: word32
   shows "\<lbrakk> fst (lookupAround2 p (ksPSpace s)) = Some (q, ko);
@@ -354,19 +199,16 @@ lemma updateObject_cte_is_tcb_or_cte:
                lookupAround2_char1
          split: kernel_object.splits)
   apply (subst(asm) in_magnitude_check3, simp+)
-   apply (simp add: in_monad tcbSlot_defs
+   apply (simp add: in_monad tcbCTableSlot_def tcbVTableSlot_def
+                    tcbReplySlot_def tcbCallerSlot_def tcbIPCBufferSlot_def
              split: if_split_asm)
-  apply (simp add: in_monad tcbSlot_defs
+  apply (simp add: in_monad tcbCTableSlot_def tcbVTableSlot_def
+                   tcbReplySlot_def tcbCallerSlot_def tcbIPCBufferSlot_def
             split: if_split_asm)
   done
 
 declare plus_1_less[simp]
 
-lemma setObject_sc_at'_n[wp]:
-  "setObject ptr val \<lbrace>\<lambda>s. P (sc_at'_n n p s)\<rbrace>"
-  by (fastforce simp : valid_def setObject_def ko_wp_at'_def in_monad split_def updateObject_size
-                       ps_clear_upd lookupAround2_char1 updateObject_type word_bits_def)
-
 lemma updateObject_default_result:
   "(x, s'') \<in> fst (updateObject_default e ko p q n s) \<Longrightarrow> x = injectKO e"
   by (clarsimp simp add: updateObject_default_def in_monad)
@@ -374,6 +216,7 @@ lemma updateObject_default_result:
 lemma obj_at_setObject1:
   assumes R: "\<And>(v::'a::pspace_storable) p q n ko s x s''.
                 (x, s'') \<in> fst (updateObject v ko p q n s) \<Longrightarrow> x = injectKO v"
+  assumes Q: "\<And>(v::'a::pspace_storable) (v'::'a). objBits v = objBits v'"
   shows
   "\<lbrace> obj_at' (\<lambda>x::'a::pspace_storable. True) t \<rbrace>
    setObject p (v::'a::pspace_storable)
@@ -382,10 +225,13 @@ lemma obj_at_setObject1:
   apply (rule bind_wp [OF _ hoare_gets_sp])
   apply (clarsimp simp: valid_def in_monad obj_at'_def
                         projectKOs lookupAround2_char1
-                        project_inject)
-  apply (frule updateObject_size, drule R)
+                        project_inject
+                 dest!: R)
+  apply (subgoal_tac "objBitsKO (injectKO v) = objBitsKO (injectKO obj)")
    apply (intro conjI impI, simp_all)
       apply fastforce+
+  apply (fold objBits_def)
+  apply (rule Q)
   done
 
 lemma obj_at_setObject2:
@@ -410,271 +256,56 @@ lemma obj_at_setObject2:
   apply (clarsimp simp: ps_clear_upd lookupAround2_char1)
   done
 
-\<comment>\<open>
-  If the old and new versions of an object are the same size, then showing
-  `obj_at'` for the updated state is the same as showing the predicate for
-  the new value; we get to "reuse" the existing PSpace properties.
-\<close>
-lemma same_size_obj_at'_set_obj'_iff:
-  fixes obj :: "'a :: pspace_storable"
-  assumes "obj_at' (\<lambda>old_obj :: 'a. objBits old_obj = objBits obj) ptr s"
-  shows "obj_at' P ptr (set_obj' ptr obj s) = P obj"
-  apply (rule iffI)
-   apply (prop_tac "ko_at' obj ptr (set_obj' ptr obj s)")
-    apply (clarsimp simp: obj_at'_def projectKO_eq project_inject)
-   apply (clarsimp simp: obj_at'_def)
-  using assms
-  apply (fastforce simp: obj_at'_def inj_def projectKO_eq project_inject objBits_def)
-  done
-
-lemma tcb_at'_obj_at'_set_obj'[unfolded injectKO_tcb]:
-  assumes "P (tcb :: tcb)"
-      and "tcb_at' ptr s"
-  shows "obj_at' P ptr (set_obj' ptr tcb s)"
-  using assms
-  apply (clarsimp simp: objBits_def objBitsKO_def inj_def
-                        same_size_obj_at'_set_obj'_iff[where 'a=tcb, simplified])
-  done
-
-\<comment>\<open>
-  Keeps a generic @{term obj_at'} (rather than a specific @{term "obj_at' (\<lambda>_. True)"}) to match
-  in more simp contexts.
-\<close>
-lemma tcb_obj_at'_set_obj'_iff:
-  fixes tcb :: tcb
-    and P Q :: "tcb \<Rightarrow> bool"
-  shows "obj_at' P p s \<Longrightarrow> obj_at' Q p (set_obj' p tcb s) = Q tcb"
-  apply (rule same_size_obj_at'_set_obj'_iff)
-  apply (clarsimp simp: objBits_simps obj_at'_def)
-  done
-
-lemmas tcb_obj_at'_pred_tcb'_set_obj'_iff =
-  tcb_obj_at'_set_obj'_iff[where Q="test o proj o tcb_to_itcb'" for test proj,
-                                 simplified objBits_simps o_def, simplified,
-                                 folded pred_tcb_at'_def]
-
-lemma same_size_ko_wp_at'_set_ko'_iff:
-  assumes "ko_wp_at' (\<lambda>old_ko. objBitsKO old_ko = objBitsKO ko) ptr s"
-  shows "ko_wp_at' P ptr (set_ko' ptr ko s) = P ko"
-  apply (rule iffI)
-   apply (clarsimp simp: ko_wp_at'_def)
-  using assms
-  apply (clarsimp simp: ko_wp_at'_def)
-  apply (erule ps_clear_domE)
-  apply clarsimp
-  apply blast
-  done
-
-\<comment>\<open>
-  Moves the @{term ksPSpace_update} to the top.
-\<close>
-lemma unfold_set_ko':
-  "set_ko' ptr ko s = ksPSpace_update (\<lambda>ps. ps(ptr := Some ko)) s"
-  by clarsimp
-
-lemma ko_wp_at'_set_ko'_distinct:
-  assumes "ptr \<noteq> ptr'"
-          "ko_wp_at' \<top> ptr' s"
-  shows "ko_wp_at' P ptr (set_ko' ptr' ko s) = ko_wp_at' P ptr s"
-  using assms
-  apply (clarsimp simp: ko_wp_at'_def)
-  apply (rule iffI; clarsimp)
-   apply (erule ps_clear_domE)
-   apply clarsimp
-   apply blast
-  apply (erule ps_clear_domE)
-  apply clarsimp
-  apply blast
-  done
-
-lemma obj_at'_set_obj'_distinct:
-  assumes "p \<noteq> p'"
-          "obj_at' Q p' s"
-  shows "obj_at' P p (set_ko' p' ko s) = obj_at' P p s"
-  using assms apply -
-  apply (rule iffI; fastforce simp: obj_at'_def projectKO_eq project_inject ps_clear_upd)
-  done
-
-lemmas pred_tcb_at'_set_obj'_distinct =
-  obj_at'_set_obj'_distinct[where P="test o proj o tcb_to_itcb'" for test proj,
-                            simplified o_def, folded pred_tcb_at'_def]
-
-lemmas pred_tcb_at'_set_obj'_iff =
-  tcb_obj_at'_set_obj'_iff[where Q="test o proj o tcb_to_itcb'" for test proj,
-                           simplified o_def injectKO_tcb, folded pred_tcb_at'_def]
-
-lemma non_sc_same_typ_at'_objBits_always_the_same:
-  assumes "typ_at' t ptr s"
-          "koTypeOf ko = t"
-          "t \<noteq> SchedContextT"
-  shows "ko_wp_at' (\<lambda>old_ko. objBitsKO old_ko = objBitsKO ko) ptr s"
-  using assms
-  apply (clarsimp simp: typ_at'_def ko_wp_at'_def)
-  apply (rule koType_objBitsKO)
-  apply simp+
-  done
-
-lemmas non_sc_same_typ_at'_ko_wp_at'_set_ko'_iff =
-  same_size_ko_wp_at'_set_ko'_iff[OF non_sc_same_typ_at'_objBits_always_the_same]
-
-(* Worth adding other typ_at's? *)
-lemma typ_at'_ksPSpace_exI:
-  "pde_at' ptr s \<Longrightarrow> \<exists>pde. ksPSpace s ptr = Some (KOArch (KOPDE pde))"
-  "pte_at' ptr s \<Longrightarrow> \<exists>pte. ksPSpace s ptr = Some (KOArch (KOPTE pte))"
-  apply -
-  apply (clarsimp simp: typ_at'_def ko_wp_at'_def,
-         (case_tac ko; clarsimp),
-         (rename_tac arch, case_tac arch; clarsimp)?)+
-  done
-
-\<comment>\<open>
-  Used to show a stronger variant of @{thm obj_at_setObject2}
-  for many concrete types.
-
-  Needs to be a definition so we can easily refer to it within
-  ML as a constant.
-\<close>
-definition distinct_updateObject_types ::
-  "('a :: pspace_storable) itself \<Rightarrow> ('b :: pspace_storable) itself \<Rightarrow> bool"
-where
-  "distinct_updateObject_types t t' \<equiv>
-    (\<forall>ko' s' (v :: 'a) ko p before after s.
-      (ko', s') \<in> fst (updateObject v ko p before after s)
-      \<longrightarrow> koTypeOf ko' \<noteq> koType TYPE('b))"
+lemma updateObject_ep_eta:
+  "updateObject (v :: endpoint) = updateObject_default v"
+  by ((rule ext)+, simp)
 
-lemma setObject_distinct_types_preserves_obj_at'_pre:
-  fixes v :: "'a :: pspace_storable"
-    and P :: "'b :: pspace_storable \<Rightarrow> bool"
-  assumes distinct_types[unfolded distinct_updateObject_types_def, rule_format]:
-    "distinct_updateObject_types TYPE('a) TYPE('b)"
-  shows "setObject p v \<lbrace>\<lambda>s. P' (obj_at' P t s)\<rbrace>"
-  apply (simp add: setObject_def split_def)
-  apply (rule bind_wp [OF _ hoare_gets_sp])
-  apply (clarsimp simp: valid_def in_monad)
-  apply (frule updateObject_type)
-  apply (erule_tac P="P'" in rsubst)
-  apply (drule distinct_types)
-  apply (clarsimp simp: lookupAround2_char1)
-  apply (case_tac "obj_at' P t s")
-   apply (clarsimp simp: obj_at'_def projectKOs)
-   using project_koType ps_clear_upd
-   apply fastforce
-  apply (clarsimp simp: obj_at'_def projectKOs ps_clear_upd)
-  apply (intro impI conjI iffI; metis project_koType)
-  done
+lemma updateObject_tcb_eta:
+  "updateObject (v :: tcb) = updateObject_default v"
+  by ((rule ext)+, simp)
 
-\<comment>\<open>
-  We're using @{command ML_goal} here because we want to show
-  `distinct_updateObject_types TYPE('a) TYPE('b)` for around
-  50 different combinations of 'a and 'b. Doing that by hand would
-  be painful, and not as clear for future readers as this comment
-  plus this ML code.
-\<close>
-ML \<open>
-local
-  val ko_types = [
-    @{typ notification},
-    @{typ tcb},
-    @{typ cte},
-    @{typ sched_context},
-    @{typ reply},
-    @{typ endpoint},
-
-    (*FIXME: arch_split*)
-    @{typ asidpool},
-    @{typ pte},
-    @{typ pde}
-  ];
-
-  val skipped_pairs = [
-    \<comment>\<open>
-      This corresponds to the case where we're inserting a CTE into
-      a TCB, which is the only case where the first two arguments
-      to `updateObject` should have different types.
-
-      See the comment on @{term updateObject} for more information.
-    \<close>
-    (@{typ cte}, @{typ tcb})
-  ];
-
-  fun skips (ts as (typ, typ')) =
-      typ = typ' orelse Library.member (op =) skipped_pairs ts;
-
-  fun mk_distinct_goal (typ, typ') =
-      Const (@{const_name distinct_updateObject_types},
-            Term.itselfT typ --> Term.itselfT typ' --> @{typ bool})
-      $ Logic.mk_type typ
-      $ Logic.mk_type typ';
-in
-  val distinct_updateObject_types_goals =
-      Library.map_product pair ko_types ko_types
-      |> Library.filter_out skips
-      |> List.map mk_distinct_goal
-end
-\<close>
+lemma updateObject_ntfn_eta:
+  "updateObject (v :: Structures_H.notification) = updateObject_default v"
+  by ((rule ext)+, simp)
 
-ML_goal distinct_updateObject_types: \<open>
-  distinct_updateObject_types_goals
-\<close>
-  apply -
-  \<comment>\<open>
-    The produced goals match the following pattern:
-  \<close>
-  apply (all \<open>match conclusion in \<open>distinct_updateObject_types _ _\<close> \<Rightarrow> -\<close>)
-  unfolding distinct_updateObject_types_def
-  apply safe
-  apply (clarsimp simp: distinct_updateObject_types_def
-                        setObject_def updateObject_cte updateObject_default_def
-                        typeError_def in_monad
-                 split: if_splits kernel_object.splits)+
-  done
-
-lemmas setObject_distinct_types_preserves_obj_at'[wp] =
-    distinct_updateObject_types[THEN setObject_distinct_types_preserves_obj_at'_pre]
-
-(* FIXME RT: these overlap substantially with `setObject_distinct_types_preserves_obj_at'`,
-   but fixing that requires having names for the relevant subset of lemmas. We can't do that with
-   attributes, but we might be able to do it with a new command (`lemmas_matching`?) once `match`
-   is factored.
-
-   This doesn't really matter in this case because you're never going to refer to these lemmas by
-   name. *)
-lemmas set_distinct_types_preserves_obj_at'[wp] =
-  setObject_distinct_types_preserves_obj_at'[folded setReply_def setNotification_def setCTE_def
-                                                    setSchedContext_def setEndpoint_def]
-
-lemmas set_distinct_types_preserves_pred_tcb_at'[wp] =
-  set_distinct_types_preserves_obj_at'[TRY[where P="test o proj o tcb_to_itcb'" for test proj,
-                                           simplified o_def, folded pred_tcb_at'_def, rule_format]]
-  setObject_distinct_types_preserves_obj_at'[TRY[where P="test o proj o tcb_to_itcb'" for test proj,
-                                             simplified o_def, folded pred_tcb_at'_def,
-                                             rule_format]]
+lemmas updateObject_eta =
+  updateObject_ep_eta updateObject_tcb_eta updateObject_ntfn_eta
 
-end
+lemma objBits_type:
+  "koTypeOf k = koTypeOf k' \<Longrightarrow> objBitsKO k = objBitsKO k'"
+  by (erule koType_objBitsKO)
 
 lemma setObject_typ_at_inv:
   "\<lbrace>typ_at' T p'\<rbrace> setObject p v \<lbrace>\<lambda>r. typ_at' T p'\<rbrace>"
-  by (clarsimp simp: setObject_def split_def valid_def typ_at'_def ko_wp_at'_def in_monad
-                        lookupAround2_char1 ps_clear_upd updateObject_size updateObject_type)
+  apply (clarsimp simp: setObject_def split_def)
+  apply (clarsimp simp: valid_def typ_at'_def ko_wp_at'_def in_monad
+                        lookupAround2_char1 ps_clear_upd)
+  apply (drule updateObject_type)
+  apply clarsimp
+  apply (drule objBits_type)
+  apply (simp add: ps_clear_upd)
+  done
 
 lemma setObject_typ_at_not:
   "\<lbrace>\<lambda>s. \<not> (typ_at' T p' s)\<rbrace> setObject p v \<lbrace>\<lambda>r s. \<not> (typ_at' T p' s)\<rbrace>"
   apply (clarsimp simp: setObject_def valid_def in_monad split_def)
   apply (erule notE)
-  by (clarsimp simp: typ_at'_def ko_wp_at'_def lookupAround2_char1
-                     updateObject_size updateObject_type
-              split: if_split_asm
-              elim!: ps_clear_domE)
-      fastforce+
+  apply (clarsimp simp: typ_at'_def ko_wp_at'_def lookupAround2_char1
+                 split: if_split_asm)
+   apply (drule updateObject_type)
+   apply clarsimp
+   apply (drule objBits_type)
+   apply (clarsimp elim!: ps_clear_domE)
+   apply fastforce
+  apply (clarsimp elim!: ps_clear_domE)
+  apply fastforce
+  done
 
 lemma setObject_typ_at'[wp]:
   "\<lbrace>\<lambda>s. P (typ_at' T p' s)\<rbrace> setObject p v \<lbrace>\<lambda>r s. P (typ_at' T p' s)\<rbrace>"
   by (blast intro: P_bool_lift setObject_typ_at_inv setObject_typ_at_not)
 
-global_interpretation setObject: typ_at_all_props' "setObject p v"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas setObject_typ_ats [wp] = typ_at_lifts [OF setObject_typ_at']
 
 lemma setObject_cte_wp_at2':
   assumes x: "\<And>x n tcb s t. \<lbrakk> t \<in> fst (updateObject v (KOTCB tcb) ptr x n s); Q s;
@@ -717,10 +348,49 @@ lemma setObject_cte_wp_at':
   unfolding pred_conj_def
   by (rule setObject_cte_wp_at2'[OF x y], assumption+)
 
+lemma setObject_ep_pre:
+  assumes "\<lbrace>P and ep_at' p\<rbrace> setObject p (e::endpoint) \<lbrace>Q\<rbrace>"
+  shows "\<lbrace>P\<rbrace> setObject p (e::endpoint) \<lbrace>Q\<rbrace>" using assms
+  apply (clarsimp simp: valid_def setObject_def in_monad
+                        split_def updateObject_default_def
+                        projectKOs in_magnitude_check objBits_simps')
+  apply (drule spec, drule mp, erule conjI)
+   apply (simp add: obj_at'_def projectKOs objBits_simps')
+  apply (simp add: split_paired_Ball)
+  apply (drule spec, erule mp)
+  apply (clarsimp simp: in_monad projectKOs in_magnitude_check)
+  done
+
+lemma setObject_ntfn_pre:
+  assumes "\<lbrace>P and ntfn_at' p\<rbrace> setObject p (e::Structures_H.notification) \<lbrace>Q\<rbrace>"
+  shows "\<lbrace>P\<rbrace> setObject p (e::Structures_H.notification) \<lbrace>Q\<rbrace>" using assms
+  apply (clarsimp simp: valid_def setObject_def in_monad
+                        split_def updateObject_default_def
+                        projectKOs in_magnitude_check objBits_simps')
+  apply (drule spec, drule mp, erule conjI)
+   apply (simp add: obj_at'_def projectKOs objBits_simps')
+  apply (simp add: split_paired_Ball)
+  apply (drule spec, erule mp)
+  apply (clarsimp simp: in_monad projectKOs in_magnitude_check)
+  done
+
+lemma setObject_tcb_pre:
+  assumes "\<lbrace>P and tcb_at' p\<rbrace> setObject p (t::tcb) \<lbrace>Q\<rbrace>"
+  shows "\<lbrace>P\<rbrace> setObject p (t::tcb) \<lbrace>Q\<rbrace>" using assms
+  apply (clarsimp simp: valid_def setObject_def in_monad
+                        split_def updateObject_default_def
+                        projectKOs in_magnitude_check objBits_simps')
+  apply (drule spec, drule mp, erule conjI)
+   apply (simp add: obj_at'_def projectKOs objBits_simps')
+  apply (simp add: split_paired_Ball)
+  apply (drule spec, erule mp)
+  apply (clarsimp simp: in_monad projectKOs in_magnitude_check)
+  done
+
 lemma obj_at_setObject3:
   fixes Q::"'a::pspace_storable \<Rightarrow> bool"
   fixes P::"'a::pspace_storable \<Rightarrow> bool"
-  assumes R: "\<And>ko s y n. (updateObject v ko p y n s)
+  assumes R: "\<And>ko s x y n. (updateObject v ko p y n s)
                    = (updateObject_default v ko p y n s)"
   assumes P: "\<And>(v::'a::pspace_storable). (1 :: word32) < 2 ^ (objBits v)"
   shows "\<lbrace>(\<lambda>s. P v)\<rbrace> setObject p v \<lbrace>\<lambda>rv. obj_at' P p\<rbrace>"
@@ -753,93 +423,57 @@ method setObject_easy_cases =
   clarsimp simp: setObject_def in_monad split_def valid_def lookupAround2_char1,
   erule rsubst[where P=P'], rule ext,
   clarsimp simp: updateObject_cte updateObject_default_def in_monad
-                 typeError_def opt_map_def projectKO_opts_defs projectKO_eq
+                 typeError_def opt_map_def opt_pred_def projectKO_opts_defs projectKOs projectKO_eq
           split: if_split_asm
                  Structures_H.kernel_object.split_asm
 
-lemma setObject_endpoint_replies_of'[wp]:
-  "setObject c (endpoint::endpoint) \<lbrace>\<lambda>s. P' (replies_of' s)\<rbrace>"
+lemma setObject_endpoint_tcbs_of'[wp]:
+  "setObject c (endpoint :: endpoint) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
   by setObject_easy_cases
 
-lemma setObject_notification_replies_of'[wp]:
-  "setObject c (notification::notification) \<lbrace>\<lambda>s. P' (replies_of' s)\<rbrace>"
+lemma setObject_notification_tcbs_of'[wp]:
+  "setObject c (notification :: notification) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
   by setObject_easy_cases
 
-lemma setObject_tcb_replies_of'[wp]:
-  "setObject c (tcb::tcb) \<lbrace>\<lambda>s. P' (replies_of' s)\<rbrace>"
+lemma setObject_cte_tcbSchedNexts_of[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbSchedNexts_of s)\<rbrace>"
   by setObject_easy_cases
 
-lemma setObject_sched_context_replies_of'[wp]:
-  "setObject c (sched_context::sched_context) \<lbrace>\<lambda>s. P' (replies_of' s)\<rbrace>"
+lemma setObject_cte_tcbSchedPrevs_of[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbSchedPrevs_of s)\<rbrace>"
   by setObject_easy_cases
 
-lemma setObject_cte_replies_of'[wp]:
-  "setObject c (cte::cte) \<lbrace>\<lambda>s. P' (replies_of' s)\<rbrace>"
-  by setObject_easy_cases
-
-\<comment>\<open>
-  Warning: this may not be a weakest precondition. `setObject c`
-  asserts that there's already a correctly-typed object at `c`,
-  so a weaker valid precondition might be @{term
-    "\<lambda>s. replies_of' s c \<noteq> None \<longrightarrow>  P' ((replies_of' s)(c \<mapsto> reply))"
-  }
-\<close>
-lemma setObject_reply_replies_of'[wp]:
-  "\<lbrace>\<lambda>s. P' ((replies_of' s)(c \<mapsto> reply))\<rbrace>
-  setObject c (reply::reply)
-  \<lbrace>\<lambda>_ s. P' (replies_of' s)\<rbrace>"
+lemma setObject_cte_tcbQueued[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (tcbQueued |< tcbs_of' s)\<rbrace>"
+  supply inQ_def[simp]
   by setObject_easy_cases
 
-\<comment>\<open>
-  Warning: this may not be a weakest precondition. `setObject c`
-  asserts that there's already a correctly-typed object at `c`,
-  so a weaker valid precondition might be @{term
-    "\<lambda>s. scs_of' s c \<noteq> None \<longrightarrow>  P' ((scs_of' s)(c \<mapsto> sched_context))"
-  }
-\<close>
-lemma setObject_sched_context_scs_of'[wp]:
-  "\<lbrace>\<lambda>s. P' ((scs_of' s)(c \<mapsto> sched_context))\<rbrace>
-  setObject c (sched_context::sched_context)
-  \<lbrace>\<lambda>_ s. P' (scs_of' s)\<rbrace>"
+lemma setObject_cte_inQ[wp]:
+  "setObject c (cte :: cte) \<lbrace>\<lambda>s. P' (inQ d p |< tcbs_of' s)\<rbrace>"
+  supply inQ_def[simp]
   by setObject_easy_cases
 
-lemma setObject_scs_of'[wp]:
-  "setObject c (cte::cte) \<lbrace>\<lambda>s. P' (scs_of' s)\<rbrace>"
-  "setObject c (reply::reply) \<lbrace>\<lambda>s. P' (scs_of' s)\<rbrace>"
-  "setObject c (tcb::tcb) \<lbrace>\<lambda>s. P' (scs_of' s)\<rbrace>"
-  "setObject c (notification::notification) \<lbrace>\<lambda>s. P' (scs_of' s)\<rbrace>"
-  "setObject c (endpoint::endpoint) \<lbrace>\<lambda>s. P' (scs_of' s)\<rbrace>"
-  by setObject_easy_cases+
-
-lemmas setReply_replies_of' = setObject_reply_replies_of'[folded setReply_def]
-
-crunch setNotification, setEndpoint, setSchedContext, setCTE
-  for replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
-
-lemmas setSchedContext_scs_of_of' =
-  setObject_sched_context_scs_of'[folded setSchedContext_def]
-
-crunch setNotification, setEndpoint, setCTE, setReply
-  for scs_of'[wp]: "\<lambda>s. P (scs_of' s)"
-
 lemma getObject_obj_at':
   assumes x: "\<And>q n ko. loadObject p q n ko =
-                (loadObject_default p q n ko :: ('a :: pspace_storable) kernel_r)"
+                (loadObject_default p q n ko :: ('a :: pspace_storable) kernel)"
+  assumes P: "\<And>(v::'a::pspace_storable). (1 :: word32) < 2 ^ (objBits v)"
   shows      "\<lbrace> \<top> \<rbrace> getObject p \<lbrace>\<lambda>r::'a::pspace_storable. obj_at' ((=) r) p\<rbrace>"
-  by (clarsimp simp: valid_def getObject_def in_monad omonad_defs readObject_def
+  by (clarsimp simp: valid_def getObject_def in_monad
                      loadObject_default_def obj_at'_def projectKOs
                      split_def in_magnitude_check lookupAround2_char1
-                     x project_inject objBits_def[symmetric]
-              split: option.split_asm if_split_asm)
+                     x P project_inject objBits_def[symmetric])
 
 lemma getObject_valid_obj:
   assumes x: "\<And>p q n ko. loadObject p q n ko =
-                (loadObject_default p q n ko :: ('a :: pspace_storable) kernel_r)"
+                (loadObject_default p q n ko :: ('a :: pspace_storable) kernel)"
+  assumes P: "\<And>(v::'a::pspace_storable). (1 :: word32) < 2 ^ (objBits v)"
   shows "\<lbrace> valid_objs' \<rbrace> getObject p \<lbrace>\<lambda>rv::'a::pspace_storable. valid_obj' (injectKO rv) \<rbrace>"
   apply (rule hoare_chain)
     apply (rule hoare_vcg_conj_lift)
-     apply (rule getObject_obj_at' [OF x])
+     apply (rule getObject_obj_at' [OF x P])
     apply (rule getObject_inv)
+    apply (subst x)
+    apply (rule loadObject_default_inv)
    apply (clarsimp, assumption)
   apply clarsimp
   apply (drule(1) obj_at_valid_objs')
@@ -853,13 +487,18 @@ lemma typeError_inv [wp]:
   by (simp add: typeError_def|wp)+
 
 lemma getObject_cte_inv [wp]: "\<lbrace>P\<rbrace> (getObject addr :: cte kernel) \<lbrace>\<lambda>rv. P\<rbrace>"
-  by (wpsimp simp: getObject_def)
+  apply (simp add: getObject_def loadObject_cte split_def)
+  apply (clarsimp simp: valid_def in_monad)
+  apply (clarsimp simp: typeError_def in_monad magnitudeCheck_def
+                 split: kernel_object.split_asm if_split_asm option.split_asm)
+  done
 
 lemma getObject_ko_at:
   assumes x: "\<And>q n ko. loadObject p q n ko =
-                (loadObject_default p q n ko :: ('a :: pspace_storable) kernel_r)"
+                (loadObject_default p q n ko :: ('a :: pspace_storable) kernel)"
+  assumes P: "\<And>(v::'a::pspace_storable). (1 :: word32) < 2 ^ (objBits v)"
   shows      "\<lbrace> \<top> \<rbrace> getObject p \<lbrace>\<lambda>r::'a::pspace_storable. ko_at' r p\<rbrace>"
-  by (subst eq_commute, rule getObject_obj_at' [OF x])
+  by (subst eq_commute, rule getObject_obj_at' [OF x P])
 
 lemma getObject_ko_at_tcb [wp]:
   "\<lbrace>\<top>\<rbrace> getObject p \<lbrace>\<lambda>rv::tcb. ko_at' rv p\<rbrace>"
@@ -878,77 +517,126 @@ lemma setObject_nosch:
   apply (wp x | simp)+
   done
 
-context
-begin
+lemma getObject_ep_inv: "\<lbrace>P\<rbrace> (getObject addr :: endpoint kernel) \<lbrace>\<lambda>rv. P\<rbrace>"
+  apply (rule getObject_inv)
+  apply (simp add: loadObject_default_inv)
+  done
 
-private method getObject_valid_obj =
-  rule hoare_chain,
-  rule getObject_valid_obj; clarsimp simp: objBits_simps' valid_obj'_def scBits_pos_power2
+lemma getObject_ntfn_inv:
+  "\<lbrace>P\<rbrace> (getObject addr :: Structures_H.notification kernel) \<lbrace>\<lambda>rv. P\<rbrace>"
+  apply (rule getObject_inv)
+  apply (simp add: loadObject_default_inv)
+  done
 
-lemma get_ep'_valid_ep[wp]:
-  "\<lbrace> valid_objs' \<rbrace> getEndpoint ep \<lbrace> valid_ep' \<rbrace>"
-  unfolding getEndpoint_def by getObject_valid_obj
+lemma get_ep_inv'[wp]: "\<lbrace>P\<rbrace> getEndpoint ep \<lbrace>\<lambda>rv. P\<rbrace>"
+  by (simp add: getEndpoint_def getObject_ep_inv)
 
-lemma get_ntfn'_valid_ntfn[wp]:
-  "\<lbrace> valid_objs' \<rbrace> getNotification ep \<lbrace> valid_ntfn' \<rbrace>"
-  unfolding getNotification_def by getObject_valid_obj
+lemma get_ntfn_inv'[wp]: "\<lbrace>P\<rbrace> getNotification ntfn \<lbrace>\<lambda>rv. P\<rbrace>"
+  by (simp add: getNotification_def getObject_ntfn_inv)
 
-lemma get_sc_valid_sc'[wp]:
-  "\<lbrace> valid_objs' \<rbrace> getSchedContext sc \<lbrace> valid_sched_context' \<rbrace>"
-  unfolding getSchedContext_def by getObject_valid_obj
+lemma get_ep'_valid_ep[wp]:
+  "\<lbrace> invs' and ep_at' ep \<rbrace> getEndpoint ep \<lbrace> valid_ep' \<rbrace>"
+  apply (simp add: getEndpoint_def)
+  apply (rule hoare_chain)
+  apply (rule getObject_valid_obj)
+     apply simp
+    apply (simp add: objBits_simps')
+   apply clarsimp
+  apply (simp add: valid_obj'_def)
+  done
 
-lemma get_reply_valid_reply'[wp]:
-  "\<lbrace> valid_objs'\<rbrace> getReply sc \<lbrace> valid_reply' \<rbrace>"
-  unfolding getReply_def by getObject_valid_obj
+lemma get_ntfn'_valid_ntfn[wp]:
+  "\<lbrace> invs' and ntfn_at' ep \<rbrace> getNotification ep \<lbrace> valid_ntfn' \<rbrace>"
+  apply (simp add: getNotification_def)
+  apply (rule hoare_chain)
+  apply (rule getObject_valid_obj)
+     apply simp
+    apply (simp add: objBits_simps')
+   apply clarsimp
+  apply (simp add: valid_obj'_def)
+  done
 
-end
+lemma setObject_distinct[wp]:
+  shows     "\<lbrace>pspace_distinct'\<rbrace> setObject p val \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
+  apply (clarsimp simp: setObject_def split_def valid_def in_monad
+                        projectKOs pspace_distinct'_def ps_clear_upd
+                        objBits_def[symmetric] lookupAround2_char1
+                 split: if_split_asm
+                 dest!: updateObject_objBitsKO)
+   apply (fastforce dest: bspec[OF _ domI])
+  apply (fastforce dest: bspec[OF _ domI])
+  done
 
-lemma get_ep_ko':
-  "\<lbrace>\<top>\<rbrace> getEndpoint ep \<lbrace>\<lambda>rv. ko_at' rv ep\<rbrace>"
-  unfolding getEndpoint_def
-  by (rule getObject_ko_at; simp add: objBits_simps')
+lemma setObject_aligned[wp]:
+  shows     "\<lbrace>pspace_aligned'\<rbrace> setObject p val \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
+  apply (clarsimp simp: setObject_def split_def valid_def in_monad
+                        projectKOs pspace_aligned'_def ps_clear_upd
+                        objBits_def[symmetric] lookupAround2_char1
+                 split: if_split_asm
+                 dest!: updateObject_objBitsKO)
+   apply (fastforce dest: bspec[OF _ domI])
+  apply (fastforce dest: bspec[OF _ domI])
+  done
 
-lemma get_ntfn_ko':
-  "\<lbrace>\<top>\<rbrace> getNotification ntfn \<lbrace>\<lambda>rv. ko_at' rv ntfn\<rbrace>"
-  unfolding getNotification_def
-  by (rule getObject_ko_at; simp add: objBits_simps')
+lemma set_ep_aligned' [wp]:
+  "\<lbrace>pspace_aligned'\<rbrace> setEndpoint ep v  \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
+  unfolding setEndpoint_def by wp
 
-lemma get_sc_ko':
-  "\<lbrace>\<top>\<rbrace> getSchedContext sc_ptr \<lbrace>\<lambda>sc. ko_at' sc sc_ptr\<rbrace>"
-  unfolding getSchedContext_def
-  by (rule getObject_ko_at; simp add: objBits_simps' scBits_pos_power2)
+lemma set_ep_distinct' [wp]:
+  "\<lbrace>pspace_distinct'\<rbrace> setEndpoint ep v  \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
+  unfolding setEndpoint_def by wp
 
-lemma get_reply_ko':
-  "\<lbrace>\<top>\<rbrace> getReply reply_ptr \<lbrace>\<lambda>reply. ko_at' reply reply_ptr\<rbrace>"
-  unfolding getReply_def
-  by (rule getObject_ko_at; simp add: objBits_simps')
 
-context
-begin
+lemma setEndpoint_cte_wp_at':
+  "\<lbrace>cte_wp_at' P p\<rbrace> setEndpoint ptr v \<lbrace>\<lambda>rv. cte_wp_at' P p\<rbrace>"
+  unfolding setEndpoint_def
+  apply (rule setObject_cte_wp_at'[where Q="\<top>", simplified])
+   apply (clarsimp simp add: updateObject_default_def in_monad
+                             projectKOs
+                     intro!: set_eqI)+
+  done
 
-private method unfold_setObject_inmonad =
-  (clarsimp simp: setObject_def split_def valid_def in_monad projectKOs updateObject_size
-                  objBits_def[symmetric] lookupAround2_char1 ps_clear_upd
-            split: if_split_asm),
-    (fastforce dest: bspec[OF _ domI])+
+lemma setEndpoint_pred_tcb_at'[wp]:
+  "\<lbrace>pred_tcb_at' proj P t\<rbrace> setEndpoint ptr val \<lbrace>\<lambda>rv. pred_tcb_at' proj P t\<rbrace>"
+  apply (simp add: pred_tcb_at'_def setEndpoint_def)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp: updateObject_default_def in_monad)
+  done
 
-lemma setObject_distinct[wp]:
-  "setObject p val \<lbrace>pspace_distinct'\<rbrace>"
-  unfolding pspace_distinct'_def by (unfold_setObject_inmonad)
+lemma get_ntfn_ko':
+  "\<lbrace>\<top>\<rbrace> getNotification ep \<lbrace>\<lambda>rv. ko_at' rv ep\<rbrace>"
+  apply (simp add: getNotification_def)
+  apply (rule getObject_ko_at)
+   apply simp
+  apply (simp add: objBits_simps')
+  done
 
-lemma setObject_aligned[wp]:
-  "setObject p val \<lbrace>pspace_aligned'\<rbrace>"
-  unfolding pspace_aligned'_def by (unfold_setObject_inmonad)
+lemma set_ntfn_aligned'[wp]:
+  "\<lbrace>pspace_aligned'\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
+  unfolding setNotification_def by wp
 
-lemma setObject_bounded[wp]:
-  "setObject p val \<lbrace>pspace_bounded'\<rbrace>"
-  unfolding pspace_bounded'_def by (unfold_setObject_inmonad)
+lemma set_ntfn_distinct'[wp]:
+  "\<lbrace>pspace_distinct'\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
+  unfolding setNotification_def by wp
 
-end
+lemma setNotification_cte_wp_at':
+  "\<lbrace>cte_wp_at' P p\<rbrace> setNotification ptr v \<lbrace>\<lambda>rv. cte_wp_at' P p\<rbrace>"
+  unfolding setNotification_def
+  apply (rule setObject_cte_wp_at'[where Q="\<top>", simplified])
+   apply (clarsimp simp add: updateObject_default_def in_monad
+                             projectKOs
+                     intro!: set_eqI)+
+  done
 
-end
+lemma setObject_ntfn_tcb':
+  "\<lbrace>tcb_at' t\<rbrace> setObject p (e::Structures_H.notification) \<lbrace>\<lambda>_. tcb_at' t\<rbrace>"
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp: updateObject_default_def in_monad)
+  done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemma set_ntfn_tcb' [wp]:
+  "\<lbrace> tcb_at' t \<rbrace> setNotification ntfn v \<lbrace> \<lambda>rv. tcb_at' t \<rbrace>"
+  by (simp add: setNotification_def setObject_ntfn_tcb')
 
 lemma pspace_dom_update:
   "\<lbrakk> ps ptr = Some x; a_type x = a_type v \<rbrakk> \<Longrightarrow> pspace_dom (ps(ptr \<mapsto> v)) = pspace_dom ps"
@@ -960,6 +648,7 @@ lemma pspace_dom_update:
 
 lemmas ps_clear_def3 = ps_clear_def2 [OF order_less_imp_le [OF aligned_less_plus_1]]
 
+
 declare diff_neg_mask[simp del]
 
 lemma cte_wp_at_ctes_of:
@@ -994,29 +683,6 @@ lemma cte_wp_at_ctes_of:
                         word_bw_assocs field_simps)
   done
 
-(* FIXME rt merge: move to Word_lib *)
-lemma max_word_minus_1[simp]: "0xFFFFFFFF + 2^x = (2^x - 1::32 word)"
-  by simp
-
-lemma ctes_of'_after_update:
-  "ko_wp_at' (same_caps' val) p s \<Longrightarrow> ctes_of (s\<lparr>ksPSpace := (ksPSpace s)(p \<mapsto> val)\<rparr>) x = ctes_of s x"
-  apply (clarsimp simp only: ko_wp_at'_def map_to_ctes_def Let_def)
-  apply (rule if_cong)
-    apply (cases val; fastforce split: if_splits)
-   apply (cases val; fastforce split: if_splits)
-  apply (rule if_cong)
-    apply (cases val; clarsimp; fastforce)
-   apply (cases val; clarsimp simp: tcb_cte_cases_def)
-  apply simp
-  done
-
-lemma ex_cap_to'_after_update:
-  "\<lbrakk> ex_nonz_cap_to' p s; ko_wp_at' (same_caps' val) p' s \<rbrakk>
-     \<Longrightarrow> ex_nonz_cap_to' p (s\<lparr>ksPSpace := (ksPSpace s)(p' \<mapsto> val)\<rparr>)"
-  unfolding ex_nonz_cap_to'_def cte_wp_at_ctes_of
-  using ctes_of'_after_update
-  by fastforce
-
 lemma tcb_cte_cases_small:
   "\<lbrakk> tcb_cte_cases v = Some (getF, setF) \<rbrakk>
       \<Longrightarrow> v < 2 ^ tcbBlockSizeBits"
@@ -1171,25 +837,34 @@ lemma real_cte_at':
                          objBits_simps' cte_level_bits_def
                     del: disjCI)
 
-lemma no_fail_getMiscObject [wp]:
+lemma no_fail_getEndpoint [wp]:
   "no_fail (ep_at' ptr) (getEndpoint ptr)"
-  "no_fail (ntfn_at' ptr) (getNotification ptr)"
-  "no_fail (reply_at' ptr) (getReply ptr)"
-  "no_fail (sc_at' ptr) (getSchedContext ptr)"
-  by (wpsimp simp: getEndpoint_def getNotification_def getReply_def getSchedContext_def)+
+  apply (simp add: getEndpoint_def getObject_def
+                   split_def)
+  apply (rule no_fail_pre)
+   apply wp
+  apply (clarsimp simp add: obj_at'_def projectKOs objBits_simps'
+                            lookupAround2_known1)
+  apply (erule(1) ps_clear_lookupAround2)
+    apply simp
+   apply (simp add: field_simps)
+   apply (erule is_aligned_no_wrap')
+    apply (simp add: word_bits_conv)
+   apply (clarsimp split: option.split_asm simp: objBits_simps' archObjSize_def)
+  done
 
 lemma getEndpoint_corres [corres]:
   "corres ep_relation (ep_at ptr) (ep_at' ptr)
      (get_endpoint ptr) (getEndpoint ptr)"
   apply (rule corres_no_failI)
    apply wp
-  apply (simp add: get_simple_ko_def getEndpoint_def get_object_def gets_the_def
+  apply (simp add: get_simple_ko_def getEndpoint_def get_object_def
                    getObject_def bind_assoc ep_at_def2)
-  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def
-                 dest!: readObject_misc_ko_at')
+  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def)
   apply (clarsimp simp: assert_def fail_def obj_at_def return_def is_ep partial_inv_def)
-  apply (rename_tac ep' ep)
-  apply (clarsimp simp: state_relation_def pspace_relation_def obj_at'_def projectKOs)
+  apply (clarsimp simp: loadObject_default_def in_monad projectKOs
+                        in_magnitude_check objBits_simps')
+  apply (clarsimp simp add: state_relation_def pspace_relation_def)
   apply (drule bspec)
    apply blast
   apply (simp add: other_obj_relation_def)
@@ -1223,16 +898,14 @@ lemma setObject_ksDomSchedule_inv:
   apply (wp updateObject_default_inv | simp)+
   done
 
-lemma read_magnitudeCheck_Some:
-  "(case y of None \<Rightarrow> True | Some z \<Rightarrow> 2 ^ n \<le> z - x)
-   \<longleftrightarrow> read_magnitudeCheck x y n s = Some ()"
-  by (fastforce simp: read_magnitudeCheck_def split: option.splits if_split_asm; simp)
+lemma projectKO_def2:
+  "projectKO ko = assert_opt (projectKO_opt ko)"
+  by (simp add: projectKO_def assert_opt_def)
 
-lemmas read_magnitudeCheck_Some'[simp, intro!] = read_magnitudeCheck_Some[THEN iffD1]
 lemma no_fail_magnitudeCheck[wp]:
   "no_fail (\<lambda>s. case y of None \<Rightarrow> True | Some z \<Rightarrow> 2 ^ n \<le> z - x)
     (magnitudeCheck x y n)"
-  apply (clarsimp simp: magnitudeCheck_def gets_the_def)
+  apply (clarsimp simp add: magnitudeCheck_def split: option.splits)
   apply (rule no_fail_pre, wp)
   apply simp
   done
@@ -1242,11 +915,11 @@ lemma no_fail_setObject_other [wp]:
   assumes x: "updateObject ob = updateObject_default ob"
   shows "no_fail (obj_at' (\<lambda>k::'a. objBits k = objBits ob) ptr)
                   (setObject ptr ob)"
-  apply (simp add: setObject_def x split_def updateObject_default_def alignError_def
-                   projectKO_def alignCheck_def read_alignCheck_def read_alignError_def)
+  apply (simp add: setObject_def x split_def updateObject_default_def
+                   projectKO_def2 alignCheck_def alignError_def)
   apply (rule no_fail_pre)
-   apply wp
-  apply (clarsimp simp: is_aligned_mask[symmetric] obj_at'_def omonad_defs
+   apply (wp )
+  apply (clarsimp simp: is_aligned_mask[symmetric] obj_at'_def
                         objBits_def[symmetric] projectKOs
                         project_inject lookupAround2_known1)
   apply (erule(1) ps_clear_lookupAround2)
@@ -1256,14 +929,13 @@ lemma no_fail_setObject_other [wp]:
     apply (erule is_aligned_no_wrap')
     apply simp
    apply simp
-  apply (fastforce simp: oassert_opt_def project_inject split: option.splits)
+  apply fastforce
   done
 
 lemma obj_relation_cut_same_type:
   "\<lbrakk> (y, P) \<in> obj_relation_cuts ko x; P ko z;
     (y', P') \<in> obj_relation_cuts ko' x'; P' ko' z \<rbrakk>
      \<Longrightarrow> (a_type ko = a_type ko') \<or> (\<exists>n n'. a_type ko = ACapTable n \<and> a_type ko' = ACapTable n')
-         \<or> (\<exists>n n'. a_type ko = ASchedContext n \<and> a_type ko' = ASchedContext n')
          \<or> (\<exists>sz sz'. a_type ko = AArch (AUserData sz) \<and> a_type ko' = AArch (AUserData sz'))
          \<or> (\<exists>sz sz'. a_type ko = AArch (ADeviceData sz) \<and> a_type ko' = AArch (ADeviceData sz'))"
   apply (rule ccontr)
@@ -1275,47 +947,16 @@ lemma obj_relation_cut_same_type:
                     ARM_A.arch_kernel_obj.split_asm)
   done
 
-lemma replyNexts_of_non_reply_update:
-  "\<And>s'. \<lbrakk>typ_at' (koTypeOf ko) ptr s';
-   koTypeOf ko \<noteq> ReplyT \<rbrakk>
-     \<Longrightarrow> replyNexts_of (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> ko)\<rparr>) = replyNexts_of s'"
-  by (fastforce simp: typ_at'_def ko_wp_at'_def opt_map_def projectKO_opts_defs
-               split: kernel_object.splits)
-
-definition replyNext_same :: "'a :: pspace_storable \<Rightarrow> 'a \<Rightarrow> bool" where
-  "replyNext_same obj1 obj2 \<equiv>
-    (case (injectKO obj1, injectKO obj2) of
-       (KOReply r1, KOReply r2) \<Rightarrow> replyNext r1 = replyNext r2
-      | _ \<Rightarrow> True)"
-
-lemma replyNexts_of_replyNext_same_update:
-  "\<And>s'. \<lbrakk>typ_at' ReplyT ptr s'; ksPSpace s' ptr = Some ko;
-   koTypeOf (injectKO (ob':: 'a :: pspace_storable)) = ReplyT;
-   projectKO_opt ko = Some ab; replyNext_same (ob':: 'a) ab\<rbrakk>
-     \<Longrightarrow> replyNexts_of (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> injectKO ob')\<rparr>) = replyNexts_of s'"
-  apply (cases "injectKO ob'"; clarsimp simp: typ_at'_def ko_wp_at'_def)
-  by (cases ko; fastforce simp add: replyNext_same_def project_inject projectKO_opts_defs opt_map_def)
-
-lemma replyPrevs_of_non_reply_update:
-  "\<And>s'. \<lbrakk>typ_at' (koTypeOf ko) ptr s';
-   koTypeOf ko \<noteq> ReplyT \<rbrakk>
-     \<Longrightarrow> replyPrevs_of (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> ko)\<rparr>) = replyPrevs_of s'"
-  by (fastforce simp: typ_at'_def ko_wp_at'_def opt_map_def projectKO_opts_defs
-               split: kernel_object.splits)
-
-definition replyPrev_same :: "'a :: pspace_storable \<Rightarrow> 'a \<Rightarrow> bool" where
-  "replyPrev_same obj1 obj2 \<equiv>
-    (case (injectKO obj1, injectKO obj2) of
-       (KOReply r1, KOReply r2) \<Rightarrow> replyPrev r1 = replyPrev r2
-      | _ \<Rightarrow> True)"
+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'"
 
-lemma replyPrevs_of_replyPrev_same_update:
-  "\<And>s'. \<lbrakk>typ_at' ReplyT ptr s'; ksPSpace s' ptr = Some ko;
-   koTypeOf (injectKO (ob':: 'a :: pspace_storable)) = ReplyT;
-   projectKO_opt ko = Some ab; replyPrev_same (ob':: 'a) ab\<rbrakk>
-     \<Longrightarrow> replyPrevs_of (s'\<lparr>ksPSpace := (ksPSpace s')(ptr \<mapsto> injectKO ob')\<rparr>) = replyPrevs_of s'"
-  apply (cases "injectKO ob'"; clarsimp simp: typ_at'_def ko_wp_at'_def)
-  by (cases ko; fastforce simp add: replyPrev_same_def project_inject projectKO_opts_defs opt_map_def)
+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>
@@ -1334,6 +975,7 @@ 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 :: word32) < 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)
@@ -1348,8 +990,8 @@ lemma setObject_other_corres:
   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 x
-                        projectKOs obj_at_def in_magnitude_check[OF _ P]
-                        updateObject_default_def)
+                        projectKOs obj_at_def
+                        updateObject_default_def in_magnitude_check [OF _ P])
   apply (rename_tac ko)
   apply (clarsimp simp add: state_relation_def z)
   apply (clarsimp simp add: caps_of_state_after_update cte_wp_at_after_update
@@ -1383,24 +1025,28 @@ lemma setObject_other_corres:
            (fastforce simp add: is_other_obj_relation_type t)+)
    apply (insert t)
    apply ((erule disjE
-         | clarsimp simp: is_other_obj_relation_type is_other_obj_relation_type_def a_type_def)+)[1]
-  (* sc_replies_relation *)
-  apply (simp add: sc_replies_relation_def)
-  apply (clarsimp simp: sc_replies_of_scs_def map_project_def scs_of_kh_def)
-  apply (drule_tac x=p in spec)
-  apply (rule conjI; clarsimp split: Structures_A.kernel_object.split_asm if_split_asm)
-   apply(clarsimp simp: a_type_def is_other_obj_relation_type_def)
-  apply (rename_tac sc n)
-  apply (prop_tac "typ_at' (koTypeOf (injectKO ob')) ptr b")
-   apply (clarsimp simp: typ_at'_def ko_wp_at'_def obj_at'_def projectKO_opts_defs
-                         is_other_obj_relation_type_def a_type_def other_obj_relation_def
-                  split: Structures_A.kernel_object.split_asm if_split_asm
-                         arch_kernel_obj.split_asm kernel_object.split_asm arch_kernel_object.split_asm)
-  apply (drule replyPrevs_of_non_reply_update[simplified])
-   apply (clarsimp simp: other_obj_relation_def; cases ob; cases "injectKO ob'";
-          simp split: arch_kernel_obj.split_asm)
-  apply (clarsimp simp add: opt_map_def)
-  done
+          | 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)
+     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
+     by (clarsimp simp: other_obj_relation_def; cases ob; cases "injectKO ob'";
+         simp split: arch_kernel_obj.split_asm)
+  by (fastforce dest: tcbs_of'_non_tcb_update)
 
 lemmas obj_at_simps = obj_at_def obj_at'_def projectKOs map_to_ctes_upd_other
                       is_other_obj_relation_type_def
@@ -1425,421 +1071,90 @@ lemma setNotification_corres [corres]:
   apply (corresKsimp wp: get_object_ret get_object_wp)+
   by (fastforce simp: is_ntfn obj_at_simps objBits_defs partial_inv_def)
 
-lemma reply_at'_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes t: "reply_at' ptr s'"
-  shows "reply_at ptr s" using assms
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (erule (1) pspace_dom_relatedE)
-  by (clarsimp simp: obj_relation_cuts_def2 obj_at_def is_reply cte_relation_def
-                     other_obj_relation_def pte_relation_def pde_relation_def
-              split: Structures_A.kernel_object.split_asm if_split_asm
-                     ARM_A.arch_kernel_obj.split_asm)
-
-lemma set_reply_corres: (* for reply update that doesn't touch the reply stack *)
-  "reply_relation ae ae' \<Longrightarrow>
-  corres dc \<top>
-            (obj_at' (\<lambda>ko. replyPrev_same ae' ko) ptr)
-            (set_reply ptr ae) (setReply ptr ae')"
-  proof -
-  have x: "updateObject ae' = updateObject_default ae'" by clarsimp
-  have z: "\<And>s. reply_at' ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO ae')) = map_to_ctes (ksPSpace s)"
-    by (clarsimp simp: obj_at_simps)
-  have b: "\<And>ko. (\<lambda>_ :: reply. True) ko \<Longrightarrow> objBits ko = objBits ae'"
-    by (clarsimp simp: obj_at_simps)
-  assume r: "reply_relation ae ae'"
-  show ?thesis
-    apply (simp add: set_simple_ko_def setReply_def is_reply_def[symmetric])
-    supply image_cong_simp [cong del]
-    apply (insert r)
-    apply (rule corres_no_failI)
-     apply (rule no_fail_pre)
-      apply wp
-      apply (rule x)
-     apply (clarsimp simp: obj_at'_weakenE[OF _ b])
-    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 x
-                          projectKOs obj_at_def obj_at'_def is_reply
-                          updateObject_default_def in_magnitude_check[OF _])
-    apply (prop_tac "reply_at ptr a")
-     apply (clarsimp simp: obj_at'_def projectKOs dest!: state_relation_pspace_relation reply_at'_cross[where ptr=ptr])
-    apply (clarsimp simp: obj_at_def is_reply)
-    apply (rename_tac reply)
-    apply (prop_tac "obj_at (same_caps (kernel_object.Reply ae)) ptr a")
-     apply (clarsimp simp: obj_at_def is_reply)
-    apply (clarsimp simp: state_relation_def
-                          z[simplified obj_at'_def is_reply projectKO_eq projectKO_opts_defs, simplified])
-    apply (clarsimp simp add: caps_of_state_after_update cte_wp_at_after_update
-                              swp_def fun_upd_def obj_at_def)
-    apply (subst conj_assoc[symmetric])
-    apply (rule conjI[rotated])
-     apply (clarsimp simp add: ghost_relation_def)
-     apply (erule_tac x=ptr in allE)+
-     apply (clarsimp simp: obj_at_def a_type_def
-                     split: Structures_A.kernel_object.splits if_split_asm)
-    apply (fold fun_upd_def)
-    apply (simp only: pspace_relation_def simp_thms
-                      pspace_dom_update[where x="kernel_object.Reply _"
-                                          and v="kernel_object.Reply _",
-                                        simplified a_type_def, simplified])
-    apply (simp only: 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: project_inject split: if_split_asm kernel_object.split_asm)
-     apply (rename_tac bb aa ba)
-     apply (drule_tac x="(aa, ba)" in bspec, simp)
-     apply clarsimp
-     apply (frule_tac ko'="kernel_object.Reply reply" and x'=ptr in obj_relation_cut_same_type)
-        apply simp+
-     apply clarsimp
-      (* sc_replies_relation *)
-    apply (simp add: sc_replies_relation_def)
-    apply (clarsimp simp: sc_replies_of_scs_def map_project_def scs_of_kh_def)
-    apply (drule_tac x=p in spec)
-    by (subst replyPrevs_of_replyPrev_same_update[simplified, where ob'=ae', simplified];
-        simp add: typ_at'_def ko_wp_at'_def obj_at'_def project_inject opt_map_def)
-  qed
-
-lemma setReply_not_queued_corres: (* for reply updates on replies not in fst ` replies_with_sc *)
-  "reply_relation r1 r2 \<Longrightarrow>
-  corres dc (\<lambda>s. ptr \<notin> fst ` replies_with_sc s) (reply_at' ptr)
-            (set_reply ptr r1) (setReply ptr r2)"
-proof -
-  have x: "updateObject r2 = updateObject_default r2" by clarsimp
-  have z: "\<And>s. reply_at' ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO r2)) = map_to_ctes (ksPSpace s)"
-    by (clarsimp simp: obj_at_simps)
-  have b: "\<And>ko. (\<lambda>_ :: reply. True) ko \<Longrightarrow> objBits ko = objBits r2"
-    by (clarsimp simp: obj_at_simps)
-  assume r: "reply_relation r1 r2"
-  show ?thesis
-    apply (simp add: set_simple_ko_def setReply_def is_reply_def[symmetric])
-    supply image_cong_simp [cong del]
-    apply (insert r)
-    apply (rule corres_no_failI)
-     apply (rule no_fail_pre)
-      apply wp
-      apply (rule x)
-     apply (clarsimp simp: obj_at'_weakenE[OF _ b])
-    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 x
-                          projectKOs obj_at_def obj_at'_def is_reply
-                          updateObject_default_def in_magnitude_check[OF _])
-    apply (prop_tac "reply_at ptr a")
-     apply (clarsimp simp: obj_at'_def projectKOs dest!: state_relation_pspace_relation reply_at'_cross[where ptr=ptr])
-    apply (clarsimp simp: obj_at_def is_reply)
-    apply (rename_tac reply)
-    apply (prop_tac "obj_at (same_caps (kernel_object.Reply _)) ptr a")
-     apply (clarsimp simp: obj_at_def is_reply)
-    apply (clarsimp simp: state_relation_def
-                          z[simplified obj_at'_def is_reply projectKO_eq projectKO_opts_defs, simplified])
-    apply (clarsimp simp add: caps_of_state_after_update cte_wp_at_after_update
-                              swp_def fun_upd_def obj_at_def)
-    apply (subst conj_assoc[symmetric])
-    apply (rule conjI[rotated])
-     apply (clarsimp simp add: ghost_relation_def)
-     apply (erule_tac x=ptr in allE)+
-     apply (clarsimp simp: obj_at_def a_type_def
-                     split: Structures_A.kernel_object.splits if_split_asm)
-    apply (fold fun_upd_def)
-    apply (simp only: pspace_relation_def simp_thms
-                      pspace_dom_update[where x="kernel_object.Reply _"
-                                          and v="kernel_object.Reply _",
-                                        simplified a_type_def, simplified])
-    apply (simp only: 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: project_inject split: if_split_asm kernel_object.split_asm)
-     apply (rename_tac bb aa ba)
-     apply (drule_tac x="(aa, ba)" in bspec, simp)
-     apply clarsimp
-     apply (frule_tac ko'="kernel_object.Reply reply" and x'=ptr in obj_relation_cut_same_type)
-        apply simp+
-     apply clarsimp
-      (* sc_replies_relation *)
-    apply (simp add: sc_replies_relation_def)
-    apply (clarsimp simp: sc_replies_of_scs_def map_project_def scs_of_kh_def)
-    apply (drule_tac x=p in spec)
-    apply (subgoal_tac "((scs_of' b)(ptr := sc_of' (KOReply r2)) |> scReply) p = scReplies_of b p")
-     apply simp
-     apply (subgoal_tac "heap_ls (replyPrevs_of b) (scReplies_of b p) (sc_replies z)")
-      apply (erule heap_path_heap_upd_not_in)
-      apply (clarsimp simp: sc_at_pred_n_def obj_at_def replies_with_sc_def image_def)
-      apply (drule_tac x=p in spec)
-      apply (fastforce elim!: opt_mapE)
-     apply (simp add: typ_at'_def ko_wp_at'_def obj_at'_def project_inject opt_map_def)
-    apply (simp add: typ_at'_def ko_wp_at'_def obj_at'_def project_inject opt_map_def)
-    done
-qed
-
-lemma sc_at'_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes t: "sc_at' ptr s'"
-  shows "sc_at ptr s" using assms
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (erule (1) pspace_dom_relatedE)
-  by (clarsimp simp: obj_relation_cuts_def2 obj_at_def is_sc_obj cte_relation_def
-                     other_obj_relation_def pte_relation_def pde_relation_def
-              split: Structures_A.kernel_object.split_asm if_split_asm
-                     ARM_A.arch_kernel_obj.split_asm)
-
-lemma sc_obj_at'_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes t: "obj_at' (\<lambda>sc::sched_context. scSize sc = n) ptr s'"
-  shows "sc_obj_at n ptr s" using assms
-  apply (clarsimp simp: obj_at'_def)
-  apply (erule (1) pspace_dom_relatedE)
-  by (clarsimp simp: obj_relation_cuts_def2 obj_at_def is_sc_obj cte_relation_def
-                     objBits_simps scBits_simps projectKOs
-                     other_obj_relation_def pte_relation_def pde_relation_def sc_relation_def
-              split: Structures_A.kernel_object.split_asm if_split_asm
-                     ARM_A.arch_kernel_obj.split_asm)
-
-lemma setSchedContext_corres:
-  assumes R': "sc_relation sc n sc'"
-  assumes s: "n = scSize sc'"
-  shows "corres dc \<top>
-         (obj_at' (\<lambda>k::sched_context. objBits k = objBits sc') ptr
-          and (\<lambda>s'. heap_ls (replyPrevs_of s') (scReply sc') (sc_replies sc)))
-            (set_object ptr (kernel_object.SchedContext sc n))
-            (setSchedContext ptr sc')"
-  proof -
-  have z: "\<And>s. sc_at' ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s) (ptr \<mapsto> injectKO sc')) = map_to_ctes (ksPSpace s)"
-    by (clarsimp simp: obj_at_simps)
-  show ?thesis
-    apply (insert R' s)
-    apply (clarsimp simp: setSchedContext_def)
-    apply (rule corres_no_failI)
-     apply (rule no_fail_pre)
-      apply wp
-      apply clarsimp
-     apply clarsimp
-    apply clarsimp
-    apply (rename_tac s s' rv; prop_tac "sc_obj_at n ptr s")
-     apply (fastforce intro!: sc_obj_at'_cross dest: state_relation_pspace_relation
-                        simp: obj_at'_def objBits_simps)
-    apply (clarsimp simp: obj_at_def is_sc_obj_def obj_at'_def projectKO_eq projectKO_opts_defs)
-    apply (unfold update_sched_context_def 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_def2
-                          projectKOs obj_at_def a_type_def
-                          updateObject_default_def in_magnitude_check[OF _]
-                   split: Structures_A.kernel_object.splits)
-    apply (prop_tac "obj_at (same_caps (kernel_object.SchedContext sc n)) ptr s")
-     apply (clarsimp simp: obj_at_def)
-    apply (clarsimp simp: state_relation_def
-                          z[simplified obj_at'_def is_sc_obj_def projectKO_eq projectKO_opts_defs, simplified])
-    apply (clarsimp simp: caps_of_state_after_update cte_wp_at_after_update
-                              swp_def fun_upd_def obj_at_def)
-    apply (subst conj_assoc[symmetric])
-    apply (rule conjI[rotated])
-     apply (clarsimp simp: ghost_relation_def)
-     apply (erule_tac x=ptr in allE)+
-     apply (clarsimp simp: obj_at_def a_type_def
-                     split: Structures_A.kernel_object.splits if_split_asm)
-    apply (fold fun_upd_def)
-    apply (simp only: pspace_relation_def simp_thms
-                      pspace_dom_update[where x="kernel_object.SchedContext _ _"
-                                          and v="kernel_object.SchedContext _ _",
-                                        simplified a_type_def, simplified])
-    apply (simp only: 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: project_inject split: if_split_asm kernel_object.split_asm)
-     apply (rename_tac sc0 x bb aa ba)
-     apply (drule_tac x="(aa, ba)" in bspec, simp)
-     apply clarsimp
-     apply (frule_tac ko'="kernel_object.SchedContext sc0 n" and x'=ptr
-              in obj_relation_cut_same_type)
-        apply simp+
-     apply (clarsimp simp: a_type_def split: Structures_A.kernel_object.split_asm if_split_asm)
-      (* sc_replies_relation *)
-    apply (clarsimp simp: sc_replies_relation_def sc_replies_of_scs_def map_project_def scs_of_kh_def)
-    apply (drule_tac x=p in spec)
-    by (auto simp: typ_at'_def ko_wp_at'_def opt_map_def projectKO_opts_defs
-            split: if_splits)
-qed
-
-lemma setSchedContext_update_corres:
-  assumes R': "sc_relation sc n sc' \<longrightarrow> sc_relation (f sc) n (f' (sc'::sched_context))"
-  assumes s: "objBits sc' = objBits (f' sc')"
-  shows "corres dc
-         (\<lambda>s. kheap s ptr = Some (kernel_object.SchedContext sc n))
-         (ko_at' sc' ptr and (\<lambda>s'. heap_ls (replyPrevs_of s') (scReply (f' sc')) (sc_replies (f sc))))
-            (set_object ptr (kernel_object.SchedContext (f sc) n))
-            (setSchedContext ptr (f' sc'))"
-  apply (insert R' s)
-  apply (rule_tac F="sc_relation sc n sc'" in corres_req)
-   apply (drule state_relation_pspace_relation)
-   apply (drule (1) pspace_relation_absD)
-   apply (clarsimp simp: obj_at'_def projectKOs split: if_split_asm)
-  apply (rule corres_guard_imp)
-    apply (rule setSchedContext_corres)
-     apply fastforce
-    apply (clarsimp simp: obj_at'_def sc_relation_def objBits_simps)
-   apply fastforce
-  apply (clarsimp simp: obj_at'_def sc_relation_def)
-  done
-
-lemma setSchedContext_no_stack_update_corres:
-  "\<lbrakk>sc_relation sc n sc' \<longrightarrow> sc_relation (f sc) n (f' sc');
-     sc_replies sc = sc_replies (f sc); objBits sc' = objBits (f' sc');
-     scReply sc' = scReply (f' sc')\<rbrakk>
-    \<Longrightarrow> corres dc
-         (\<lambda>s. kheap s ptr = Some (kernel_object.SchedContext sc n))
-         (ko_at' sc' ptr)
-            (set_object ptr (kernel_object.SchedContext (f sc) n))
-            (setSchedContext ptr (f' sc'))"
-  apply (rule_tac F="sc_relation sc n sc'" in corres_req)
-   apply (drule state_relation_pspace_relation)
-   apply (drule (1) pspace_relation_absD)
-   apply (clarsimp simp: obj_at'_def projectKOs split: if_split_asm)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule setSchedContext_update_corres[where sc=sc and sc'=sc'])
-     apply simp+
-  apply (clarsimp dest!: state_relation_sc_replies_relation
-                   simp: obj_at'_def projectKOs)
-  apply (drule (2) sc_replies_relation_prevs_list)
-  by fastforce
-
-lemma setSchedContext_update_sched_context_no_stack_update_corres:
-  "\<lbrakk>\<forall>sc n sc'. sc_relation sc n sc' \<longrightarrow> sc_relation (f sc) n (f' sc');
-    \<forall>sc. sc_replies sc = sc_replies (f sc); objBits sc' = objBits (f' sc');
-    scReply sc' = scReply (f' sc')\<rbrakk>
-    \<Longrightarrow> corres dc
-         (\<lambda>s. sc_at ptr s)
-         (ko_at' sc' ptr)
-         (update_sched_context ptr f)
-         (setSchedContext ptr (f' sc'))"
-  apply (clarsimp simp: update_sched_context_def)
-  apply (rule corres_symb_exec_l[rotated 2, OF get_object_sp])
-    apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace>" for P f Q \<Rightarrow> -\<close>)
-    apply (fastforce intro: get_object_exs_valid
-                      simp: obj_at_def)
-   apply wpsimp
-   apply (clarsimp simp: obj_at_def)
-  apply (rename_tac obj)
-  apply (case_tac obj;
-         clarsimp, (solves \<open>clarsimp simp: obj_at_def is_sc_obj_def corres_underlying_def\<close>)?)
-  apply (rule corres_guard_imp)
-    apply (rule_tac f=f and f'="f'" in setSchedContext_no_stack_update_corres)
-       apply simp+
-   apply (clarsimp simp: obj_at_def)
-  apply (clarsimp simp: obj_at_simps)
-  done
-
-lemma getNotification_corres:
-  "corres ntfn_relation (ntfn_at ptr) (ntfn_at' ptr)
-     (get_notification ptr) (getNotification ptr)"
-  apply (rule corres_no_failI)
+lemma no_fail_getNotification [wp]:
+  "no_fail (ntfn_at' ptr) (getNotification ptr)"
+  apply (simp add: getNotification_def getObject_def
+                   split_def)
+  apply (rule no_fail_pre)
    apply wp
-  apply (simp add: get_simple_ko_def getNotification_def get_object_def
-                   getObject_def bind_assoc gets_the_def)
-  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def
-                 dest!: readObject_misc_ko_at')
-  apply (clarsimp simp: assert_def fail_def obj_at_def return_def is_ntfn partial_inv_def)
-  apply (clarsimp simp add: state_relation_def pspace_relation_def obj_at'_def projectKOs)
-  apply (drule bspec)
-   apply blast
-  apply (simp add: other_obj_relation_def)
+  apply (clarsimp simp add: obj_at'_def projectKOs objBits_simps'
+                            lookupAround2_known1)
+  apply (erule(1) ps_clear_lookupAround2)
+    apply simp
+   apply (simp add: field_simps)
+   apply (erule is_aligned_no_wrap')
+    apply (simp add: word_bits_conv)
+   apply (clarsimp split: option.split_asm simp: objBits_simps' archObjSize_def)
   done
 
-lemma get_reply_corres:
-  "corres reply_relation (reply_at ptr) (reply_at' ptr)
-     (get_reply ptr) (getReply ptr)"
+lemma getNotification_corres:
+  "corres ntfn_relation (ntfn_at ptr) (ntfn_at' ptr)
+     (get_notification ptr) (getNotification ptr)"
   apply (rule corres_no_failI)
    apply wp
-  apply (simp add: get_simple_ko_def getReply_def get_object_def
-                   getObject_def bind_assoc gets_the_def)
-  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def
-                 dest!: readObject_misc_ko_at')
-  apply (clarsimp simp: assert_def fail_def obj_at_def return_def is_reply partial_inv_def)
-  apply (clarsimp simp add: state_relation_def pspace_relation_def obj_at'_def projectKOs)
+  apply (simp add: get_simple_ko_def getNotification_def get_object_def
+                   getObject_def bind_assoc)
+  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def)
+  apply (clarsimp simp: assert_def fail_def obj_at_def return_def is_ntfn partial_inv_def)
+  apply (clarsimp simp: loadObject_default_def in_monad projectKOs
+                        in_magnitude_check objBits_simps')
+  apply (clarsimp simp add: state_relation_def pspace_relation_def)
   apply (drule bspec)
    apply blast
   apply (simp add: other_obj_relation_def)
   done
 
-lemma getReply_TCB_corres:
-  "corres (=) (reply_at ptr) (reply_at' ptr)
-     (get_reply_tcb ptr) (liftM replyTCB (getReply ptr))"
-  apply clarsimp
-  apply (rule get_reply_corres[THEN corres_rel_imp])
-  apply (clarsimp simp: reply_relation_def)
-  done
-
-lemma get_sc_corres:
-  "corres (\<lambda>sc sc'. \<exists>n. sc_relation sc n sc') (sc_at ptr) (sc_at' ptr)
-     (get_sched_context ptr) (getSchedContext ptr)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (simp add: get_sched_context_def getSchedContext_def get_object_def
-                   getObject_def bind_assoc gets_the_def)
-  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def
-                 dest!: readObject_misc_ko_at')
-  apply (clarsimp simp: assert_def fail_def obj_at_def return_def is_sc_obj_def
-                 split: Structures_A.kernel_object.splits)
-  apply (clarsimp simp add: state_relation_def pspace_relation_def obj_at'_def)
-  apply (drule bspec)
-   apply blast
-  apply (fastforce simp add: other_obj_relation_def projectKOs)
-  done
-
-lemma get_sc_corres_size:
-  "corres (\<lambda>sc sc'. sc_relation sc n sc')
-     (sc_obj_at n ptr) (sc_at' ptr)
-     (get_sched_context ptr) (getSchedContext ptr)"
-  apply (rule corres_no_failI)
-   apply wp
-  apply (simp add: get_sched_context_def getSchedContext_def get_object_def
-                   getObject_def bind_assoc gets_the_def)
-  apply (clarsimp simp: in_monad split_def bind_def gets_def get_def)
-  apply (clarsimp simp: assert_def fail_def obj_at_def return_def is_sc_obj
-                 split: Structures_A.kernel_object.splits
-                 dest!: readObject_misc_ko_at')
-  apply (clarsimp simp: state_relation_def pspace_relation_def obj_at'_def)
-  apply (drule bspec)
-   apply blast
-  apply (clarsimp simp: other_obj_relation_def scBits_simps sc_relation_def objBits_simps projectKOs)
-  done
-
 lemma setObject_ko_wp_at:
   fixes v :: "'a :: pspace_storable"
-  assumes R: "\<And>ko s y n. (updateObject v ko p y n s)
+  assumes R: "\<And>ko s x y n. (updateObject v ko p y n s)
                    = (updateObject_default v ko p y n s)"
+  assumes n: "\<And>v' :: 'a. objBits v' = n"
+  assumes m: "(1 :: word32) < 2 ^ n"
   shows      "\<lbrace>\<lambda>s. obj_at' (\<lambda>x :: 'a. True) p s \<longrightarrow>
                     P (ko_wp_at' (if p = p' then K (P' (injectKO v)) else P')p' s)\<rbrace>
                 setObject p v
               \<lbrace>\<lambda>rv s. P (ko_wp_at' P' p' s)\<rbrace>"
   apply (clarsimp simp: setObject_def valid_def in_monad
-                        ko_wp_at'_def split_def in_magnitude_check
+                        ko_wp_at'_def split_def
                         R updateObject_default_def
                         projectKOs obj_at'_real_def
              split del: if_split)
-  apply (clarsimp simp: project_inject objBits_def[symmetric]
+  apply (clarsimp simp: project_inject objBits_def[symmetric] n
+                        in_magnitude_check [OF _ m]
                  elim!: rsubst[where P=P]
              split del: if_split)
   apply (rule iffI)
-   apply (clarsimp simp: ps_clear_upd objBits_def[symmetric]
+   apply (clarsimp simp: n ps_clear_upd objBits_def[symmetric]
                   split: if_split_asm)
-  apply (clarsimp simp: project_inject objBits_def[symmetric]
+  apply (clarsimp simp: n project_inject objBits_def[symmetric]
                         ps_clear_upd
                  split: if_split_asm)
   done
 
+lemma typ_at'_valid_obj'_lift:
+  assumes P: "\<And>P T p. \<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
+  notes [wp] = hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_const_Ball_lift typ_at_lifts [OF P]
+  shows      "\<lbrace>\<lambda>s. valid_obj' obj s\<rbrace> f \<lbrace>\<lambda>rv s. valid_obj' obj s\<rbrace>"
+  apply (cases obj; simp add: valid_obj'_def hoare_TrueI)
+      apply (rename_tac endpoint)
+      apply (case_tac endpoint; simp add: valid_ep'_def, wp)
+     apply (rename_tac notification)
+     apply (case_tac "ntfnObj notification";
+             simp add: valid_ntfn'_def valid_bound_tcb'_def split: option.splits,
+             (wpsimp|rule conjI)+)
+    apply (rename_tac tcb)
+    apply (case_tac "tcbState tcb";
+           simp add: valid_tcb'_def valid_tcb_state'_def split_def opt_tcb_at'_def
+                     valid_bound_ntfn'_def;
+           wpsimp wp: hoare_case_option_wp hoare_case_option_wp2;
+           (clarsimp split: option.splits)?)
+   apply (wpsimp simp: valid_cte'_def)
+  apply (rename_tac arch_kernel_object)
+  apply (case_tac arch_kernel_object; wpsimp)
+  done
+
+lemmas setObject_valid_obj = typ_at'_valid_obj'_lift [OF setObject_typ_at']
+
 lemma setObject_valid_objs':
   assumes x: "\<And>x n ko s ko' s'.
        \<lbrakk> (ko', s') \<in> fst (updateObject val ko ptr x n s); P s;
@@ -1850,7 +1165,7 @@ lemma setObject_valid_objs':
   apply (subgoal_tac "\<forall>ko. valid_obj' ko s \<longrightarrow> valid_obj' ko b")
    defer
    apply clarsimp
-   apply (erule (1) use_valid [OF _ setObject.typ_at_sc_at'_n_lifts'(3)])
+   apply (erule(1) use_valid [OF _ setObject_valid_obj])
   apply (clarsimp simp: setObject_def split_def in_monad
                         lookupAround2_char1)
   apply (simp add: valid_objs'_def)
@@ -1864,8 +1179,10 @@ lemma setObject_valid_objs':
 
 lemma setObject_iflive':
   fixes v :: "'a :: pspace_storable"
-  assumes R: "\<And>ko s y n. (updateObject v ko ptr y n s)
+  assumes R: "\<And>ko s x y n. (updateObject v ko ptr y n s)
                    = (updateObject_default v ko ptr y n s)"
+  assumes n: "\<And>x :: 'a. objBits x = n"
+  assumes m: "(1 :: word32) < 2 ^ n"
   assumes x: "\<And>x n tcb s t. \<lbrakk> t \<in> fst (updateObject v (KOTCB tcb) ptr x n s); P s;
                                lookupAround2 ptr (ksPSpace s) = (Some (x, KOTCB tcb), n) \<rbrakk>
                   \<Longrightarrow> \<exists>tcb'. t = (KOTCB tcb', s) \<and> (\<forall>(getF, setF) \<in> ran tcb_cte_cases. getF tcb' = getF tcb)"
@@ -1877,7 +1194,7 @@ lemma setObject_iflive':
   apply (rule hoare_pre)
    apply (simp only: imp_conv_disj)
    apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-    apply (rule setObject_ko_wp_at [OF R])
+    apply (rule setObject_ko_wp_at [OF R n m])
    apply (rule hoare_vcg_ex_lift)
    apply (rule setObject_cte_wp_at'[where Q = P, OF x y])
       apply assumption+
@@ -1937,45 +1254,30 @@ lemma setObject_it[wp]:
 definition idle_tcb_ps :: "('a :: pspace_storable) \<Rightarrow> bool" where
   "idle_tcb_ps val \<equiv> (\<exists>tcb. projectKO_opt (injectKO val) = Some tcb \<and> idle_tcb' tcb)"
 
-\<comment>\<open>
-  `idle_sc_ps val` asserts that `val` is a pspace_storable value
-  which corresponds to an idle SchedContext.
-\<close>
-definition idle_sc_ps :: "('a :: pspace_storable) \<Rightarrow> bool" where
-  "idle_sc_ps val \<equiv> (\<exists>sc. sc_of' (injectKO val) = Some sc \<and> idle_sc' sc)"
-
 lemma setObject_idle':
   fixes v :: "'a :: pspace_storable"
-  assumes R: "\<And>ko s y n.
-              (updateObject v ko ptr y n s) = (updateObject_default v ko ptr y n s)"
+  assumes R: "\<And>ko s x y n. (updateObject v ko ptr y n s)
+                   = (updateObject_default v ko ptr y n s)"
+  assumes n: "\<And>x :: 'a. objBits x = n"
+  assumes m: "(1 :: word32) < 2 ^ n"
   assumes z: "\<And>P p q n ko.
-              \<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace>
-              updateObject v p q n ko
-              \<lbrace>\<lambda>rv s. P (ksIdleThread s)\<rbrace>"
-  shows      "\<lbrace>\<lambda>s. valid_idle' s
-                   \<and> (ptr = ksIdleThread s
+       \<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> updateObject v p q n ko
+       \<lbrace>\<lambda>rv s. P (ksIdleThread s)\<rbrace>"
+  shows      "\<lbrace>\<lambda>s. valid_idle' s \<and>
+                   (ptr = ksIdleThread s
                         \<longrightarrow> (\<exists>val :: 'a. idle_tcb_ps val)
-                        \<longrightarrow> idle_tcb_ps v)
-                   \<and> (ptr = idle_sc_ptr
-                        \<longrightarrow> (\<exists>val :: 'a. idle_sc_ps val)
-                        \<longrightarrow> idle_sc_ps v)\<rbrace>
-              setObject ptr v
+                        \<longrightarrow> idle_tcb_ps v)\<rbrace>
+                setObject ptr v
               \<lbrace>\<lambda>rv s. valid_idle' s\<rbrace>"
   apply (simp add: valid_idle'_def pred_tcb_at'_def o_def)
   apply (rule hoare_pre)
    apply (rule hoare_lift_Pf2 [where f="ksIdleThread"])
     apply (simp add: pred_tcb_at'_def obj_at'_real_def)
-    apply (wpsimp wp: setObject_ko_wp_at[OF R])
+    apply (rule setObject_ko_wp_at [OF R n m])
    apply (wp z)
-  apply (rule conjI)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def idle_tcb_ps_def
-                         idle_sc_ps_def)
-   apply (rename_tac tcb sc obj)
-   apply (drule_tac x=obj and y=tcb in spec2, clarsimp simp: project_inject)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def idle_tcb_ps_def
-                        idle_sc_ps_def)
-  apply (rename_tac tcb sc obj)
-  apply (drule_tac x=obj and y=sc in spec2, clarsimp simp: project_inject)
+  apply (clarsimp simp add: pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def idle_tcb_ps_def)
+  apply (clarsimp simp add: project_inject)
+  apply (drule_tac x=obja in spec, simp)
   done
 
 lemma setObject_no_0_obj' [wp]:
@@ -1991,39 +1293,11 @@ lemma valid_updateCapDataI:
   apply (cases c)
   apply (simp_all add: isCap_defs valid_cap'_def capUntypedPtr_def isCap_simps
                        capAligned_def word_size word_bits_def word_bw_assocs)
- done
-
-lemma no_ofail_threadRead[simp]:
-  "no_ofail (obj_at' (P::tcb \<Rightarrow> bool) p) (threadRead f p)"
-  unfolding threadRead_def oliftM_def no_ofail_def
-  apply clarsimp
-  apply (clarsimp simp: threadRead_def obind_def oliftM_def oreturn_def
-                  split: option.split dest!: no_ofailD[OF no_ofail_obj_at'_readObject_tcb])
   done
 
-lemmas no_ofail_threadRead_tcb_at'[wp] = no_ofail_threadRead[where P=\<top>]
-
-lemma threadRead_tcb_at'':
-  "bound (threadRead f t s) \<Longrightarrow> tcb_at' t s"
-  by (clarsimp simp: threadRead_def oliftM_def elim!: obj_at'_weakenE)
-
-lemmas threadRead_tcb_at' = threadRead_tcb_at''[simplified]
-
-lemma ovalid_threadRead:
-  "\<lblot>\<lambda>s. tcb_at' t s \<longrightarrow> (\<exists>tcb. ko_at' tcb t s \<and> P (f tcb) s)\<rblot>
-   threadRead f t
-   \<lblot>P\<rblot>"
-  by (clarsimp simp: threadRead_def oliftM_def obind_def obj_at'_def ovalid_def
-              dest!: readObject_misc_ko_at' split: option.split_asm)
-
-lemma ovalid_threadRead_sp:
-  "\<lblot>P\<rblot> threadRead f ptr \<lblot>\<lambda>rv s. \<exists>tcb :: tcb. ko_at' tcb ptr s \<and> f tcb = rv \<and> P s\<rblot>"
-  by (clarsimp simp: threadRead_def oliftM_def obind_def obj_at'_def ovalid_def
-              dest!: readObject_misc_ko_at' split: option.split_asm)
-
 lemma no_fail_threadGet [wp]:
   "no_fail (tcb_at' t) (threadGet f t)"
-  by (wpsimp simp: threadGet_def wp: no_ofail_gets_the)
+  by (simp add: threadGet_def, wp)
 
 lemma no_fail_getThreadState [wp]:
   "no_fail (tcb_at' t) (getThreadState t)"
@@ -2064,6 +1338,97 @@ lemma no_fail_dmo' [wp]:
   apply (simp add: no_fail_def)
   done
 
+lemma setEndpoint_nosch[wp]:
+  "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace>
+    setEndpoint val ptr
+   \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
+  apply (simp add: setEndpoint_def)
+  apply (rule setObject_nosch)
+  apply (simp add: updateObject_default_def)
+  apply wp
+  apply simp
+  done
+
+lemma setNotification_nosch[wp]:
+  "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace>
+    setNotification val ptr
+   \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
+  apply (simp add: setNotification_def)
+  apply (rule setObject_nosch)
+  apply (simp add: updateObject_default_def)
+  apply wp
+  apply simp
+  done
+
+lemma set_ep_valid_objs':
+  "\<lbrace>valid_objs' and valid_ep' ep\<rbrace>
+  setEndpoint epptr ep
+  \<lbrace>\<lambda>r s. valid_objs' s\<rbrace>"
+  apply (simp add: setEndpoint_def)
+  apply (rule setObject_valid_objs')
+  apply (clarsimp simp: updateObject_default_def in_monad
+                        projectKOs valid_obj'_def)
+  done
+
+lemma set_ep_ctes_of[wp]:
+  "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> setEndpoint p val \<lbrace>\<lambda>rv s. P (ctes_of s)\<rbrace>"
+  apply (simp add: setEndpoint_def)
+  apply (rule setObject_ctes_of[where Q="\<top>", simplified])
+   apply (clarsimp simp: updateObject_default_def in_monad
+                         projectKOs)
+  apply (clarsimp simp: updateObject_default_def bind_def
+                        projectKOs)
+  done
+
+lemma set_ep_valid_mdb' [wp]:
+  "\<lbrace>valid_mdb'\<rbrace>
+     setObject epptr (ep::endpoint)
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (simp add: valid_mdb'_def)
+  apply (rule set_ep_ctes_of[simplified setEndpoint_def])
+  done
+
+lemma setEndpoint_valid_mdb':
+  "\<lbrace>valid_mdb'\<rbrace> setEndpoint p v \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
+  unfolding setEndpoint_def
+  by (rule set_ep_valid_mdb')
+
+lemma set_ep_valid_pspace'[wp]:
+  "\<lbrace>valid_pspace' and valid_ep' ep\<rbrace>
+  setEndpoint epptr ep
+  \<lbrace>\<lambda>r. valid_pspace'\<rbrace>"
+  apply (simp add: valid_pspace'_def)
+  apply (wp set_ep_aligned' [simplified] set_ep_valid_objs')
+   apply (wp hoare_vcg_conj_lift)
+    apply (simp add: setEndpoint_def)
+    apply (wp setEndpoint_valid_mdb')+
+  apply auto
+  done
+
+lemma set_ep_valid_bitmapQ[wp]:
+  "\<lbrace>Invariants_H.valid_bitmapQ\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. Invariants_H.valid_bitmapQ\<rbrace>"
+  apply (unfold setEndpoint_def)
+  apply (rule setObject_ep_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
+  done
+
+lemma set_ep_bitmapQ_no_L1_orphans[wp]:
+  "\<lbrace> bitmapQ_no_L1_orphans \<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. bitmapQ_no_L1_orphans \<rbrace>"
+  apply (unfold setEndpoint_def)
+  apply (rule setObject_ep_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
+  done
+
+lemma set_ep_bitmapQ_no_L2_orphans[wp]:
+  "\<lbrace> bitmapQ_no_L2_orphans \<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>rv. bitmapQ_no_L2_orphans \<rbrace>"
+  apply (unfold setEndpoint_def)
+  apply (rule setObject_ep_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
+  done
+
 lemma ct_in_state_thread_state_lift':
   assumes ct: "\<And>P. \<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
   assumes st: "\<And>t. \<lbrace>st_tcb_at' P t\<rbrace> f \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
@@ -2076,7 +1441,7 @@ lemma ct_in_state_thread_state_lift':
 
 lemma sch_act_wf_lift:
   assumes tcb: "\<And>P t. \<lbrace>st_tcb_at' P t\<rbrace> f \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
-  assumes tcb_cd: "\<And>t. \<lbrace> tcb_in_cur_domain' t\<rbrace> f \<lbrace>\<lambda>_ . tcb_in_cur_domain' t \<rbrace>"
+  assumes tcb_cd: "\<And>P t. \<lbrace> tcb_in_cur_domain' t\<rbrace> f \<lbrace>\<lambda>_ . tcb_in_cur_domain' t \<rbrace>"
   assumes kCT: "\<And>P. \<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
   assumes ksA: "\<And>P. \<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksSchedulerAction s)\<rbrace>"
   shows
@@ -2108,7 +1473,7 @@ lemma ct_idle_or_in_cur_domain'_lift:
   assumes b: "\<And>P. \<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksSchedulerAction s)\<rbrace>"
   assumes c: "\<And>P. \<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace>      f \<lbrace>\<lambda>_ s. P (ksIdleThread s)\<rbrace>"
   assumes d: "\<And>P. \<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace>       f \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
-  assumes e: "\<And>d t t'. \<lbrace>\<lambda>s. t = t' \<or> obj_at' (\<lambda>tcb. d = tcbDomain tcb) t s\<rbrace>
+  assumes e: "\<And>d a t t'. \<lbrace>\<lambda>s. t = t' \<or> obj_at' (\<lambda>tcb. d = tcbDomain tcb) t s\<rbrace>
                             f
                        \<lbrace>\<lambda>_ s. t = t' \<or> obj_at' (\<lambda>tcb. d = tcbDomain tcb) t s\<rbrace>"
   shows "\<lbrace> ct_idle_or_in_cur_domain' \<rbrace> f \<lbrace> \<lambda>_. ct_idle_or_in_cur_domain' \<rbrace>"
@@ -2126,24 +1491,48 @@ lemma ct_idle_or_in_cur_domain'_lift:
   apply (rule d)
   done
 
-lemmas cur_tcb_lift =
-  hoare_lift_Pf [where f = ksCurThread and P = tcb_at', folded cur_tcb'_def]
 
-lemma valid_mdb'_lift:
-  "(\<And>P. f \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>) \<Longrightarrow> f \<lbrace>valid_mdb'\<rbrace>"
-  unfolding valid_mdb'_def
-  apply simp
+lemma setObject_ep_obj_at'_tcb[wp]:
+  "\<lbrace>obj_at' (P :: tcb \<Rightarrow> bool) t \<rbrace> setObject ptr (e::endpoint) \<lbrace>\<lambda>_. obj_at' (P :: tcb \<Rightarrow> bool) t\<rbrace>"
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp: updateObject_default_def in_monad)
+  done
+
+lemma setObject_ep_cur_domain[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> setObject ptr (e::endpoint) \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setEndpoint_tcb_in_cur_domain'[wp]:
+  "\<lbrace>tcb_in_cur_domain' t\<rbrace> setEndpoint epptr ep \<lbrace>\<lambda>_. tcb_in_cur_domain' t\<rbrace>"
+  apply (clarsimp simp: setEndpoint_def)
+  apply (rule tcb_in_cur_domain'_lift; wp)
+  done
+
+lemma setEndpoint_obj_at'_tcb[wp]:
+  "\<lbrace>obj_at' (P :: tcb \<Rightarrow> bool) t \<rbrace> setEndpoint ptr (e::endpoint) \<lbrace>\<lambda>_. obj_at' (P :: tcb \<Rightarrow> bool) t\<rbrace>"
+  by (clarsimp simp: setEndpoint_def, wp)
+
+lemma set_ep_sch_act_wf[wp]:
+  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
+     setEndpoint epptr ep
+   \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (wp sch_act_wf_lift)
+    apply (simp add: setEndpoint_def split_def setObject_def
+              | wp updateObject_default_inv)+
   done
 
 lemma setObject_state_refs_of':
   assumes x: "updateObject val = updateObject_default val"
+  assumes y: "(1 :: word32) < 2 ^ objBits val"
   shows
   "\<lbrace>\<lambda>s. P ((state_refs_of' s) (ptr := refs_of' (injectKO val)))\<rbrace>
      setObject ptr val
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (clarsimp simp: setObject_def valid_def in_monad split_def
-                        updateObject_default_def x
-                        projectKOs in_magnitude_check[OF _]
+                        updateObject_default_def x in_magnitude_check
+                        projectKOs y
                  elim!: rsubst[where P=P] intro!: ext
              split del: if_split cong: option.case_cong if_cong)
   apply (clarsimp simp: state_refs_of'_def objBits_def[symmetric]
@@ -2160,14 +1549,183 @@ lemma setObject_state_refs_of_eq:
      setObject ptr val
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (clarsimp simp: setObject_def valid_def in_monad split_def
-                        lookupAround2_char1
+                        updateObject_default_def in_magnitude_check
+                        projectKOs lookupAround2_char1
                  elim!: rsubst[where P=P] intro!: ext
              split del: if_split cong: option.case_cong if_cong)
-  apply (frule x)
-  apply (simp add: state_refs_of'_def ps_clear_upd updateObject_size
-             cong: option.case_cong if_cong)+
+  apply (frule x, drule updateObject_objBitsKO)
+  apply (simp add: state_refs_of'_def ps_clear_upd
+             cong: option.case_cong if_cong)
+  done
+
+lemma set_ep_state_refs_of'[wp]:
+  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (epptr := ep_q_refs_of' ep))\<rbrace>
+     setEndpoint epptr ep
+   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
+  unfolding setEndpoint_def
+  by (wp setObject_state_refs_of',
+      simp_all add: objBits_simps' fun_upd_def[symmetric])
+
+lemma set_ntfn_ctes_of[wp]:
+  "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> setNotification p val \<lbrace>\<lambda>rv s. P (ctes_of s)\<rbrace>"
+  apply (simp add: setNotification_def)
+  apply (rule setObject_ctes_of[where Q="\<top>", simplified])
+   apply (clarsimp simp: updateObject_default_def in_monad
+                         projectKOs)
+  apply (clarsimp simp: updateObject_default_def bind_def
+                        projectKOs)
+  done
+
+lemma set_ntfn_valid_mdb' [wp]:
+  "\<lbrace>valid_mdb'\<rbrace>
+    setObject epptr (ntfn::Structures_H.notification)
+   \<lbrace>\<lambda>_. valid_mdb'\<rbrace>"
+  apply (simp add: valid_mdb'_def)
+  apply (rule set_ntfn_ctes_of[simplified setNotification_def])
+  done
+
+lemma set_ntfn_valid_objs':
+  "\<lbrace>valid_objs' and valid_ntfn' ntfn\<rbrace>
+    setNotification p ntfn
+   \<lbrace>\<lambda>r s. valid_objs' s\<rbrace>"
+  apply (simp add: setNotification_def)
+  apply (rule setObject_valid_objs')
+  apply (clarsimp simp: updateObject_default_def in_monad
+                        valid_obj'_def)
+  done
+
+lemma set_ntfn_valid_pspace'[wp]:
+  "\<lbrace>valid_pspace' and valid_ntfn' ntfn\<rbrace>
+    setNotification p ntfn
+   \<lbrace>\<lambda>r. valid_pspace'\<rbrace>"
+  apply (simp add: valid_pspace'_def)
+  apply (wp set_ntfn_aligned' [simplified] set_ntfn_valid_objs')
+      apply (simp add: setNotification_def,wp)
+     apply auto
+  done
+
+lemma set_ntfn_valid_bitmapQ[wp]:
+  "\<lbrace>Invariants_H.valid_bitmapQ\<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. Invariants_H.valid_bitmapQ\<rbrace>"
+  apply (unfold setNotification_def)
+  apply (rule setObject_ntfn_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp)+
+  done
+
+lemma set_ntfn_bitmapQ_no_L1_orphans[wp]:
+  "\<lbrace> bitmapQ_no_L1_orphans \<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. bitmapQ_no_L1_orphans \<rbrace>"
+  apply (unfold setNotification_def)
+  apply (rule setObject_ntfn_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp)+
+  done
+
+lemma set_ntfn_bitmapQ_no_L2_orphans[wp]:
+  "\<lbrace> bitmapQ_no_L2_orphans \<rbrace> setNotification p ntfn \<lbrace>\<lambda>rv. bitmapQ_no_L2_orphans \<rbrace>"
+  apply (unfold setNotification_def)
+  apply (rule setObject_ntfn_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp)+
+  done
+
+lemma set_ntfn_state_refs_of'[wp]:
+  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (epptr := ntfn_q_refs_of' (ntfnObj ntfn)
+                                      \<union> ntfn_bound_refs' (ntfnBoundTCB ntfn)))\<rbrace>
+     setNotification epptr ntfn
+   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
+  unfolding setNotification_def
+  by (wp setObject_state_refs_of',
+      simp_all add: objBits_simps' fun_upd_def)
+
+lemma setNotification_pred_tcb_at'[wp]:
+  "\<lbrace>pred_tcb_at' proj P t\<rbrace> setNotification ptr val \<lbrace>\<lambda>rv. pred_tcb_at' proj P t\<rbrace>"
+  apply (simp add: pred_tcb_at'_def setNotification_def)
+  apply (rule obj_at_setObject2)
+   apply simp
+  apply (clarsimp simp: updateObject_default_def in_monad)
+  done
+
+lemma setObject_ntfn_cur_domain[wp]:
+  "\<lbrace> \<lambda>s. P (ksCurDomain s) \<rbrace> setObject ptr (ntfn::Structures_H.notification) \<lbrace> \<lambda>_s . P (ksCurDomain s) \<rbrace>"
+  apply (clarsimp simp: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_ntfn_obj_at'_tcb[wp]:
+  "\<lbrace>obj_at' (P :: tcb \<Rightarrow> bool) t \<rbrace> setObject ptr (ntfn::Structures_H.notification) \<lbrace>\<lambda>_. obj_at' (P :: tcb \<Rightarrow> bool) t\<rbrace>"
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp: updateObject_default_def in_monad)
   done
 
+lemma setNotification_ksCurDomain[wp]:
+  "\<lbrace> \<lambda>s. P (ksCurDomain s) \<rbrace> setNotification ptr (ntfn::Structures_H.notification) \<lbrace> \<lambda>_s . P (ksCurDomain s) \<rbrace>"
+   apply (simp add: setNotification_def)
+   apply wp
+   done
+
+lemma setNotification_tcb_in_cur_domain'[wp]:
+  "\<lbrace>tcb_in_cur_domain' t\<rbrace> setNotification epptr ep \<lbrace>\<lambda>_. tcb_in_cur_domain' t\<rbrace>"
+  apply (clarsimp simp: setNotification_def)
+  apply (rule tcb_in_cur_domain'_lift; wp)
+  done
+
+lemma set_ntfn_sch_act_wf[wp]:
+  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
+     setNotification ntfnptr ntfn
+   \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (wp sch_act_wf_lift | clarsimp simp: setNotification_def)+
+    apply (simp add: setNotification_def split_def setObject_def
+         | wp updateObject_default_inv)+
+  done
+
+lemmas cur_tcb_lift =
+  hoare_lift_Pf [where f = ksCurThread and P = tcb_at', folded cur_tcb'_def]
+
+lemma set_ntfn_cur_tcb'[wp]:
+  "\<lbrace>cur_tcb'\<rbrace> setNotification ptr ntfn \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
+  apply (wp cur_tcb_lift)
+  apply (simp add: setNotification_def setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setEndpoint_typ_at'[wp]:
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> setEndpoint ptr val \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
+  unfolding setEndpoint_def
+  by (rule setObject_typ_at')
+
+lemmas setEndpoint_typ_ats[wp] = typ_at_lifts [OF setEndpoint_typ_at']
+
+lemma get_ep_sp':
+  "\<lbrace>P\<rbrace> getEndpoint r \<lbrace>\<lambda>t. P and ko_at' t r\<rbrace>"
+  by (clarsimp simp: getEndpoint_def getObject_def loadObject_default_def
+                     projectKOs in_monad valid_def obj_at'_def objBits_simps'
+                     in_magnitude_check split_def)
+
+lemma setEndpoint_cur_tcb'[wp]:
+  "\<lbrace>cur_tcb'\<rbrace> setEndpoint p v \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
+  apply (wp cur_tcb_lift)
+  apply (simp add: setEndpoint_def setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setEndpoint_iflive'[wp]:
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
+      \<and> (v \<noteq> IdleEP \<longrightarrow> ex_nonz_cap_to' p s)\<rbrace>
+     setEndpoint p v
+   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
+  unfolding setEndpoint_def
+  apply (wp setObject_iflive'[where P="\<top>"])
+       apply simp
+      apply (simp add: objBits_simps')
+     apply simp
+    apply (clarsimp simp: updateObject_default_def in_monad projectKOs)
+   apply (clarsimp simp: updateObject_default_def in_monad
+                         projectKOs bind_def)
+  apply clarsimp
+  done
+
+declare setEndpoint_cte_wp_at'[wp]
+
 lemma ex_nonz_cap_to_pres':
   assumes y: "\<And>P p. \<lbrace>cte_wp_at' P p\<rbrace> f \<lbrace>\<lambda>rv. cte_wp_at' P p\<rbrace>"
   shows      "\<lbrace>ex_nonz_cap_to' p\<rbrace> f \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
@@ -2176,6 +1734,52 @@ lemma ex_nonz_cap_to_pres':
                y hoare_vcg_all_lift)
   done
 
+lemma setEndpoint_cap_to'[wp]:
+  "\<lbrace>ex_nonz_cap_to' p\<rbrace> setEndpoint p' v \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
+  by (wp ex_nonz_cap_to_pres')
+
+lemma setEndpoint_ifunsafe'[wp]:
+  "\<lbrace>if_unsafe_then_cap'\<rbrace> setEndpoint p v \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
+  unfolding setEndpoint_def
+  apply (rule setObject_ifunsafe'[where P="\<top>", simplified])
+    apply (clarsimp simp: updateObject_default_def in_monad projectKOs
+                  intro!: equals0I)+
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setEndpoint_idle'[wp]:
+  "\<lbrace>\<lambda>s. valid_idle' s\<rbrace>
+   setEndpoint p v
+   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
+  unfolding setEndpoint_def
+  apply (wp setObject_idle')
+       apply (simp add: objBits_simps' updateObject_default_inv)+
+  apply (clarsimp simp: projectKOs idle_tcb_ps_def)
+  done
+
+crunch setEndpoint
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (simp: updateObject_default_inv)
+
+lemma setObject_ksPSpace_only:
+  "\<lbrakk> \<And>p q n ko. \<lbrace>P\<rbrace> updateObject val p q n ko \<lbrace>\<lambda>rv. P \<rbrace>;
+        \<And>f s. P (ksPSpace_update f s) = P s \<rbrakk>
+     \<Longrightarrow> \<lbrace>P\<rbrace> setObject ptr val \<lbrace>\<lambda>rv. P\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp | simp | assumption)+
+  done
+
+lemma setObject_ksMachine:
+  "\<lbrakk> \<And>p q n ko. \<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> updateObject val p q n ko \<lbrace>\<lambda>rv s. P (ksMachineState s)\<rbrace> \<rbrakk>
+     \<Longrightarrow> \<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> setObject ptr val \<lbrace>\<lambda>rv s. P (ksMachineState s)\<rbrace>"
+  by (simp add: setObject_ksPSpace_only)
+
+lemma setObject_ksInterrupt:
+  "\<lbrakk> \<And>p q n ko. \<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> updateObject val p q n ko \<lbrace>\<lambda>rv s. P (ksInterruptState s)\<rbrace> \<rbrakk>
+     \<Longrightarrow> \<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> setObject ptr val \<lbrace>\<lambda>rv s. P (ksInterruptState s)\<rbrace>"
+  by (simp add: setObject_ksPSpace_only)
+
 lemma valid_irq_handlers_lift':
   assumes x: "\<And>P. \<lbrace>\<lambda>s. P (cteCaps_of s)\<rbrace> f \<lbrace>\<lambda>rv s. P (cteCaps_of s)\<rbrace>"
   assumes y: "\<And>P. \<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> f \<lbrace>\<lambda>rv s. P (ksInterruptState s)\<rbrace>"
@@ -2186,6 +1790,19 @@ lemma valid_irq_handlers_lift':
 
 lemmas valid_irq_handlers_lift'' = valid_irq_handlers_lift' [unfolded cteCaps_of_def]
 
+crunch setEndpoint
+  for ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
+  (wp: setObject_ksInterrupt updateObject_default_inv)
+
+lemmas setEndpoint_irq_handlers[wp]
+    = valid_irq_handlers_lift'' [OF set_ep_ctes_of setEndpoint_ksInterruptState]
+
+declare set_ep_arch' [wp]
+
+lemma set_ep_maxObj [wp]:
+  "\<lbrace>\<lambda>s. P (gsMaxObjectSize s)\<rbrace> setEndpoint ptr val \<lbrace>\<lambda>rv s. P (gsMaxObjectSize s)\<rbrace>"
+  by (simp add: setEndpoint_def | wp setObject_ksPSpace_only updateObject_default_inv)+
+
 lemma valid_global_refs_lift':
   assumes ctes: "\<And>P. \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ctes_of s)\<rbrace>"
   assumes arch: "\<And>P. \<lbrace>\<lambda>s. P (ksArchState s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksArchState s)\<rbrace>"
@@ -2213,6 +1830,107 @@ lemma valid_arch_state_lift':
    apply (wp typs hoare_vcg_const_Ball_lift arch typ_at_lifts)+
   done
 
+lemma setObject_ep_ct:
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setObject p (e::endpoint) \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: setObject_def updateObject_ep_eta split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_ntfn_ct:
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setObject p (e::Structures_H.notification)
+   \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma get_ntfn_sp':
+  "\<lbrace>P\<rbrace> getNotification r \<lbrace>\<lambda>t. P and ko_at' t r\<rbrace>"
+  by (clarsimp simp: getNotification_def getObject_def loadObject_default_def
+                     projectKOs in_monad valid_def obj_at'_def objBits_simps'
+                     in_magnitude_check split_def)
+
+lemma set_ntfn_pred_tcb_at' [wp]:
+  "\<lbrace> pred_tcb_at' proj P t \<rbrace>
+   setNotification ep v
+   \<lbrace> \<lambda>rv. pred_tcb_at' proj P t \<rbrace>"
+  apply (simp add: setNotification_def pred_tcb_at'_def)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_default_def in_monad)
+  done
+
+lemma set_ntfn_iflive'[wp]:
+  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
+      \<and> (live' (KONotification v) \<longrightarrow> ex_nonz_cap_to' p s)\<rbrace>
+     setNotification p v
+   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
+  apply (simp add: setNotification_def)
+  apply (wp setObject_iflive'[where P="\<top>"])
+       apply simp
+      apply (simp add: objBits_simps)
+     apply (simp add: objBits_simps')
+    apply (clarsimp simp: updateObject_default_def in_monad projectKOs)
+   apply (clarsimp simp: updateObject_default_def
+                         projectKOs bind_def)
+  apply clarsimp
+  done
+
+declare setNotification_cte_wp_at'[wp]
+
+lemma set_ntfn_cap_to'[wp]:
+  "\<lbrace>ex_nonz_cap_to' p\<rbrace> setNotification p' v \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
+  by (wp ex_nonz_cap_to_pres')
+
+lemma setNotification_ifunsafe'[wp]:
+  "\<lbrace>if_unsafe_then_cap'\<rbrace> setNotification p v \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
+  unfolding setNotification_def
+  apply (rule setObject_ifunsafe'[where P="\<top>", simplified])
+    apply (clarsimp simp: updateObject_default_def in_monad projectKOs
+                  intro!: equals0I)+
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setNotification_idle'[wp]:
+  "\<lbrace>\<lambda>s. valid_idle' s\<rbrace> setNotification p v \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
+  unfolding setNotification_def
+  apply (wp setObject_idle')
+        apply (simp add: objBits_simps' updateObject_default_inv)+
+  apply (clarsimp simp: projectKOs idle_tcb_ps_def)
+  done
+
+crunch setNotification
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (wp: updateObject_default_inv)
+
+lemma set_ntfn_arch' [wp]:
+  "\<lbrace>\<lambda>s. P (ksArchState s)\<rbrace> setNotification ntfn p \<lbrace>\<lambda>_ s. P (ksArchState s)\<rbrace>"
+  apply (simp add: setNotification_def setObject_def split_def)
+  apply (wp updateObject_default_inv|simp)+
+  done
+
+lemma set_ntfn_ksInterrupt[wp]:
+  "\<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> setNotification ptr val \<lbrace>\<lambda>rv s. P (ksInterruptState s)\<rbrace>"
+  by (simp add: setNotification_def | wp setObject_ksInterrupt updateObject_default_inv)+
+
+lemma set_ntfn_ksMachine[wp]:
+  "\<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> setNotification ptr val \<lbrace>\<lambda>rv s. P (ksMachineState s)\<rbrace>"
+  by (simp add: setNotification_def | wp setObject_ksMachine updateObject_default_inv)+
+
+lemma set_ntfn_maxObj [wp]:
+  "\<lbrace>\<lambda>s. P (gsMaxObjectSize s)\<rbrace> setNotification ptr val \<lbrace>\<lambda>rv s. P (gsMaxObjectSize s)\<rbrace>"
+  by (simp add: setNotification_def | wp setObject_ksPSpace_only updateObject_default_inv)+
+
+lemma set_ntfn_global_refs' [wp]:
+  "\<lbrace>valid_global_refs'\<rbrace> setNotification ptr val \<lbrace>\<lambda>_. valid_global_refs'\<rbrace>"
+  by (rule valid_global_refs_lift'; wp)
+
+crunch setNotification
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+
+lemma set_ntfn_valid_arch' [wp]:
+  "\<lbrace>valid_arch_state'\<rbrace> setNotification ptr val \<lbrace>\<lambda>_. valid_arch_state'\<rbrace>"
+  by (rule valid_arch_state_lift'; wp)
+
 lemmas valid_irq_node_lift =
     hoare_use_eq_irq_node' [OF _ typ_at_lift_valid_irq_node']
 
@@ -2229,791 +1947,9 @@ lemma valid_irq_states_lift':
   apply wp
   done
 
-lemma irqs_masked_lift:
-  assumes "\<And>P. \<lbrace>\<lambda>s. P (intStateIRQTable (ksInterruptState s))\<rbrace> f
-               \<lbrace>\<lambda>rv s. P (intStateIRQTable (ksInterruptState s))\<rbrace>"
-  shows "\<lbrace>irqs_masked'\<rbrace> f \<lbrace>\<lambda>_. irqs_masked'\<rbrace>"
-  apply (simp add: irqs_masked'_def)
-  apply (wp assms)
-  done
+lemmas set_ntfn_irq_handlers'[wp] = valid_irq_handlers_lift'' [OF set_ntfn_ctes_of set_ntfn_ksInterrupt]
 
-lemma setObject_pspace_domain_valid[wp]:
-  "setObject ptr val \<lbrace>pspace_domain_valid\<rbrace>"
-  by (clarsimp simp: setObject_def split_def pspace_domain_valid_def valid_def
-                      in_monad lookupAround2_char1 updateObject_size
-              split: if_split_asm)
-
-lemma ct_not_inQ_lift:
-  assumes sch_act: "\<And>P. \<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksSchedulerAction s)\<rbrace>"
-      and not_inQ: "\<lbrace>\<lambda>s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>
-                    f \<lbrace>\<lambda>_ s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>"
-  shows "\<lbrace>ct_not_inQ\<rbrace> f \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
-  unfolding ct_not_inQ_def
-  by (rule hoare_convert_imp [OF sch_act not_inQ])
-
-lemma obj_at'_ignoring_obj:
-  "obj_at' (\<lambda>_ :: 'a :: pspace_storable. P) p s = (obj_at' (\<lambda>_ :: 'a. True) p s \<and> P)"
-  by (rule iffI; clarsimp simp: obj_at'_def)
-
-lemma forall_ko_at'_equiv_projection:
-  "(\<lambda>s. \<forall>ko::'a::pspace_storable. ko_at' ko p s \<longrightarrow> P ko s) =
-   (\<lambda>s. obj_at' (\<lambda>_::'a::pspace_storable. True) p s \<longrightarrow> P (the ((ksPSpace s |> projectKO_opt) p)) s)"
-  by (fastforce simp: obj_at'_def projectKOs opt_map_red)
-
-end
-
-locale pspace_only' =
-  fixes f :: "'a kernel"
-  assumes pspace: "(rv, s') \<in> fst (f s) \<Longrightarrow> \<exists>g. s' = ksPSpace_update g s"
-begin
-
-lemma it[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace>"
-  and ct[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace>"
-  and cur_domain[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace>"
-  and ksDomSchedule[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace>"
-  and l1Bitmap[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
-  and l2Bitmap[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
-  and gsUserPages[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (gsUserPages s)\<rbrace>"
-  and gsCNodes[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (gsCNodes s)\<rbrace>"
-  and gsUntypedZeroRanges[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (gsUntypedZeroRanges s)\<rbrace>"
-  and gsMaxObjectSize[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (gsMaxObjectSize s)\<rbrace>"
-  and ksDomScheduleIdx[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace>"
-  and ksDomainTime[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksDomainTime s)\<rbrace>"
-  and ksReadyQueues[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace>"
-  and ksReleaseQueue[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksReleaseQueue s)\<rbrace>"
-  and ksConsumedTime[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksConsumedTime s)\<rbrace>"
-  and ksCurTime[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksCurTime s)\<rbrace>"
-  and ksCurSc[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksCurSc s)\<rbrace>"
-  and ksReprogramTimer[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksReprogramTimer s)\<rbrace>"
-  and ksSchedulerAction[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace>"
-  and ksInterruptState[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace>"
-  and ksWorkUnitsCompleted[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksWorkUnitsCompleted s)\<rbrace>"
-  and ksArchState[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksArchState s)\<rbrace>"
-  and ksMachineState[wp]: "\<And>P. f \<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace>"
-  unfolding valid_def using pspace
-  by (all \<open>fastforce\<close>)
-
-lemma sch_act_simple[wp]:
-  "f \<lbrace>\<lambda>s. P (sch_act_simple s)\<rbrace>"
-  apply (wpsimp wp: ksSchedulerAction simp: sch_act_simple_def)
-  done
-
-end
-
-locale simple_ko' =
-  fixes f :: "obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-    and g :: "obj_ref \<Rightarrow> 'a kernel"
-  assumes f_def: "f p v = setObject p v"
-  assumes g_def: "g p = getObject p"
-  assumes default_update: "updateObject (v::'a) = updateObject_default (v::'a)"
-  assumes default_load: "(loadObject ptr ptr' next obj :: 'a kernel_r) =
-                              loadObject_default ptr ptr' next obj"
-  assumes not_cte: "projectKO_opt (KOCTE cte) = (None::'a option)"
-begin
-
-lemma updateObject_cte[simp]:
-  "fst (updateObject (v::'a) (KOCTE cte) p x n s) = {}"
-  by (clarsimp simp: default_update updateObject_default_def in_monad projectKOs not_cte bind_def)
-
-lemma pspace_aligned'[wp]: "f p v \<lbrace>pspace_aligned'\<rbrace>"
-  and pspace_distinct'[wp]: "f p v \<lbrace>pspace_distinct'\<rbrace>"
-  and pspace_bounded'[wp]: "f p v \<lbrace>pspace_bounded'\<rbrace>"
-  and no_0_obj'[wp]: "f p v \<lbrace>no_0_obj'\<rbrace>"
-  unfolding f_def by (all \<open>wpsimp simp: default_update updateObject_default_def in_monad\<close>)
-
-lemma valid_objs':
-  "\<lbrace>valid_objs' and valid_obj' (injectKO v) \<rbrace> f p v \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  unfolding f_def
-  by (rule setObject_valid_objs')
-     (clarsimp simp: default_update updateObject_default_def in_monad projectKOs)+
-
-lemma typ_at'[wp]:
-  "f p v \<lbrace>\<lambda>s. P (typ_at' T p' s)\<rbrace>"
-  unfolding f_def
-  by (rule setObject_typ_at')
-
-lemma sc_at'_n[wp]: "f p v \<lbrace>\<lambda>s. P (sc_at'_n n p' s)\<rbrace>"
-  unfolding f_def
-  by (clarsimp simp: valid_def setObject_def in_monad split_def ko_wp_at'_def ps_clear_upd
-                     updateObject_size lookupAround2_char1 updateObject_type)
-
-sublocale typ_at_all_props' "f p v" for p v by typ_at_props'
-
-sublocale pspace_only' "f p v" for p v
-  unfolding f_def
-  by unfold_locales
-     (fastforce simp: setObject_def updateObject_default_def magnitudeCheck_def default_update
-                      in_monad split_def projectKOs
-                split: option.splits)
-
-lemma set_ep_valid_bitmapQ[wp]:
-  "f p v \<lbrace> valid_bitmapQ \<rbrace>"
-  unfolding bitmapQ_defs by (wpsimp wp: hoare_vcg_all_lift | wps)+
-
-lemma bitmapQ_no_L1_orphans[wp]:
-  "f p v \<lbrace> bitmapQ_no_L1_orphans \<rbrace>"
-  unfolding bitmapQ_defs by (wpsimp wp: hoare_vcg_all_lift | wps)+
-
-lemma bitmapQ_no_L2_orphans[wp]:
-  "f p v \<lbrace> bitmapQ_no_L2_orphans \<rbrace>"
-  unfolding bitmapQ_defs by (wpsimp wp: hoare_vcg_all_lift | wps)+
-
-lemma state_refs_of':
-  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (ptr := refs_of' (injectKO val)))\<rbrace>
-   f ptr val
-   \<lbrace>\<lambda>_ s. P (state_refs_of' s)\<rbrace>"
-  unfolding f_def
-  by (auto intro: setObject_state_refs_of' simp: default_update)
-
-lemma valid_arch_state'[wp]:
-  "f p v \<lbrace> valid_arch_state' \<rbrace>"
-  by (rule valid_arch_state_lift'; wp)
-
-lemmas valid_irq_node'[wp] = valid_irq_node_lift[OF ksInterruptState typ_at']
-lemmas irq_states' [wp] = valid_irq_states_lift' [OF ksInterruptState ksMachineState]
-lemmas irqs_masked'[wp] = irqs_masked_lift[OF ksInterruptState]
-
-lemma valid_machine_state'[wp]:
-  "f p v \<lbrace>valid_machine_state'\<rbrace>"
-  unfolding valid_machine_state'_def pointerInDeviceData_def pointerInUserData_def
-  by (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-
-lemma pspace_domain_valid[wp]:
-  "f ptr val \<lbrace>pspace_domain_valid\<rbrace>"
-  unfolding f_def by (wpsimp simp: default_update updateObject_default_def in_monad projectKOs)
-
-lemmas x = ct_not_inQ_lift[OF ksSchedulerAction]
-
-lemma setObject_wp:
-  "\<lbrace>\<lambda>s. P (set_obj' ptr obj s)\<rbrace>
-   setObject ptr (obj :: 'a :: pspace_storable)
-   \<lbrace>\<lambda>_. P\<rbrace>"
-  apply (wpsimp simp: setObject_def default_update updateObject_default_def fun_upd_def
-                      ARM_H.fromPPtr_def) (* FIXME: arch split *)
-                                          (* FIXME: this is a simp rule, why isn't it available? *)
-  done
-
-lemmas set_wp = setObject_wp[folded f_def]
-lemma setObject_pre:
-  fixes obj :: 'a
-  assumes "\<lbrace>P and obj_at' (\<lambda>old_obj :: 'a. objBits old_obj = objBits obj) p\<rbrace>
-           setObject p obj
-           \<lbrace>Q\<rbrace>"
-  shows "\<lbrace>P\<rbrace> setObject p obj \<lbrace>Q\<rbrace>"
-  supply simps = in_magnitude_check[OF _, unfolded objBits_def] valid_def
-                 setObject_def in_monad split_def default_update updateObject_default_def
-                 projectKO_eq project_inject objBits_def
-                 ARM_H.fromPPtr_def (* FIXME: arch split *)
-  using assms
-  apply (clarsimp simp: simps)
-  apply (rename_tac s ko)
-  apply (drule_tac x=s in spec)
-  apply (clarsimp simp: obj_at'_def projectKO_eq split_paired_Ball project_inject)
-  apply (erule impE)
-   apply fastforce
-  apply (drule spec, erule mp)
-  apply (fastforce simp: simps)
-  done
-
-\<comment>\<open>
-  Keeps the redundant @{term "obj_at \<top>"} precondition because this matches common abbreviations
-  like @{term "tcb_at'"}.
-
-  Lets the postcondition pointer depend on the state for things like @{term "ksCurThread"}.
-\<close>
-lemma setObject_obj_at'_strongest:
-  fixes obj :: 'a
-  shows "\<lbrace>\<lambda>s. obj_at' (\<lambda>_:: 'a. True) ptr s
-              \<and> obj_at' (\<lambda>old_obj :: 'a. objBits old_obj = objBits obj) ptr s
-              \<longrightarrow> (let s' = set_obj' ptr obj s in
-                    Q ((ptr = ptr' s' \<longrightarrow> P s' obj)
-                       \<and> (ptr \<noteq> ptr' s' \<longrightarrow> obj_at' (P s') (ptr' s') s)))\<rbrace>
-         setObject ptr obj
-         \<lbrace>\<lambda>rv s. Q (obj_at' (P s) (ptr' s) s)\<rbrace>"
-  apply (rule setObject_pre)
-  apply (wpsimp wp: setObject_wp
-              simp: Let_def)
-  apply (elim impE)
-   apply (clarsimp simp: obj_at'_def)
-  apply (erule rsubst[where P=Q])
-  apply (case_tac "ptr = ptr' (set_obj' ptr obj s)"; simp)
-   apply (clarsimp simp: same_size_obj_at'_set_obj'_iff
-                         obj_at'_ignoring_obj[where P="P f obj" for f])
-  apply (clarsimp simp: obj_at'_def projectKO_eq project_inject ps_clear_upd)
-  done
-
-lemmas obj_at'_strongest = setObject_obj_at'_strongest[folded f_def]
-
-lemma setObject_obj_at':
-  fixes v :: 'a
-  shows "\<lbrace>\<lambda>s. obj_at' (\<lambda>_:: 'a. True) p s \<longrightarrow> P (if p = p' then P' v else obj_at' P' p' s)\<rbrace>
-         setObject p v
-         \<lbrace>\<lambda>rv s. P (obj_at' P' p' s)\<rbrace>"
-  by (wpsimp wp: setObject_obj_at'_strongest split: if_splits)
-
-lemmas obj_at' = setObject_obj_at'[folded f_def]
-
-lemma getObject_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko :: 'a. ko_at' ko p s \<longrightarrow> P ko s\<rbrace>
-   getObject p
-   \<lbrace>P\<rbrace>"
-  apply (wpsimp simp: getObject_def default_load ARM_H.fromPPtr_def loadObject_default_def
-                      projectKO_def readObject_def omonad_defs split_def)
-  apply (rename_tac ko)
-  apply (prop_tac "ko_at' ko p s")
-   apply (clarsimp simp: obj_at'_def project_inject projectKO_eq objBits_def[symmetric]
-                         read_magnitudeCheck_def
-                         lookupAround2_no_after_ps_clear
-                         lookupAround2_after_ps_clear[OF _ _]
-                  split: if_split_asm option.split_asm)
-  apply fastforce
-  done
-
-lemma getObject_wp':
-  "\<lbrace>\<lambda>s. obj_at' (\<lambda>_::'a. True) p s \<longrightarrow> P (the ((ksPSpace s |> projectKO_opt) p)) s\<rbrace>
-   getObject p
-   \<lbrace>P::'a \<Rightarrow> _ \<Rightarrow> _\<rbrace>"
-  apply (wpsimp wp: getObject_wp)
-  by (metis forall_ko_at'_equiv_projection)
-
-lemmas get_wp = getObject_wp[folded g_def]
-lemmas get_wp' = getObject_wp'[folded g_def]
-
-lemma loadObject_default_inv:
-  "\<lbrace>P\<rbrace> gets_the $ loadObject_default addr addr' next obj \<lbrace>\<lambda>rv. P\<rbrace>"
-  by wpsimp
-
-lemma getObject_inv:
-  "\<lbrace>P\<rbrace> getObject p \<lbrace>\<lambda>(rv :: 'a). P\<rbrace>"
-  by (wpsimp simp: default_load getObject_def split_def wp: loadObject_default_inv)
-
-lemmas get_inv = getObject_inv[folded g_def]
-
-lemma getObject_sp:
-  "\<lbrace>P\<rbrace> getObject r \<lbrace>\<lambda>rv::'a. P and ko_at' rv r\<rbrace>"
-  apply (clarsimp simp: getObject_def loadObject_default_def default_load
-                        projectKOs in_monad valid_def obj_at'_def project_inject
-                        split_def ARM_H.fromPPtr_def readObject_def omonad_defs
-                 split: if_split_asm option.split_asm)
-  by (clarsimp simp: objBits_def)
-
-lemmas getObject_sp' = getObject_sp[folded g_def]
-
-lemma setObject_preserves_some_obj_at':
-  "\<lbrace>\<lambda>s. obj_at' (\<lambda>_ :: 'a. True) p s \<longrightarrow> P (obj_at' (\<lambda>_ :: 'a. True) p' s)\<rbrace>
-   setObject p (ko :: 'a)
-   \<lbrace>\<lambda>_ s. P (obj_at' (\<lambda>_ :: 'a. True) p' s)\<rbrace>"
-  apply (wpsimp wp: setObject_obj_at'_strongest)
-  apply (case_tac "p = p'"; clarsimp)
-  done
-
-lemmas set_preserves_some_obj_at' = setObject_preserves_some_obj_at'[folded f_def]
-
-lemma getObject_wp_rv_only:
-  "\<lbrace>\<lambda>s. obj_at' (\<lambda>_:: 'a. True) p s \<longrightarrow> obj_at' (\<lambda>ko :: 'a. P ko) p s\<rbrace> getObject p \<lbrace>\<lambda>rv _. P rv\<rbrace>"
-  apply (wpsimp wp: getObject_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemmas get_wp_rv_only = getObject_wp_rv_only[folded g_def]
-
-\<comment>\<open> Stronger than getObject_inv. \<close>
-lemma getObject_wp_state_only:
-  "\<lbrace>\<lambda>s. obj_at' (\<lambda>_ :: 'a. True) p s \<longrightarrow> P s\<rbrace> getObject p \<lbrace>\<lambda>_ :: 'a. P\<rbrace>"
-  apply (wpsimp wp: getObject_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemmas get_wp_state_only = getObject_wp_state_only[folded g_def]
-
-lemma setObject_no_update:
-  assumes [simp]: "\<And>ko :: 'a. Q (upd ko) = Q ko"
-  shows
-  "\<lbrace>\<lambda>s. P (obj_at' Q p' s) \<and> ko_at' ko p s\<rbrace>
-   setObject p (upd ko)
-   \<lbrace>\<lambda>_ s. P (obj_at' Q p' s)\<rbrace>"
-  apply (wpsimp wp: setObject_obj_at'_strongest)
-  apply (case_tac "p = p'"; clarsimp simp: obj_at'_def)
-  done
-
-lemmas set_no_update = setObject_no_update[folded f_def]
-
-lemmas getObject_ko_at' = getObject_ko_at[OF default_load]
-
-lemmas get_ko_at' = getObject_ko_at'[folded g_def]
-
-lemmas ko_wp_at = setObject_ko_wp_at[where 'a='a, folded f_def,
-                                     simplified default_update, simplified]
-
-lemma setObject_valid_reply':
-  "setObject p (ko :: 'a) \<lbrace>valid_reply' reply'\<rbrace>"
-  unfolding valid_reply'_def valid_bound_obj'_def
-  apply (wpsimp split: option.splits
-                   wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-  apply fastforce
-  done
-
-lemmas set_valid_reply' = setObject_valid_reply'[folded f_def]
-
-lemma setObject_ko_at':
-  "\<lbrace>\<lambda>s. obj_at' (\<lambda>_ :: 'a. True) p s \<longrightarrow>
-          (p = p' \<longrightarrow> P (ko = ko')) \<and>
-          (p \<noteq> p' \<longrightarrow> P (ko_at' ko' p' s))\<rbrace>
-   setObject p (ko :: 'a)
-   \<lbrace>\<lambda>_ s. P (ko_at' (ko' :: 'a) p' s)\<rbrace>"
-  apply (wpsimp wp: obj_at'_strongest[unfolded f_def])
-  apply (case_tac "p = p'"; clarsimp simp: obj_at'_def)
-  done
-
-lemmas set_ko_at' = setObject_ko_at'[folded f_def]
-
-end
-
-locale simple_non_tcb_ko' = simple_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                                       "g:: obj_ref \<Rightarrow> 'a kernel" for f g +
-  assumes not_tcb: "projectKO_opt (KOTCB sc) = (None :: 'a option)"
-begin
-
-lemma updateObject_tcb[simp]:
-  "fst (updateObject (v::'a) (KOTCB tcb) p x n s) = {}"
-  by (clarsimp simp: default_update updateObject_default_def in_monad projectKOs not_tcb bind_def)
-
-lemma not_inject_tcb[simp]:
-  "injectKO (v::'a) \<noteq> KOTCB tcb"
-  by (simp flip: project_inject add: projectKOs not_tcb)
-
-lemma typeOf_not_tcb[simp]:
-  "koTypeOf (injectKO (v::'a)) \<noteq> TCBT"
-  by (cases "injectKO v"; simp)
-
-lemma cte_wp_at'[wp]: "f p v \<lbrace>\<lambda>s. P (cte_wp_at' Q p' s)\<rbrace>"
-  unfolding f_def by (rule setObject_cte_wp_at2'[where Q="\<top>", simplified]; simp)
-
-lemma ctes_of[wp]: "f p v \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
-  unfolding f_def by (rule setObject_ctes_of[where Q="\<top>", simplified]; simp)
-
-lemma valid_mdb'[wp]: "f p v \<lbrace>valid_mdb'\<rbrace>"
-  unfolding valid_mdb'_def by wp
-
-lemma obj_at_tcb'[wp]:
-  "f p v \<lbrace>\<lambda>s. P (obj_at' (Q :: tcb \<Rightarrow> bool) p' s)\<rbrace>"
-  unfolding f_def obj_at'_real_def
-  apply (wp setObject_ko_wp_at; simp add: default_update)
-  apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
-  apply (case_tac ko; simp add: projectKOs not_tcb)
-  done
-
-lemma valid_queues[wp]:
-  "f p v \<lbrace> valid_queues \<rbrace>"
-  unfolding valid_queues_def valid_queues_no_bitmap_def
-  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_ball_lift |wps)+
-
-lemma valid_inQ_queues[wp]:
-  "f p v \<lbrace> valid_inQ_queues \<rbrace>"
-  unfolding valid_inQ_queues_def
-  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_ball_lift | wps)+
-
-lemma set_non_tcb_valid_queues'[wp]:
-  "f p v \<lbrace>valid_queues'\<rbrace>"
-  unfolding valid_queues'_def
-  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift)
-
-lemma set_non_tcb_valid_release_queue[wp]:
-  "f p v \<lbrace>valid_release_queue\<rbrace>"
-  unfolding valid_release_queue_def
-  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift | wps)+
-
-lemma set_non_tcb_valid_release_queue'[wp]:
-  "f p v \<lbrace>valid_release_queue'\<rbrace>"
-  unfolding valid_release_queue'_def
-  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift | wps)+
-
-lemma tcb_in_cur_domain'[wp]:
-  "f p v \<lbrace>tcb_in_cur_domain' t\<rbrace>"
-  by (rule tcb_in_cur_domain'_lift; wp)
-
-lemma pred_tcb_at'[wp]:
-  "f p v \<lbrace> \<lambda>s. Q (pred_tcb_at' proj P t s) \<rbrace>"
-  unfolding pred_tcb_at'_def by wp
-
-lemma sch_act_wf[wp]:
-  "f p v \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (wp sch_act_wf_lift)
-
-lemma cur_tcb'[wp]:
-  "f p v \<lbrace>cur_tcb'\<rbrace>"
-  by (wp cur_tcb_lift)
-
-lemma cap_to'[wp]:
-  "f p' v \<lbrace>ex_nonz_cap_to' p\<rbrace>"
-  by (wp ex_nonz_cap_to_pres')
-
-lemma ifunsafe'[wp]:
-  "f p v \<lbrace>if_unsafe_then_cap'\<rbrace>"
-  unfolding f_def
-  apply (rule setObject_ifunsafe'[where P="\<top>", simplified])
-    apply (clarsimp simp: default_update updateObject_default_def in_monad projectKOs not_tcb
-                          not_cte
-                  intro!: equals0I)+
-  apply (simp add: setObject_def split_def default_update)
-  apply (wp updateObject_default_inv | simp)+
-  done
-
-lemmas irq_handlers[wp] = valid_irq_handlers_lift'' [OF ctes_of ksInterruptState]
-lemmas irq_handlers'[wp] = valid_irq_handlers_lift'' [OF ctes_of ksInterruptState]
-
-lemma valid_global_refs'[wp]:
-  "f p v \<lbrace>valid_global_refs'\<rbrace>"
-  by (rule valid_global_refs_lift'; wp)
-
-lemma ct_not_inQ[wp]:
-  "f p v \<lbrace>ct_not_inQ\<rbrace>"
-  apply (rule ct_not_inQ_lift, wp)
-  apply (rule hoare_lift_Pf[where f=ksCurThread]; wp)
-  done
-
-lemma ct_idle_or_in_cur_domain'[wp]:
-  "f p v \<lbrace> ct_idle_or_in_cur_domain' \<rbrace>"
-  by (rule ct_idle_or_in_cur_domain'_lift; wp)
-
-lemma untyped_ranges_zero'[wp]:
-  "f p ko \<lbrace>untyped_ranges_zero'\<rbrace>"
-  unfolding cteCaps_of_def o_def
-  apply (wpsimp wp: untyped_ranges_zero_lift)
-  done
-
-end
-
-locale simple_non_reply_ko' = simple_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                                         "g:: obj_ref \<Rightarrow> 'a kernel" for f g +
-  assumes not_reply: "projectKO_opt (KOReply reply) = (None :: 'a option)"
-begin
-
-lemma updateObject_reply[simp]:
-  "fst (updateObject (v::'a) (KOReply c) p x n s) = {}"
-  by (clarsimp simp: default_update updateObject_default_def in_monad projectKOs not_reply bind_def)
-
-lemma not_inject_reply[simp]:
-  "injectKO (v::'a) \<noteq> KOReply sc"
-  by (simp flip: project_inject add: projectKOs not_reply)
-
-lemma typeOf_not_reply[simp]:
-  "koTypeOf (injectKO (v::'a)) \<noteq> ReplyT"
-  by (cases "injectKO v"; simp)
-
-end
-
-locale simple_non_tcb_non_reply_ko' =
-   simple_non_reply_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                        "g:: obj_ref \<Rightarrow> 'a kernel" +
-   simple_non_tcb_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                      "g:: obj_ref \<Rightarrow> 'a kernel" for f g
-begin
-
-\<comment>\<open>
-  preservation of valid_replies' requires us to not be touching either of a Reply or a TCB
-\<close>
-
-lemma valid_replies'[wp]:
-  "\<lbrace>valid_replies' and pspace_distinct' and pspace_aligned'\<rbrace>
-   f p v
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-   (is "\<lbrace>?pre valid_replies'\<rbrace> _ \<lbrace>?post\<rbrace>")
-  apply (rule_tac Q'="\<lambda>_. ?pre valid_replies'_alt" in hoare_post_imp;
-         clarsimp simp: valid_replies'_def2)
-  unfolding obj_at'_real_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift ko_wp_at hoare_vcg_ex_lift)
-  by (fastforce simp: valid_replies'_def2 obj_at'_def ko_wp_at'_def projectKOs)
-
-lemma valid_pspace':
-  "\<lbrace>valid_pspace' and valid_obj' (injectKO v) \<rbrace> f p v \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
-  unfolding valid_pspace'_def by (wpsimp wp: valid_objs')
-
-end
-
-locale simple_non_sc_ko' = simple_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                                      "g:: obj_ref \<Rightarrow> 'a kernel" for f g +
-  assumes not_sc: "projectKO_opt (KOSchedContext sc) = (None :: 'a option)"
-begin
-
-lemma updateObject_sc[simp]:
-  "fst (updateObject (v::'a) (KOSchedContext c) p x n s) = {}"
-  by (clarsimp simp: default_update updateObject_default_def in_monad projectKOs not_sc bind_def)
-
-lemma not_inject_sc[simp]:
-  "injectKO (v::'a) \<noteq> KOSchedContext sc"
-  by (simp flip: project_inject add: projectKOs not_sc)
-
-lemma typeOf_not_sc[simp]:
-  "koTypeOf (injectKO (v::'a)) \<noteq> SchedContextT"
-  by (cases "injectKO v"; simp)
-
-end
-
-locale simple_non_tcb_non_sc_ko' =
-   simple_non_sc_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                     "g:: obj_ref \<Rightarrow> 'a kernel" +
-   simple_non_tcb_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                      "g:: obj_ref \<Rightarrow> 'a kernel" for f g
-begin
-
-\<comment>\<open>
-  preservation of valid_idle' requires us to not be touching either of an SC or a TCB
-\<close>
-
-lemma idle'[wp]:
-  "f p v \<lbrace>valid_idle'\<rbrace>"
-  unfolding f_def
-  apply (wp setObject_idle'
-         ; simp add: default_update updateObject_default_inv idle_tcb_ps_def idle_sc_ps_def)
-  apply (clarsimp simp: projectKOs)
-  done
-
-end
-
-locale simple_non_tcb_non_sc_non_reply_ko' =
-   simple_non_tcb_non_sc_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                             "g:: obj_ref \<Rightarrow> 'a kernel" +
-   simple_non_tcb_non_reply_ko' "f:: obj_ref \<Rightarrow> 'a::pspace_storable \<Rightarrow> unit kernel"
-                             "g:: obj_ref \<Rightarrow> 'a kernel" for f g
-
-(* FIXME: should these be in Arch + sublocale instead? *)
-interpretation set_ep': simple_non_tcb_non_sc_non_reply_ko' setEndpoint getEndpoint
-  by unfold_locales (simp_all add: setEndpoint_def getEndpoint_def projectKO_opts_defs
-                                   objBits_simps')
-
-interpretation set_ntfn': simple_non_tcb_non_sc_non_reply_ko' setNotification getNotification
-  by unfold_locales (simp_all add: setNotification_def getNotification_def projectKO_opts_defs
-                                   objBits_simps')
-
-interpretation set_reply': simple_non_tcb_non_sc_ko' setReply getReply
-  by unfold_locales (simp_all add: setReply_def getReply_def projectKO_opts_defs objBits_simps')
-
-interpretation set_sc': simple_non_tcb_non_reply_ko' setSchedContext getSchedContext
-  by unfold_locales (simp_all add: setSchedContext_def getSchedContext_def projectKO_opts_defs
-                                   objBits_simps' scBits_pos_power2)
-
-interpretation set_tcb': simple_non_sc_ko' "\<lambda>p v. setObject p (v::tcb)"
-                                           "\<lambda>p. getObject p :: tcb kernel"
-  by unfold_locales (simp_all add: projectKO_opts_defs objBits_simps')
-
-lemma threadSet_pspace_only':
-  "pspace_only' (threadSet f p)"
-  unfolding threadSet_def
-  apply unfold_locales
-  apply (clarsimp simp: in_monad)
-  apply (drule_tac P="(=) s" in use_valid[OF _ getObject_tcb_inv], rule refl)
-  apply (fastforce dest: set_tcb'.pspace)
-  done
-
-interpretation threadSet: pspace_only' "threadSet f p"
-  by (simp add: threadSet_pspace_only')
-
-interpretation setBoundNotification: pspace_only' "setBoundNotification ntfnPtr tptr"
-  by (simp add: setBoundNotification_def threadSet_pspace_only')
-
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemmas setNotification_cap_to'[wp]
-    = ex_cte_cap_to'_pres [OF set_ntfn'.cte_wp_at' set_ntfn'.ksInterruptState]
-
-lemmas setEndpoint_cap_to'[wp]
-    = ex_cte_cap_to'_pres [OF set_ep'.cte_wp_at' set_ep'.ksInterruptState]
-
-lemmas setEndpoint_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_ep'.ctes_of]
-lemmas setNotification_cteCaps_of[wp] = ctes_of_cteCaps_of_lift [OF set_ntfn'.ctes_of]
-
-(* aliases for compatibility with master *)
-
-lemmas setObject_ep_pre = set_ep'.setObject_pre
-lemmas setObject_ntfn_pre = set_ntfn'.setObject_pre
-lemmas setObject_tcb_pre = set_tcb'.setObject_pre
-lemmas setObject_reply_pre = set_reply'.setObject_pre
-lemmas setObject_sched_context_pre = set_sc'.setObject_pre
-
-lemmas getEndpoint_wp = set_ep'.get_wp
-lemmas getNotification_wp = set_ntfn'.get_wp
-lemmas getTCB_wp = set_tcb'.get_wp
-lemmas getReply_wp[wp] = set_reply'.get_wp
-lemmas getSchedContext_wp[wp] = set_sc'.get_wp
-
-lemmas getEndpoint_wp' = set_ep'.get_wp'
-lemmas getNotification_wp' = set_ntfn'.get_wp'
-lemmas getTCB_wp' = set_tcb'.get_wp'
-lemmas getReply_wp' = set_reply'.get_wp'
-lemmas getSchedContext_wp' = set_sc'.get_wp'
-
-lemmas getObject_ep_inv = set_ep'.getObject_inv
-lemmas getObject_ntfn_inv = set_ntfn'.getObject_inv
-lemmas getObject_reply_inv = set_reply'.getObject_inv
-lemmas getObject_sc_inv = set_sc'.getObject_inv
-(* FIXME RT: the one below is deferred because it requires to
-   move the simple_ko' locale at the beginning of this theory
-   which turns out to be quite a lot more work *)
-(*lemmas getObject_tcb_inv = set_tcb'.getObject_inv*)
-
-lemmas get_ep_inv'[wp] = set_ep'.get_inv
-lemmas get_ntfn_inv'[wp] = set_ntfn'.get_inv
-lemmas get_tcb_inv' = set_tcb'.get_inv
-lemmas get_reply_inv' = set_reply'.get_inv
-lemmas get_sc_inv' = set_sc'.get_inv
-
-lemmas get_ep_sp' = set_ep'.getObject_sp'
-lemmas get_ntfn_sp' = set_ntfn'.getObject_sp'
-lemmas get_tcb_sp' = set_tcb'.getObject_sp'
-lemmas get_reply_sp' = set_reply'.getObject_sp'
-lemmas get_sc_sp' = set_sc'.getObject_sp'
-
-lemmas setObject_tcb_wp = set_tcb'.setObject_wp
-lemmas setObject_sc_wp = set_sc'.setObject_wp
-lemmas setObject_tcb_obj_at'_strongest = set_tcb'.setObject_obj_at'_strongest
-
-lemmas set_ep_valid_objs'[wp] =
-  set_ep'.valid_objs'[simplified valid_obj'_def pred_conj_def, simplified]
-lemmas set_ep_valid_pspace'[wp] =
-  set_ep'.valid_pspace'[simplified valid_obj'_def pred_conj_def, simplified]
-
-lemmas set_ntfn_valid_objs'[wp] =
-  set_ntfn'.valid_objs'[simplified valid_obj'_def pred_conj_def, simplified]
-lemmas set_ntfn_valid_pspace'[wp] =
-  set_ntfn'.valid_pspace'[simplified valid_obj'_def pred_conj_def, simplified]
-
-lemmas set_reply_valid_objs'[wp] =
-  set_reply'.valid_objs'[simplified valid_obj'_def pred_conj_def, simplified]
-
-lemmas set_sc_valid_objs'[wp] =
-  set_sc'.valid_objs'[simplified valid_obj'_def pred_conj_def, simplified]
-lemmas set_sc_valid_pspace'[wp] =
-  set_sc'.valid_pspace'[simplified valid_obj'_def pred_conj_def, simplified]
-
-lemma set_ep_state_refs_of'[wp]:
-  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (p := ep_q_refs_of' ep))\<rbrace>
-     setEndpoint p ep
-   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
-  by (wp set_ep'.state_refs_of') (simp flip: fun_upd_def)
-
-lemma set_ntfn_state_refs_of'[wp]:
-  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (p := ntfn_q_refs_of' (ntfnObj ntfn) \<union>
-                                    get_refs NTFNBound (ntfnBoundTCB ntfn) \<union>
-                                    get_refs NTFNSchedContext (ntfnSc ntfn)))\<rbrace>
-     setNotification p ntfn
-   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
-  by (wp set_ntfn'.state_refs_of') (simp flip: fun_upd_def)
-
-lemma setSchedContext_state_refs_of'[wp]:
-  "\<lbrace>\<lambda>s. P ((state_refs_of' s)(p := get_refs SCNtfn (scNtfn sc) \<union>
-                                   get_refs SCTcb (scTCB sc) \<union>
-                                   get_refs SCYieldFrom (scYieldFrom sc) \<union>
-                                   get_refs SCReply (scReply sc)))\<rbrace>
-   setSchedContext p sc
-   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
-  by (wp set_sc'.state_refs_of') (simp flip: fun_upd_def)
-
-lemma setReply_state_refs_of'[wp]:
-  "\<lbrace>\<lambda>s. P ((state_refs_of' s)(p := get_refs ReplySchedContext (replySC reply) \<union>
-                                   get_refs ReplyTCB (replyTCB reply)))\<rbrace>
-   setReply p reply
-   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
-  by (wp set_reply'.state_refs_of') (simp flip: fun_upd_def)
-
-lemma setReply_reply_projs[wp]:
-  "\<lbrace>\<lambda>s. P ((replyNexts_of s)(rptr := replyNext_of reply))
-          ((replyPrevs_of s)(rptr := replyPrev reply))
-          ((replyTCBs_of s)(rptr := replyTCB reply))
-          ((replySCs_of s)(rptr := replySC reply))\<rbrace>
-   setReply rptr reply
-   \<lbrace>\<lambda>_ s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)\<rbrace>"
-  apply (wpsimp simp: setReply_def updateObject_default_def setObject_def split_def)
-  apply (erule rsubst4[where P=P])
-     apply (clarsimp simp: ext opt_map_def list_refs_of_reply'_def map_set_def projectKO_opt_reply
-                    split: option.splits)+
-  done
-
-lemma updateReply_wp_all:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko rptr s \<longrightarrow> P (set_obj' rptr (upd ko) s)\<rbrace>
-   updateReply rptr upd
-   \<lbrace>\<lambda>_. P\<rbrace>"
-  unfolding updateReply_def
-  apply (wpsimp wp: set_reply'.set_wp)
-  done
-
-lemma setSchedContext_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and (\<lambda>s. live_sc' sc \<longrightarrow> ex_nonz_cap_to' p s)\<rbrace>
-   setSchedContext p sc
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  unfolding setSchedContext_def
-  by (wpsimp wp: setObject_iflive'[where P="\<top>"]
-           simp: updateObject_default_def in_monad scBits_pos_power2
-                 projectKOs objBits_simps' bind_def
-     |simp)+
-
-lemma setReply_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' p\<rbrace>
-   setReply p reply
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  unfolding setReply_def
-  by (wpsimp wp: setObject_iflive'[where P="\<top>"]
-           simp: updateObject_default_def in_monad
-                 projectKOs objBits_simps' bind_def
-     |simp)+
-
-lemma setEndpoint_iflive'[wp]:
-  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
-      \<and> (v \<noteq> IdleEP \<longrightarrow> ex_nonz_cap_to' p s)\<rbrace>
-   setEndpoint p v
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  unfolding setEndpoint_def
-  by (wpsimp wp: setObject_iflive'[where P="\<top>"]
-           simp: updateObject_default_def in_monad
-                 projectKOs objBits_simps' bind_def
-     |simp)+
-
-lemma setReply_list_refs_of_replies'[wp]:
-  "\<lbrace>\<lambda>s. P ((list_refs_of_replies' s)(p := list_refs_of_reply' reply))\<rbrace>
-   setReply p reply
-   \<lbrace>\<lambda>rv s. P (list_refs_of_replies' s)\<rbrace>"
-  apply (wpsimp simp: setReply_def updateObject_default_def setObject_def split_def)
-  apply (erule arg_cong[where f=P, THEN iffD1, rotated])
-  apply (clarsimp simp: opt_map_def sym_refs_def fun_upd_def list_refs_of_reply'_def
-                        map_set_def projectKO_opt_reply)
-  apply (rule ext)
-  apply (clarsimp simp: projectKO_opt_reply list_refs_of_reply'_def)
-  done
-
-lemma setObject_ksPSpace_only:
-  "\<lbrakk> \<And>p q n ko. \<lbrace>P\<rbrace> updateObject val p q n ko \<lbrace>\<lambda>rv. P \<rbrace>;
-        \<And>f s. P (ksPSpace_update f s) = P s \<rbrakk>
-     \<Longrightarrow> \<lbrace>P\<rbrace> setObject ptr val \<lbrace>\<lambda>rv. P\<rbrace>"
-  apply (simp add: setObject_def split_def)
-  apply (wp | simp | assumption)+
-  done
-
-lemma setObject_ksMachine:
-  "\<lbrakk> \<And>p q n ko. \<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> updateObject val p q n ko \<lbrace>\<lambda>rv s. P (ksMachineState s)\<rbrace> \<rbrakk>
-     \<Longrightarrow> \<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> setObject ptr val \<lbrace>\<lambda>rv s. P (ksMachineState s)\<rbrace>"
-  by (simp add: setObject_ksPSpace_only)
-
-lemma setObject_ksInterrupt:
-  "\<lbrakk> \<And>p q n ko. \<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> updateObject val p q n ko \<lbrace>\<lambda>rv s. P (ksInterruptState s)\<rbrace> \<rbrakk>
-     \<Longrightarrow> \<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> setObject ptr val \<lbrace>\<lambda>rv s. P (ksInterruptState s)\<rbrace>"
-  by (simp add: setObject_ksPSpace_only)
-
-
-lemma set_ntfn_iflive'[wp]:
-  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
-      \<and> (live' (KONotification v) \<longrightarrow> ex_nonz_cap_to' p s)\<rbrace>
-     setNotification p v
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: setNotification_def)
-  apply (wp setObject_iflive'[where P="\<top>"])
-     apply simp
-    apply (simp add: objBits_simps)
-    apply (clarsimp simp: updateObject_default_def in_monad projectKOs)
-   apply (clarsimp simp: updateObject_default_def in_monad
-                         projectKOs bind_def)
-  apply clarsimp
-  done
+lemmas set_ntfn_irq_states' [wp] = valid_irq_states_lift' [OF set_ntfn_ksInterrupt set_ntfn_ksMachine]
 
 lemma valid_pde_mappings'_def2:
   "valid_pde_mappings' =
@@ -3042,45 +1978,81 @@ lemma set_ntfn_valid_pde_mappings'[wp]:
   apply (clarsimp simp: updateObject_default_def in_monad)
   done
 
-lemma setObject_tcb_pre':
-  "\<lbrace>P and tcb_at' p\<rbrace> setObject p (t::tcb) \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> setObject p (t::tcb) \<lbrace>Q\<rbrace>"
-  apply (rule setObject_tcb_pre)
-  apply (clarsimp simp: valid_def setObject_def in_monad
-                        split_def updateObject_default_def
-                        projectKOs in_magnitude_check objBits_simps')
+lemma set_ntfn_vms'[wp]:
+  "\<lbrace>valid_machine_state'\<rbrace> setNotification ptr val \<lbrace>\<lambda>rv. valid_machine_state'\<rbrace>"
+  apply (simp add: setNotification_def valid_machine_state'_def pointerInDeviceData_def pointerInUserData_def)
+  apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift)
+  by (wp setObject_typ_at_inv setObject_ksMachine updateObject_default_inv |
+      simp)+
+
+lemma irqs_masked_lift:
+  assumes "\<And>P. \<lbrace>\<lambda>s. P (intStateIRQTable (ksInterruptState s))\<rbrace> f
+               \<lbrace>\<lambda>rv s. P (intStateIRQTable (ksInterruptState s))\<rbrace>"
+  shows "\<lbrace>irqs_masked'\<rbrace> f \<lbrace>\<lambda>_. irqs_masked'\<rbrace>"
+  apply (simp add: irqs_masked'_def)
+  apply (wp assms)
   done
 
-lemma setObject_at_pre_default:
-  assumes pre: "\<lbrace>P and obj_at' (\<lambda>_::'a. True) p\<rbrace> setObject p (v::'a::pspace_storable) \<lbrace>Q\<rbrace>"
-  assumes R: "\<And>ko s y n. updateObject v ko p y n s = updateObject_default v ko p y n s"
-  shows "\<lbrace>P\<rbrace> setObject p v \<lbrace>Q\<rbrace>"
-  using pre
-  apply (clarsimp simp: valid_def setObject_def in_monad R
-                        split_def updateObject_default_def
-                        projectKOs in_magnitude_check split_paired_Ball)
-  apply (drule spec, drule mp, erule conjI)
-   apply (simp add: obj_at'_def projectKOs objBits_def project_inject)
-   apply metis
-  apply (simp add: split_paired_Ball)
-  apply (drule spec, erule mp)
-  apply (clarsimp simp: in_monad projectKOs in_magnitude_check)
+lemma setObject_pspace_domain_valid[wp]:
+  "\<lbrace>pspace_domain_valid\<rbrace>
+    setObject ptr val
+   \<lbrace>\<lambda>rv. pspace_domain_valid\<rbrace>"
+  apply (clarsimp simp: setObject_def split_def pspace_domain_valid_def
+                        valid_def in_monad
+                 split: if_split_asm)
+  apply (drule updateObject_objBitsKO)
+  apply (clarsimp simp: lookupAround2_char1)
+  done
+
+crunch setNotification, setEndpoint
+  for pspace_domain_valid[wp]: "pspace_domain_valid"
+
+lemma ct_not_inQ_lift:
+  assumes sch_act: "\<And>P. \<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksSchedulerAction s)\<rbrace>"
+      and not_inQ: "\<lbrace>\<lambda>s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>
+                    f \<lbrace>\<lambda>_ s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>"
+  shows "\<lbrace>ct_not_inQ\<rbrace> f \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+  unfolding ct_not_inQ_def
+  by (rule hoare_convert_imp [OF sch_act not_inQ])
+
+lemma setNotification_ct_not_inQ[wp]:
+  "\<lbrace>ct_not_inQ\<rbrace> setNotification ptr rval \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+  apply (rule ct_not_inQ_lift [OF setNotification_nosch])
+  apply (simp add: setNotification_def ct_not_inQ_def)
+  apply (rule hoare_weaken_pre)
+  apply (wps setObject_ntfn_ct)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_default_def in_monad)+
+  done
+
+lemma setNotification_ksCurThread[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setNotification a b \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: setNotification_def setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
   done
 
-lemma setObject_pspace_no_overlap':
-  assumes R: "\<And>ko s y n. updateObject v ko p y n s = updateObject_default v ko p y n s"
-  shows "setObject p (v::'a::pspace_storable) \<lbrace>pspace_no_overlap' w s\<rbrace>"
-  apply (clarsimp simp: setObject_def split_def valid_def in_monad R objBits_def
-                        updateObject_default_def in_monad projectKOs in_magnitude_check)
-  apply (fastforce simp: pspace_no_overlap'_def project_inject)
+lemma setNotification_ksDomSchedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> setNotification a b \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
+  apply (simp add: setNotification_def setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
   done
 
-lemma setObject_tcb_pspace_no_overlap':
-  "setObject t (tcb::tcb) \<lbrace>pspace_no_overlap' w s\<rbrace>"
-  apply (rule setObject_pspace_no_overlap')
-  apply (clarsimp simp: setObject_def)
+lemma setNotification_ksDomScheduleId[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setNotification a b \<lbrace>\<lambda>rv s. P (ksDomScheduleIdx s)\<rbrace>"
+  apply (simp add: setNotification_def setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
   done
 
-end
+lemma setNotification_ct_idle_or_in_cur_domain'[wp]:
+  "\<lbrace> ct_idle_or_in_cur_domain' \<rbrace> setNotification ptr ntfn \<lbrace> \<lambda>_. ct_idle_or_in_cur_domain' \<rbrace>"
+  apply (rule ct_idle_or_in_cur_domain'_lift)
+  apply (wp hoare_vcg_disj_lift| rule obj_at_setObject2
+           | clarsimp simp: updateObject_default_def in_monad setNotification_def)+
+  done
+
+crunch setNotification
+  for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  (wp: setObject_ksPSpace_only updateObject_default_inv)
 
 lemma sym_heap_sched_pointers_lift:
   assumes prevs: "\<And>P. f \<lbrace>\<lambda>s. P (tcbSchedPrevs_of s)\<rbrace>"
@@ -3098,14 +2070,35 @@ crunch setNotification
   (simp: updateObject_default_def)
 
 lemma set_ntfn_minor_invs':
-  "\<lbrace>invs'
-      and valid_ntfn' val
-      and (\<lambda>s. live' (KONotification val) \<longrightarrow> ex_nonz_cap_to' ptr s)\<rbrace>
-   setNotification ptr val
+  "\<lbrace>invs' and obj_at' (\<lambda>ntfn. ntfn_q_refs_of' (ntfnObj ntfn) = ntfn_q_refs_of' (ntfnObj val)
+                           \<and> ntfn_bound_refs' (ntfnBoundTCB ntfn) = ntfn_bound_refs' (ntfnBoundTCB val))
+                       ptr
+         and valid_ntfn' val
+         and (\<lambda>s. live' (KONotification val) \<longrightarrow> ex_nonz_cap_to' ptr s)
+         and (\<lambda>s. ptr \<noteq> ksIdleThread s) \<rbrace>
+     setNotification ptr val
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (clarsimp simp add: invs'_def cteCaps_of_def valid_dom_schedule'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def cteCaps_of_def)
   apply (wpsimp wp: irqs_masked_lift valid_irq_node_lift untyped_ranges_zero_lift
+                    sym_heap_sched_pointers_lift valid_bitmaps_lift
               simp: o_def)
+  apply (clarsimp elim!: rsubst[where P=sym_refs]
+                 intro!: ext
+                  dest!: obj_at_state_refs_ofD')+
+  done
+
+lemma getEndpoint_wp:
+  "\<lbrace>\<lambda>s. \<forall>ep. ko_at' ep e s \<longrightarrow> P ep s\<rbrace> getEndpoint e \<lbrace>P\<rbrace>"
+  apply (rule hoare_strengthen_post)
+   apply (rule get_ep_sp')
+  apply simp
+  done
+
+lemma getNotification_wp:
+  "\<lbrace>\<lambda>s. \<forall>ntfn. ko_at' ntfn e s \<longrightarrow> P ntfn s\<rbrace> getNotification e \<lbrace>P\<rbrace>"
+  apply (rule hoare_strengthen_post)
+   apply (rule get_ntfn_sp')
+  apply simp
   done
 
 lemma ep_redux_simps':
@@ -3116,11 +2109,9 @@ lemma ep_redux_simps':
   "ntfn_q_refs_of' (case xs of [] \<Rightarrow> IdleNtfn | y # ys \<Rightarrow> WaitingNtfn xs)
         = (set xs \<times> {NTFNSignal})"
   by (fastforce split: list.splits
-                simp: valid_ep_def valid_ntfn_def)+
+                simp: valid_ep_def valid_ntfn_def
+              intro!: ext)+
 
-lemma endpoint_live':
-  "\<lbrakk>ko_at' ep ptr s; ep \<noteq> IdleEP\<rbrakk> \<Longrightarrow> ko_wp_at' live' ptr s"
-  by (clarsimp simp: ko_wp_at'_def obj_at'_def projectKOs)
 
 (* There are two wp rules for preserving valid_ioc over set_object.
    First, the more involved rule for CNodes and TCBs *)
@@ -3133,18 +2124,11 @@ lemma idle_is_global [intro!]:
   "ksIdleThread s \<in> global_refs' s"
   by (simp add: global_refs'_def)
 
-lemma idle_sc_is_global [intro!]:
-  "idle_sc_ptr \<in> global_refs' s"
-  by (simp add: global_refs'_def)
-
 lemma valid_globals_cte_wpD':
-  "\<lbrakk> valid_global_refs' s; cte_wp_at' P p s; ptr \<in> global_refs' s \<rbrakk>
-       \<Longrightarrow> \<exists>cte. P cte \<and> ptr \<notin> capRange (cteCap cte)"
+  "\<lbrakk> valid_global_refs' s; cte_wp_at' P p s \<rbrakk>
+       \<Longrightarrow> \<exists>cte. P cte \<and> ksIdleThread s \<notin> capRange (cteCap cte)"
   by (fastforce simp: valid_global_refs'_def valid_refs'_def  cte_wp_at_ctes_of)
 
-lemmas valid_globals_cte_wpD'_idleThread = valid_globals_cte_wpD'[OF _ _ idle_is_global]
-lemmas valid_globals_cte_wpD'_idleSC = valid_globals_cte_wpD'[OF _ _ idle_sc_is_global]
-
 lemma dmo_aligned'[wp]:
   "\<lbrace>pspace_aligned'\<rbrace> doMachineOp f \<lbrace>\<lambda>_. pspace_aligned'\<rbrace>"
   apply (simp add: doMachineOp_def split_def)
@@ -3178,2043 +2162,76 @@ lemma dmo_inv':
 
 crunch doMachineOp
   for cte_wp_at'2[wp]: "\<lambda>s. P (cte_wp_at' P' p s)"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
 
-global_interpretation doMachineOp: typ_at_all_props' "doMachineOp mop"
-  by typ_at_props'
+crunch doMachineOp
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+
+lemmas doMachineOp_typ_ats[wp] = typ_at_lifts [OF doMachineOp_typ_at']
 
 lemma doMachineOp_invs_bits[wp]:
-  "\<lbrace>valid_pspace'\<rbrace> doMachineOp m \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
-     doMachineOp m \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  "\<lbrace>Invariants_H.valid_queues\<rbrace> doMachineOp m \<lbrace>\<lambda>rv. Invariants_H.valid_queues\<rbrace>"
-  "\<lbrace>valid_queues'\<rbrace> doMachineOp m \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>
-      doMachineOp m
-   \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
-  "\<lbrace>if_live_then_nonz_cap'\<rbrace> doMachineOp m \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  "\<lbrace>cur_tcb'\<rbrace> doMachineOp m \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
-  "\<lbrace>if_unsafe_then_cap'\<rbrace> doMachineOp m \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
-  "\<lbrace>sch_act_simple\<rbrace> doMachineOp mop \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
-  by (simp add: doMachineOp_def split_def sch_act_simple_def
-       | wp cur_tcb_lift sch_act_wf_lift tcb_in_cur_domain'_lift
-       | fastforce elim: state_refs_of'_pspaceI)+
+  "doMachineOp m \<lbrace>valid_pspace'\<rbrace>"
+  "doMachineOp m \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  "doMachineOp m \<lbrace>valid_bitmaps\<rbrace>"
+  "doMachineOp m \<lbrace>valid_sched_pointers\<rbrace>"
+  "doMachineOp m \<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>"
+  "doMachineOp m \<lbrace>if_live_then_nonz_cap'\<rbrace>"
+  "doMachineOp m \<lbrace>cur_tcb'\<rbrace>"
+  "doMachineOp m \<lbrace>if_unsafe_then_cap'\<rbrace>"
+  by (simp add: doMachineOp_def split_def
+      | wp
+      | fastforce elim: state_refs_of'_pspaceI)+
 
+crunch doMachineOp
+  for cte_wp_at'[wp]: "\<lambda>s. P (cte_wp_at' P' p s)"
 crunch doMachineOp
   for obj_at'[wp]: "\<lambda>s. P (obj_at' P' p s)"
-  and it[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and idle'[wp]: "valid_idle'"
-  and pde_mappings'[wp]: "valid_pde_mappings'"
-  and ko_wp_at'[wp]: "\<lambda>s. P (ko_wp_at' T p s)"
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemmas bit_simps' = pteBits_def asidHighBits_def asid_low_bits_def
-                    asid_high_bits_def minSchedContextBits_def
-                    replySizeBits_def pageBits_def pdeBits_def ptBits_def pdBits_def
-
-lemmas is_aligned_add_step_le' = is_aligned_add_step_le[simplified mask_2pm1 add_diff_eq]
-
-lemma objBitsKO_Data:
-  "objBitsKO (if dev then KOUserDataDevice else KOUserData) = pageBits"
-  by (simp add: objBits_def objBitsKO_def word_size_def)
-
-lemma of_bl_shift_cte_level_bits:
-  "(of_bl z :: machine_word) << cte_level_bits \<le> mask (cte_level_bits + length z)"
-  by word_bitwise
-     (simp add: test_bit_of_bl word_size cte_level_bits_def rev_bl_order_simps)
-
-lemma obj_relation_cuts_range_limit:
-  "\<lbrakk> (p', P) \<in> obj_relation_cuts ko p; P ko ko' \<rbrakk>
-   \<Longrightarrow> \<exists>x n. p' = p + x \<and> is_aligned x n \<and> n \<le> obj_bits ko \<and> x \<le> mask (obj_bits ko)"
-   apply (erule (1) obj_relation_cutsE; clarsimp)
-     apply (drule (1) wf_cs_nD)
-     apply (clarsimp simp: cte_map_def[simplified word_shift_by_n])
-     apply (rule_tac x=cte_level_bits in exI)
-     apply (simp add: is_aligned_shift of_bl_shift_cte_level_bits)
-       apply (rule_tac x=minSchedContextBits in exI)
-       apply (simp add: bit_simps' min_sched_context_bits_def)
-      apply (rule_tac x=replySizeBits in exI)
-      apply (simp add: replySizeBits_def)
-     apply (rule_tac x=pteBits in exI)
-     apply (simp add: bit_simps is_aligned_shift mask_def pteBits_def)
-     apply word_bitwise
-    apply (rule_tac x=pdeBits in exI)
-    apply (simp add: bit_simps is_aligned_shift mask_def pdeBits_def)
-    apply word_bitwise
-   apply (rule_tac x=pageBits in exI)
-   apply (simp add: is_aligned_shift pbfs_atleast_pageBits is_aligned_mult_triv2)
-   apply (simp add: mask_def shiftl_t2n mult_ac)
-   apply (frule word_less_power_trans2, rule pbfs_atleast_pageBits)
-    apply (simp add: pbfs_less_wb'[unfolded word_bits_def, simplified])
-   apply (simp add: pbfs_less_wb'[unfolded word_bits_def, simplified])
-  apply fastforce
-  done
-
-lemma obj_relation_cuts_range_mask_range:
-  "\<lbrakk> (p', P) \<in> obj_relation_cuts ko p; P ko ko'; is_aligned p (obj_bits ko) \<rbrakk>
-   \<Longrightarrow> p' \<in> mask_range p (obj_bits ko)"
-  apply (drule (1) obj_relation_cuts_range_limit, clarsimp)
-  apply (rule conjI)
-   apply (rule word_plus_mono_right2; assumption?)
-   apply (simp add: is_aligned_no_overflow_mask)
-  apply (erule word_plus_mono_right)
-  apply (simp add: is_aligned_no_overflow_mask)
-  done
-
-lemma obj_relation_cuts_obj_bits:
-  "\<lbrakk> (p', P) \<in> obj_relation_cuts ko p; P ko ko' \<rbrakk> \<Longrightarrow> objBitsKO ko' \<le> obj_bits ko"
-  apply (erule (1) obj_relation_cutsE;
-          clarsimp simp: objBits_simps objBits_defs cte_level_bits_def sc_const_eq[symmetric]
-                         pbfs_atleast_pageBits[simplified bit_simps] archObjSize_def pteBits_def
-                         pdeBits_def sc_relation_def)
-  apply (cases ko; simp add: other_obj_relation_def objBits_defs
-                      split: kernel_object.splits)
-  apply (rename_tac ako, case_tac ako; clarsimp)
-  apply (rename_tac ako', case_tac ako'; clarsimp simp: archObjSize_def)
-  done
-
-lemma typ_at'_same_type:
-  assumes "typ_at' T p s" "koTypeOf k = koTypeOf ko" "objBitsKO k = objBitsKO ko" "ksPSpace s p' = Some ko"
-  shows "typ_at' T p (s\<lparr>ksPSpace :=(ksPSpace s)(p' \<mapsto> k)\<rparr>)"
-  using assms
-  by (clarsimp simp: typ_at'_def ko_wp_at'_def ps_clear_upd)
-
-lemma cte_at'_same_type:
-  "\<lbrakk>cte_wp_at' \<top> t s; koTypeOf k = koTypeOf ko;objBitsKO k = objBitsKO ko;
-    ksPSpace s p = Some ko\<rbrakk>
-      \<Longrightarrow> cte_wp_at' \<top> t (s\<lparr>ksPSpace := (ksPSpace s)(p \<mapsto> k)\<rparr>)"
-  apply (simp add: cte_at_typ' typ_at'_same_type)
-  apply (elim exE disjE)
-   apply (rule disjI1, clarsimp simp: typ_at'_same_type)
-  apply (rule disjI2, rule_tac x=n in exI, clarsimp simp: typ_at'_same_type)
-  done
-
-lemma valid_ep'_ep_update:
-  "\<lbrakk> valid_objs' s; valid_ep' ep s; ep_at' epPtr s; ksPSpace s x = Some (KOEndpoint obj) \<rbrakk>
-     \<Longrightarrow> valid_ep' obj (s\<lparr>ksPSpace := (ksPSpace s)(epPtr \<mapsto> KOEndpoint ep)\<rparr>)"
-  apply (erule (1) valid_objsE')
-  apply (fastforce simp: valid_objs'_def valid_obj'_def obj_at'_def projectKOs valid_ep'_def
-                  split: endpoint.splits)
-  done
-
-lemma valid_cap'_ep_update:
-  "\<lbrakk> valid_cap' cap s; valid_objs' s; valid_ep' ep s; ep_at' epPtr s \<rbrakk>
-     \<Longrightarrow> valid_cap' cap (s\<lparr>ksPSpace := (ksPSpace s)(epPtr \<mapsto> KOEndpoint ep)\<rparr>)"
-  supply ps_clear_upd[simp]
-  apply (clarsimp simp: typ_at'_same_type ko_wp_at'_def cte_at'_same_type
-                        valid_cap'_def obj_at'_def projectKOs objBits_simps
-                 split: endpoint.splits capability.splits)
-         apply fastforce+
-       apply (clarsimp split: zombie_type.splits simp: projectKOs obj_at'_def typ_at'_same_type)
-       apply (intro conjI impI; clarsimp)
-        apply (drule_tac x=addr in spec, clarsimp)
-       apply (drule_tac x=addr in spec, clarsimp)
-      apply (clarsimp simp: ko_wp_at'_def valid_cap'_def obj_at'_def projectKOs objBits_simps
-                            page_directory_at'_def page_table_at'_def
-                            ARM_H.arch_capability.distinct ARM_H.arch_capability.inject
-                     split: ARM_H.arch_capability.splits option.splits if_split_asm
-           | rule_tac ko="KOEndpoint obj" in typ_at'_same_type[where p'=epPtr]
-           | simp)+
-     apply fastforce
-    apply (clarsimp simp: valid_untyped'_def ko_wp_at'_def obj_range'_def split: if_split_asm)
-     apply (drule_tac x=epPtr in spec, fastforce simp: objBits_simps)+
-   apply (drule_tac x=addr in spec, fastforce)
-  apply fastforce
-  done
-
-lemma valid_cap'_reply_update:
-  "\<lbrakk> valid_cap' cap s; valid_objs' s; valid_reply' reply s; reply_at' rptr s \<rbrakk>
-     \<Longrightarrow> valid_cap' cap (s\<lparr>ksPSpace := (ksPSpace s)(rptr \<mapsto> KOReply reply)\<rparr>)"
-  supply ps_clear_upd[simp]
-  apply (clarsimp simp: typ_at'_same_type ko_wp_at'_def cte_at'_same_type
-                        valid_cap'_def obj_at'_def projectKOs objBits_simps
-                 split: endpoint.splits capability.splits)
-         apply fastforce+
-      apply (clarsimp split: zombie_type.splits simp: projectKOs obj_at'_def typ_at'_same_type)
-      apply (intro conjI impI; clarsimp)
-       apply (drule_tac x=addr in spec, clarsimp)
-      apply (drule_tac x=addr in spec, clarsimp)
-     apply (clarsimp simp: ko_wp_at'_def valid_cap'_def obj_at'_def projectKOs objBits_simps
-                           page_directory_at'_def page_table_at'_def
-                    split: ARM_H.arch_capability.splits option.splits if_split_asm
-          | rule_tac ko="KOReply obj" in typ_at'_same_type[where p'=rptr])+
-    apply (clarsimp simp: valid_untyped'_def ko_wp_at'_def obj_range'_def split: if_split_asm)
-     apply (drule_tac x=rptr in spec, fastforce simp: objBits_simps)+
-   apply (drule_tac x=addr in spec, fastforce)
-  apply fastforce
-  done
-
-lemma valid_tcb_state'_ep_update:
-  "\<lbrakk> valid_objs' s; valid_ep' ep s; ep_at' epPtr s;  ksPSpace s x = Some (KOTCB obj) \<rbrakk>
-     \<Longrightarrow> valid_tcb_state' (tcbState obj) (s\<lparr>ksPSpace := (ksPSpace s)(epPtr \<mapsto> KOEndpoint ep)\<rparr>)"
-  apply (rule valid_objsE', simp, simp)
-  by (fastforce simp: typ_at'_same_type ps_clear_upd objBits_simps valid_obj'_def projectKOs
-                      valid_tcb_state'_def valid_bound_obj'_def valid_tcb'_def obj_at'_def
-               split: option.splits thread_state.splits)
-
-lemma valid_tcb_state'_reply_update:
-  "\<lbrakk> valid_objs' s; valid_reply' reply s; reply_at' rptr s; ksPSpace s x = Some (KOTCB obj) \<rbrakk>
-     \<Longrightarrow> valid_tcb_state' (tcbState obj) (s\<lparr>ksPSpace := (ksPSpace s)(rptr \<mapsto> KOReply reply)\<rparr>)"
-  apply (rule valid_objsE', simp, simp)
-  by (fastforce simp: typ_at'_same_type ps_clear_upd objBits_simps valid_obj'_def projectKOs
-                      valid_bound_obj'_def valid_tcb'_def valid_tcb_state'_def obj_at'_def
-               split: option.splits thread_state.splits)
-
-lemma valid_tcb'_ep_update:
-  "\<lbrakk> valid_objs' s; valid_ep' ep s; ep_at' epPtr s; ksPSpace s x = Some (KOTCB obj) \<rbrakk>
-     \<Longrightarrow> valid_tcb' obj (s\<lparr>ksPSpace := (ksPSpace s)(epPtr \<mapsto> KOEndpoint ep)\<rparr>)"
-  apply (rule valid_objsE', simp, simp)
-  by (fastforce simp: typ_at'_same_type ps_clear_upd objBits_simps valid_obj'_def projectKOs
-                      valid_bound_obj'_def valid_tcb'_def obj_at'_def valid_tcb_state'_ep_update
-                      valid_cap'_ep_update
-              split: option.splits thread_state.splits)
-
-lemma valid_arch_obj'_ep_update:
-  "\<lbrakk> valid_objs' s; valid_ep' ep s; ep_at' epPtr s; ksPSpace s x = Some (KOArch obj) \<rbrakk>
-     \<Longrightarrow> valid_arch_obj' obj (s\<lparr>ksPSpace := (ksPSpace s)(epPtr \<mapsto> KOEndpoint ep)\<rparr>)"
-  apply (rule valid_objsE', simp, simp)
-  apply (cases obj; clarsimp simp: valid_arch_obj'_def valid_obj'_def obj_at'_def projectKOs
-                            split: arch_kernel_object.splits)
-    apply (rename_tac asid ep', case_tac asid, simp)
-   apply (rename_tac pte ep', case_tac pte; simp add: valid_mapping'_def)
-  apply (rename_tac pde ep', case_tac pde; simp add: valid_mapping'_def)
-  done
-
-lemma valid_arch_obj'_reply_update:
-  "\<lbrakk> valid_objs' s; valid_reply' reply s; reply_at' rptr s; ksPSpace s x = Some (KOArch obj) \<rbrakk>
-     \<Longrightarrow> valid_arch_obj' obj (s\<lparr>ksPSpace := (ksPSpace s)(rptr \<mapsto> KOReply reply)\<rparr>)"
-  supply ps_clear_upd[simp]
-  apply (rule valid_objsE', simp, simp)
-  apply (cases obj; clarsimp simp: valid_arch_obj'_def valid_obj'_def obj_at'_def projectKOs
-                            split: arch_kernel_object.splits)
-    apply (rename_tac asid reply', case_tac asid, simp)
-   apply (rename_tac pte reply', case_tac pte; simp add: valid_mapping'_def)
-  apply (rename_tac pde reply', case_tac pde; simp add: valid_mapping'_def)
-  done
 
-end
+crunch doMachineOp
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+crunch doMachineOp
+  for idle'[wp]: "valid_idle'"
+  (wp: crunch_wps simp: crunch_simps valid_idle'_pspace_itI)
+crunch doMachineOp
+  for pde_mappings'[wp]: "valid_pde_mappings'"
 
-lemma valid_obj'_ep_update:
-  "\<lbrakk> valid_objs' s; valid_ep' ep s; ep_at' epPtr s; ksPSpace s x = Some obj\<rbrakk>
-       \<Longrightarrow> valid_obj' obj (s\<lparr>ksPSpace := (ksPSpace s)(epPtr \<mapsto> KOEndpoint ep)\<rparr>)"
-  apply (rule valid_objsE', simp, simp)
-  by (cases obj;
-      clarsimp simp: typ_at'_same_type valid_obj'_def obj_at'_def ps_clear_upd
-                     valid_ntfn'_def  valid_bound_obj'_def valid_reply'_def valid_cte'_def
-                     valid_sched_context'_def objBits_simps projectKOs valid_cap'_ep_update
-                     valid_arch_obj'_ep_update valid_ep'_ep_update valid_tcb'_ep_update
-              split: endpoint.splits ntfn.splits option.splits)
-     fastforce+
-
-lemma valid_obj'_reply_update:
-  "\<lbrakk> valid_objs' s; valid_reply' reply s; reply_at' rptr s; ksPSpace s x = Some obj \<rbrakk>
-     \<Longrightarrow> valid_obj' obj (s\<lparr>ksPSpace := (ksPSpace s)(rptr \<mapsto> KOReply reply)\<rparr>)"
-  apply (rule valid_objsE', simp, simp)
-  apply (cases obj; clarsimp simp: valid_obj'_def)
-        apply (fastforce simp: valid_ep'_def obj_at'_def projectKOs split: endpoint.split)
-       apply (fastforce simp: valid_bound_obj'_def valid_ntfn'_def obj_at'_def projectKOs
-                       split: ntfn.splits option.split)
-      apply (fastforce simp: valid_bound_obj'_def valid_tcb'_def valid_tcb_state'_reply_update
-                             valid_cap'_reply_update obj_at'_def projectKOs tcb_cte_cases_def
-                      split: option.split)
-     apply (fastforce simp: valid_cap'_reply_update obj_at'_def valid_cte'_def projectKOs)
-    apply (fastforce simp: valid_arch_obj'_reply_update obj_at'_def projectKOs)
-   apply (fastforce simp: valid_sched_context'_def valid_bound_obj'_def objBitsKO_def
-                          obj_at'_def projectKOs ps_clear_upd
-                   split: option.split)
-  apply (fastforce simp: valid_reply'_def valid_bound_obj'_def obj_at'_def projectKOs objBitsKO_def
-                  split: option.split)
-  done
-
-lemma valid_objs'_ep_update:
-  "\<lbrakk> valid_objs' s; valid_ep' ep s; ep_at' epPtr s \<rbrakk>
-     \<Longrightarrow> valid_objs' (s\<lparr>ksPSpace := (ksPSpace s)(epPtr \<mapsto> KOEndpoint ep)\<rparr>)"
-  apply (clarsimp simp: valid_objs'_def obj_at'_def projectKOs)
-  apply (erule ranE)
-  apply (clarsimp simp: ps_clear_upd split: if_split_asm)
-   apply (fastforce simp: valid_obj'_def valid_ep'_def obj_at'_def ps_clear_upd
-                          objBits_simps projectKOs
-                   split: endpoint.splits)
-  apply (fastforce intro!: valid_obj'_ep_update simp: valid_objs'_def obj_at'_def projectKOs)
-  done
-
-lemma valid_objs'_reply_update:
-  "\<lbrakk> valid_objs' s; valid_reply' reply s; reply_at' rptr s \<rbrakk>
-     \<Longrightarrow> valid_objs' (s\<lparr>ksPSpace := (ksPSpace s)(rptr \<mapsto> KOReply reply)\<rparr>)"
-  apply (clarsimp simp: valid_objs'_def obj_at'_def projectKOs)
-  apply (erule ranE)
-  apply (clarsimp split: if_split_asm)
-   apply (fastforce simp: valid_bound_obj'_def valid_obj'_def valid_reply'_def
-                          obj_at'_def projectKOs objBitsKO_def
-                   split: option.splits)
-  apply (fastforce intro!: valid_obj'_reply_update simp: valid_objs'_def obj_at'_def projectKOs)
-  done
-
-lemma valid_release_queue_ksPSpace_update:
-  "\<lbrakk>valid_release_queue s;
-    ko_wp_at' (\<lambda>ko'. koTypeOf ko' = koTypeOf ko \<and> objBitsKO ko' = objBitsKO ko) ptr s;
-    koTypeOf ko \<noteq> TCBT\<rbrakk> \<Longrightarrow>
-    valid_release_queue (s\<lparr>ksPSpace := (ksPSpace s)(ptr \<mapsto> ko)\<rparr>)"
-  by (fastforce simp: valid_release_queue_def ko_wp_at'_def obj_at'_def projectKOs ps_clear_upd)
-
-lemma valid_release_queue'_ksPSpace_update:
-  "\<lbrakk>valid_release_queue' s;
-    ko_wp_at' (\<lambda>ko'. koTypeOf ko' = koTypeOf ko \<and> objBitsKO ko' = objBitsKO ko) ptr s;
-    koTypeOf ko \<noteq> TCBT\<rbrakk> \<Longrightarrow>
-    valid_release_queue' (s\<lparr>ksPSpace := (ksPSpace s)(ptr \<mapsto> ko)\<rparr>)"
-  by (fastforce simp: valid_release_queue'_def ko_wp_at'_def obj_at'_def projectKOs ps_clear_upd)
-
-lemma sym_ref_Receive_or_Reply_replyTCB':
-  "\<lbrakk> sym_refs (state_refs_of' s); ko_at' tcb tp s;
-     tcbState tcb = BlockedOnReceive ep pl (Some rp)
-     \<or> tcbState tcb = BlockedOnReply (Some rp) \<rbrakk> \<Longrightarrow>
-    \<exists>reply. ksPSpace s rp = Some (KOReply reply) \<and> replyTCB reply = Some tp"
-  apply (drule (1) sym_refs_obj_atD'[rotated, where p=tp])
-  apply (clarsimp simp: state_refs_of'_def projectKOs obj_at'_def)
-  apply (clarsimp simp: ko_wp_at'_def)
-  apply (erule disjE; clarsimp)
-  apply (rename_tac koa; case_tac koa;
-         simp add: get_refs_def2 ep_q_refs_of'_def ntfn_q_refs_of'_def
-                   tcb_st_refs_of'_def tcb_bound_refs'_def
-            split: endpoint.split_asm ntfn.split_asm thread_state.split_asm if_split_asm)+
-  done
-
-lemma sym_ref_replyTCB_Receive_or_Reply:
-  "\<lbrakk> ko_at' reply rp s; sym_refs (state_refs_of' s); replyTCB reply = Some tp \<rbrakk>
-   \<Longrightarrow> st_tcb_at' (\<lambda>st. (\<exists>ep pl. st = BlockedOnReceive ep pl (Some rp))
-                        \<or> st = BlockedOnReply (Some rp)) tp s"
-  apply (drule (1) sym_refs_obj_atD'[rotated, where p=rp])
-  apply (clarsimp simp: state_refs_of'_def projectKOs pred_tcb_at'_def obj_at'_def)
-  apply (clarsimp simp: ko_wp_at'_def)
-  apply (rename_tac tcb; case_tac tcb;
-         simp add: get_refs_def2 ntfn_q_refs_of'_def
-                   tcb_st_refs_of'_def tcb_bound_refs'_def
-            split: ntfn.split_asm thread_state.split_asm)+
-  done
-
-lemma sym_ref_BlockedOnSend_SendEP':
-  "\<lbrakk> sym_refs (state_refs_of' s); st_tcb_at' ((=) (BlockedOnSend eptr p1 p2 p3 p4)) tp s\<rbrakk>
-      \<Longrightarrow> \<exists>list. ko_wp_at' ((=) (KOEndpoint (SendEP list))) eptr s"
-  apply (simp add: pred_tcb_at'_def)
-  apply (drule (1) sym_refs_obj_atD'[rotated, where p=tp])
-  apply (clarsimp simp: state_refs_of'_def projectKOs obj_at'_def)
-  apply (drule sym[where s="BlockedOnSend _ _ _ _ _"])
-  apply (clarsimp simp: ko_wp_at'_def)
-  apply (rename_tac ko; case_tac ko;
-         simp add: get_refs_def2 ep_q_refs_of'_def ntfn_q_refs_of'_def
-                   tcb_st_refs_of'_def tcb_bound_refs'_def
-            split: endpoint.split_asm ntfn.split_asm thread_state.split_asm if_split_asm)+
-  done
-
-lemma sym_ref_BlockedOnReceive_RecvEP':
-  "\<lbrakk> sym_refs (state_refs_of' s); st_tcb_at' ((=) (BlockedOnReceive eptr pl ropt)) tp s\<rbrakk>
-     \<Longrightarrow> \<exists>list. ko_wp_at' ((=) (KOEndpoint (RecvEP list))) eptr s"
-  apply (simp add: pred_tcb_at'_def)
-  apply (drule (1) sym_refs_obj_atD'[rotated, where p=tp])
-  apply (clarsimp simp: state_refs_of'_def projectKOs obj_at'_def)
-  apply (drule sym[where s="BlockedOnReceive _ _ _"])
-  apply (clarsimp simp: ko_wp_at'_def split: if_split_asm)
-   apply (rename_tac ko koa; case_tac ko;
-          simp add: get_refs_def2 ep_q_refs_of'_def ntfn_q_refs_of'_def
-                    tcb_st_refs_of'_def tcb_bound_refs'_def
-             split: endpoint.split_asm ntfn.split_asm thread_state.split_asm if_split_asm)
-  apply (rename_tac ko; case_tac ko;
-         simp add: get_refs_def2 ep_q_refs_of'_def ntfn_q_refs_of'_def
-                   tcb_st_refs_of'_def tcb_bound_refs'_def
-            split: endpoint.split_asm ntfn.split_asm thread_state.split_asm if_split_asm)
-  done
-
-lemma Receive_or_Send_ep_at':
-  "\<lbrakk> st = BlockedOnReceive epPtr pl rp \<or> st = BlockedOnSend epPtr p1 p2 p3 p4;
-     valid_objs' s; st_tcb_at' ((=) st) t s\<rbrakk>
-       \<Longrightarrow> ep_at' epPtr s"
-  apply (drule (1) tcb_in_valid_state')
-  by (fastforce simp: obj_at'_def valid_tcb_state'_def)
-
-lemma ep_queued_st_tcb_at':
-  "\<And>P. \<lbrakk>ko_at' ep ptr s; \<exists>rt. (t, rt) \<in> ep_q_refs_of' ep;
-         valid_objs' s; sym_refs (state_refs_of' s);
-         \<And>bo bbadge bgrant breply bcall r. P (Structures_H.BlockedOnSend bo bbadge bgrant breply bcall) \<and>
-                         P (Structures_H.BlockedOnReceive bo bgrant r) \<rbrakk>
-    \<Longrightarrow> st_tcb_at' P t s"
-  apply (case_tac ep, simp_all)
-  apply (frule(1) sym_refs_ko_atD', clarsimp, erule (1) my_BallE,
-         clarsimp simp: pred_tcb_at'_def refs_of_rev' obj_at'_def ko_wp_at'_def projectKOs)+
-  done
-
-(* cross lemmas *)
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemma pspace_aligned_cross:
-  "\<lbrakk> pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \<rbrakk> \<Longrightarrow> pspace_aligned' s'"
-  apply (clarsimp simp: pspace_aligned'_def pspace_aligned_def pspace_relation_def)
-  apply (rename_tac p' ko')
-  apply (prop_tac "p' \<in> pspace_dom (kheap s)", fastforce)
-  apply (thin_tac "pspace_dom k = p" for k p)
-  apply (clarsimp simp: pspace_dom_def)
-  apply (drule bspec, fastforce)+
-  apply clarsimp
-  apply (rename_tac ko' a a' P ko)
-  apply (erule (1) obj_relation_cutsE; clarsimp simp: objBits_simps)
-
-  \<comment>\<open>CNode\<close>
-     apply (clarsimp simp: cte_map_def)
-     apply (simp only: cteSizeBits_def cte_level_bits_def)
-     apply (rule is_aligned_add)
-      apply (erule is_aligned_weaken, simp)
-     apply (rule is_aligned_weaken)
-    apply (rule is_aligned_mult_triv2, simp)
-
-  \<comment>\<open>SchedContext, Reply\<close>
-     apply ((clarsimp simp: minSchedContextBits_def min_sched_context_bits_def replySizeBits_def
-                            sc_relation_def
-                     elim!: is_aligned_weaken)+)[2]
-
-  \<comment>\<open>PageTable\<close>
-   apply (clarsimp simp: archObjSize_def pteBits_def)
-    apply (rule is_aligned_add)
-     apply (erule is_aligned_weaken)
-     apply simp
-    apply (rule is_aligned_shift)
-
-  \<comment>\<open>PageDirectory\<close>
-   apply (clarsimp simp: archObjSize_def pdeBits_def)
-    apply (rule is_aligned_add)
-     apply (erule is_aligned_weaken, simp)
-    apply (rule is_aligned_shift)
-
-  \<comment>\<open>DataPage\<close>
-   apply (rule is_aligned_add)
-    apply (erule is_aligned_weaken)
-    apply (clarsimp simp: pageBits_def pageBitsForSize_def)
-    apply (case_tac sz; simp)
-  apply (rule is_aligned_mult_triv2)
-
-  \<comment>\<open>other_obj_relation\<close>
-  apply (simp add: other_obj_relation_def)
-  by (clarsimp simp: bit_simps' tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def
-              split: kernel_object.splits Structures_A.kernel_object.splits)
-     (fastforce simp: archObjSize_def split: arch_kernel_object.splits arch_kernel_obj.splits)
-
-lemma pspace_relation_pspace_bounded':
-  "\<lbrakk> pspace_relation (kheap s) (ksPSpace s') \<rbrakk> \<Longrightarrow> pspace_bounded' s'"
-  apply (clarsimp simp: pspace_bounded'_def pspace_relation_def)
-  apply (rename_tac p' ko')
-  apply (prop_tac "p' \<in> pspace_dom (kheap s)", fastforce)
-  apply (thin_tac "pspace_dom k = p" for k p)
-  apply (clarsimp simp: pspace_dom_def)
-  apply (drule bspec, fastforce)+
-  apply clarsimp
-  apply (rename_tac ko' a a' P ko)
-  apply (erule (1) obj_relation_cutsE;
-         clarsimp simp: objBits_simps' word_bits_def pageBits_def archObjSize_def pteBits_def pdeBits_def)
+lemma setEndpoint_ksMachine:
+  "\<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> setEndpoint ptr val \<lbrace>\<lambda>rv s. P (ksMachineState s)\<rbrace>"
+  by (simp add: setEndpoint_def | wp setObject_ksMachine updateObject_default_inv)+
 
-  \<comment>\<open>SchedContext\<close>
-     apply (clarsimp simp: minSchedContextBits_def min_sched_context_bits_def replySizeBits_def
-                           valid_sched_context_size_def sc_relation_def untyped_max_bits_def
-                     elim!: is_aligned_weaken)
+lemmas setEndpoint_valid_irq_states'  =
+  valid_irq_states_lift' [OF setEndpoint_ksInterruptState setEndpoint_ksMachine]
 
-  \<comment>\<open>other_obj_relation\<close>
-  apply (simp add: other_obj_relation_def)
-  by (clarsimp simp: bit_simps' tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def
-              split: kernel_object.splits Structures_A.kernel_object.splits)
-     (clarsimp simp: archObjSize_def pteBits_def pdeBits_def pageBits_def
-              split: arch_kernel_object.splits arch_kernel_obj.splits)
-
-lemma pspace_distinct_cross:
-  "\<lbrakk> pspace_distinct s; pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \<rbrakk> \<Longrightarrow>
-   pspace_distinct' s'"
-  apply (frule (1) pspace_aligned_cross)
-  apply (clarsimp simp: pspace_distinct'_def)
-  apply (rename_tac p' ko')
-  apply (rule pspace_dom_relatedE; assumption?)
-  apply (rename_tac p ko P)
-  apply (frule (1) pspace_alignedD')
-  apply (frule (1) pspace_alignedD)
-  apply (frule pspace_relation_pspace_bounded')
-    apply (frule (1) pspace_boundedD')
-  apply (rule ps_clearI, assumption)
-   apply (case_tac ko';
-          simp add: scBits_pos_power2 objBits_simps objBits_defs bit_simps'
-               del: minSchedContextBits_def)
-   apply (clarsimp split: arch_kernel_object.splits simp: bit_simps' archObjSize_def)
-  apply (rule ccontr, clarsimp)
-  apply (rename_tac x' ko_x')
-  apply (frule_tac x=x' in pspace_alignedD', assumption)
-  apply (rule_tac x=x' in pspace_dom_relatedE; assumption?)
-  apply (rename_tac x ko_x P')
-  apply (frule_tac p=x in pspace_alignedD, assumption)
-  apply (case_tac "p = x")
-   apply clarsimp
-   apply (erule (1) obj_relation_cutsE; clarsimp)
-      apply (clarsimp simp: cte_relation_def cte_map_def objBits_simps)
-      apply (rule_tac n=cteSizeBits in is_aligned_add_step_le'; assumption?)
-     apply (clarsimp simp: pte_relation_def objBits_simps archObjSize_def)
-     apply (rule_tac n=pteBits in is_aligned_add_step_le'; assumption?)
-     apply (clarsimp simp: pde_relation_def objBits_simps archObjSize_def)
-     apply (rule_tac n=pdeBits in is_aligned_add_step_le'; assumption?)
-    apply (simp add: objBitsKO_Data)
-    apply (rule_tac n=pageBits in is_aligned_add_step_le'; assumption?)
-   apply (case_tac ko;
-          simp split: if_split_asm
-                 add: is_other_obj_relation_type_CapTable
-                      is_other_obj_relation_type_SchedContext
-                      is_other_obj_relation_type_Reply
-                      a_type_def)
-   apply (rename_tac ako,
-          case_tac ako;
-          simp add: is_other_obj_relation_type_def a_type_def split: if_split_asm)
-  apply (frule (1) obj_relation_cuts_obj_bits)
-  apply (drule (2) obj_relation_cuts_range_mask_range)+
-  apply (prop_tac "x' \<in> mask_range p' (objBitsKO ko')", simp add: mask_def add_diff_eq)
-  apply (frule_tac x=p and y=x in pspace_distinctD; assumption?)
-  apply (drule (4) mask_range_subsetD)
-  apply (erule (2) in_empty_interE)
+lemma setEndpoint_ct':
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setEndpoint a b \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: setEndpoint_def setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
   done
 
-lemma aligned'_distinct'_ko_at'I:
-  "\<lbrakk>ksPSpace s' x = Some ko;  pspace_aligned' s'; pspace_distinct' s';
-    (if koTypeOf ko  = SchedContextT then pspace_bounded' s' else True);
-    ko = injectKO (v:: 'a :: pspace_storable)\<rbrakk>
-      \<Longrightarrow> ko_at' v x s'"
-  apply (simp add: obj_at'_def projectKOs project_inject pspace_bounded'_def
-                   pspace_distinct'_def pspace_aligned'_def)
+lemma aligned_distinct_obj_atI':
+  "\<lbrakk> ksPSpace s x = Some ko; pspace_aligned' s; pspace_distinct' s; ko = injectKO v \<rbrakk>
+   \<Longrightarrow> ko_at' v x s"
+  apply (simp add: obj_at'_def projectKOs project_inject pspace_distinct'_def pspace_aligned'_def)
   apply (drule bspec, erule domI)+
-  apply (case_tac "injectKO v"; clarsimp simp: valid_sz_simps dest!: pspace_boundedD')
-  done
-
-lemma aligned_distinct_ko_at'I:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes ps: "pspace_aligned s" "pspace_distinct s"
-  shows "\<lbrakk>ksPSpace s' x = Some ko; ko = injectKO (v:: 'a :: pspace_storable)\<rbrakk>
-      \<Longrightarrow> ko_at' v x s'"
-  apply (rule aligned'_distinct'_ko_at'I[OF _ pspace_aligned_cross[OF ps(1) p]]; simp)
-  using assms by (fastforce dest!: pspace_distinct_cross simp: pspace_relation_pspace_bounded'[OF p])+
-
-lemma tcb_at_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes aligned: "pspace_aligned s"
-  assumes distinct: "pspace_distinct s"
-  assumes t: "tcb_at t s"
-  shows "tcb_at' t s'" using assms
-  apply (clarsimp simp: obj_at_def is_tcb)
-  apply (drule (1) pspace_relation_absD, clarsimp simp: other_obj_relation_def)
-  apply (case_tac z; simp)
-  by (fastforce dest!: aligned_distinct_ko_at'I[where 'a=tcb] elim: obj_at'_weakenE)
-
-lemma st_tcb_at_coerce_abstract:
-  assumes t: "st_tcb_at' P t c"
-  assumes sr: "(a, c) \<in> state_relation"
-  shows "st_tcb_at (\<lambda>st. \<exists>st'. thread_state_relation st st' \<and> P st') t a"
-  using assms
-  apply (clarsimp simp: state_relation_def pred_tcb_at'_def obj_at'_def
-                        projectKOs)
-  apply (erule (1) pspace_dom_relatedE)
-  apply (erule (1) obj_relation_cutsE, simp_all)
-  apply (clarsimp simp: st_tcb_at_def obj_at_def other_obj_relation_def
-                        tcb_relation_def
-                 split: Structures_A.kernel_object.split_asm if_split_asm
-                        arch_kernel_obj.split_asm)+
-  apply fastforce
-  done
-
-lemma st_tcb_at_coerce_concrete:
-  assumes t: "st_tcb_at P t s"
-  assumes sr: "(s, s') \<in> state_relation" "pspace_aligned s" "pspace_distinct s"
-  shows "st_tcb_at' (\<lambda>st'. \<exists>st. thread_state_relation st st' \<and> P st) t s'"
-  using assms
-  apply (clarsimp simp: state_relation_def pred_tcb_at_def obj_at_def projectKOs)
-  apply (frule (1) pspace_distinct_cross, fastforce simp: state_relation_def)
-  apply (frule pspace_aligned_cross, fastforce simp: state_relation_def)
-  apply (prop_tac "tcb_at t s", clarsimp simp: st_tcb_at_def obj_at_def is_tcb)
-  apply (drule (2) tcb_at_cross[rotated], fastforce simp: state_relation_def)
-  apply (clarsimp simp: state_relation_def pred_tcb_at'_def obj_at'_def projectKOs)
-  apply (erule (1) pspace_dom_relatedE)
-  apply (erule (1) obj_relation_cutsE, simp_all)
-   apply (clarsimp simp: st_tcb_at'_def obj_at'_def other_obj_relation_def tcb_relation_def
-                  split: Structures_A.kernel_object.split_asm if_split_asm)+
-  apply fastforce
-  done
-
-lemma st_tcb_at_runnable_cross:
-  "\<lbrakk> st_tcb_at runnable t s; pspace_aligned s; pspace_distinct s; (s, s') \<in> state_relation \<rbrakk>
-       \<Longrightarrow> st_tcb_at' runnable' t s'"
-  apply (drule (3) st_tcb_at_coerce_concrete)
-  by (clarsimp simp: pred_tcb_at'_def obj_at'_def sts_rel_runnable)
-
-lemma bound_sc_tcb_at_cross:
-  assumes t: "bound_sc_tcb_at P t s"
-  assumes sr: "(s, s') \<in> state_relation" "pspace_aligned s" "pspace_distinct s"
-  shows "tcb_at' t s' \<and> P (tcbSCs_of s' t)"
-  using assms
-  apply (clarsimp simp: state_relation_def pred_tcb_at_def obj_at_def projectKOs)
-  apply (frule (1) pspace_distinct_cross, fastforce simp: state_relation_def)
-  apply (frule pspace_aligned_cross, fastforce simp: state_relation_def)
-  apply (prop_tac "tcb_at t s", clarsimp simp: obj_at_def is_tcb)
-  apply (drule (2) tcb_at_cross[rotated], fastforce simp: state_relation_def)
-  apply (clarsimp simp: state_relation_def pred_tcb_at'_def obj_at'_def projectKOs opt_map_red)
-  apply (erule (1) pspace_dom_relatedE)
-  apply (erule (1) obj_relation_cutsE, simp_all)
-   apply (clarsimp simp: st_tcb_at'_def obj_at'_def other_obj_relation_def tcb_relation_def
-                  split: Structures_A.kernel_object.split_asm if_split_asm)+
-  done
-
-lemma bound_yt_tcb_at_cross:
-  assumes t: "bound_yt_tcb_at P t s"
-  assumes sr: "(s, s') \<in> state_relation" "pspace_aligned s" "pspace_distinct s"
-  shows "obj_at' (\<lambda>tcb'. \<exists>tcb. tcb_relation tcb tcb' \<and> P (tcb_yield_to tcb)) t s'"
-  using assms
-  apply (clarsimp simp: state_relation_def pred_tcb_at_def obj_at_def projectKOs)
-  apply (frule (1) pspace_distinct_cross, fastforce simp: state_relation_def)
-  apply (frule pspace_aligned_cross, fastforce simp: state_relation_def)
-  apply (prop_tac "tcb_at t s", clarsimp simp: st_tcb_at_def obj_at_def is_tcb)
-  apply (drule (2) tcb_at_cross[rotated], fastforce simp: state_relation_def)
-  apply (clarsimp simp: state_relation_def pred_tcb_at'_def obj_at'_def projectKOs)
-  apply (erule (1) pspace_dom_relatedE)
-  apply (erule (1) obj_relation_cutsE, simp_all)
-   apply (clarsimp simp: st_tcb_at'_def obj_at'_def other_obj_relation_def tcb_relation_def
-                  split: Structures_A.kernel_object.split_asm if_split_asm)+
-  apply fastforce
-  done
-
-lemma sc_tcb_sc_at_bound_cross:
-  "\<lbrakk>pspace_relation (kheap s) (ksPSpace s'); valid_objs s; pspace_aligned s; pspace_distinct s;
-    sc_tcb_sc_at ((\<noteq>) None) scp s\<rbrakk>
-  \<Longrightarrow> obj_at' (\<lambda>sc. \<exists>y. scTCB sc = Some y) scp s'"
-  apply (clarsimp simp: obj_at_def sc_tcb_sc_at_def)
-  apply (frule (1) pspace_relation_absD)
-  apply clarsimp
-  apply (prop_tac "valid_sched_context_size n")
-   apply (erule (1) valid_sched_context_size_objsI)
-  apply (clarsimp simp: if_split_asm)
-  apply (rename_tac z; case_tac z; simp)
-  apply (drule (3) aligned_distinct_ko_at'I[where 'a=sched_context], simp)
-  apply (clarsimp simp: obj_at'_def sc_relation_def projectKOs)
-  by (metis not_None_eq)
-
-lemma cur_tcb_cross:
-  "\<lbrakk> cur_tcb s; pspace_aligned s; pspace_distinct s; (s,s') \<in> state_relation \<rbrakk> \<Longrightarrow> cur_tcb' s'"
-  apply (clarsimp simp: cur_tcb'_def cur_tcb_def state_relation_def)
-  apply (erule (3) tcb_at_cross)
-  done
-
-method add_cur_tcb' =
-  rule_tac Q="\<lambda>s'. cur_tcb' s'" in corres_cross_add_guard,
-  fastforce intro!: cur_tcb_cross
-
-lemma cur_sc_tcb_cross:
-  "\<lbrakk>(s, s') \<in> state_relation; valid_objs s; pspace_aligned s; pspace_distinct s;
-    cur_sc_tcb s; schact_is_rct s\<rbrakk>
-  \<Longrightarrow> obj_at' (\<lambda>sc. scTCB sc = Some (ksCurThread s')) (ksCurSc s') s'"
-  apply (clarsimp simp: obj_at_def sc_tcb_sc_at_def cur_sc_tcb_def
-                 dest!: schact_is_rct state_relationD)
-  apply (frule (1) pspace_relation_absD)
-  apply clarsimp
-  apply (prop_tac "valid_sched_context_size n")
-   apply (erule (1) valid_sched_context_size_objsI)
-  apply (clarsimp simp: if_split_asm)
-  apply (rename_tac z; case_tac z; simp)
-  apply (drule (3) aligned_distinct_ko_at'I[where 'a=sched_context], simp)
-  apply (clarsimp simp: obj_at'_def sc_relation_def projectKOs)
-  done
-
-lemma reply_at_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes ps: "pspace_aligned s" "pspace_distinct s"
-  assumes t: "reply_at ptr s"
-  shows "reply_at' ptr s'"
-  using assms
-  apply (clarsimp simp: obj_at_def is_reply)
-  apply (drule (1) pspace_relation_absD, clarsimp)
-  apply (case_tac z; simp)
-  by (fastforce dest!: aligned_distinct_ko_at'I[where 'a=reply] elim: obj_at'_weakenE)
-
-lemma ep_at_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes ps: "pspace_aligned s" "pspace_distinct s"
-  assumes t: "ep_at ptr s"
-  shows "ep_at' ptr s'"
-  using assms
-  apply (clarsimp simp: obj_at_def is_ep)
-  apply (drule (1) pspace_relation_absD, clarsimp simp: other_obj_relation_def)
-  apply (case_tac z; simp)
-  by (fastforce dest!: aligned_distinct_ko_at'I[where 'a=endpoint] elim: obj_at'_weakenE)
-
-lemma ntfn_at_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes ps: "pspace_aligned s" "pspace_distinct s"
-  assumes t: "ntfn_at ptr s"
-  shows "ntfn_at' ptr s'"
-  using assms
-  apply (clarsimp simp: obj_at_def is_ntfn)
-  apply (drule (1) pspace_relation_absD, clarsimp simp: other_obj_relation_def)
-  apply (case_tac z; simp)
-  by (fastforce dest!: aligned_distinct_ko_at'I[where 'a=notification] elim: obj_at'_weakenE)
-
-lemma sc_at_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes ps: "pspace_aligned s" "pspace_distinct s"
-  assumes t: "sc_at ptr s"
-  shows "sc_at' ptr s'"
-  using assms
-  apply (clarsimp simp: obj_at_def is_sc_obj)
-  apply (drule (1) pspace_relation_absD, clarsimp)
-  apply (case_tac z; simp)
-  by (fastforce dest!: aligned_distinct_ko_at'I[where 'a=sched_context] elim: obj_at'_weakenE)
-
-lemma sc_at'_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and sc_at t) (sc_at' t)"
-  unfolding cross_rel_def state_relation_def
-  apply clarsimp
-  by (erule (3) sc_at_cross)
-
-lemma sc_obj_at_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes ps: "pspace_aligned s" "pspace_distinct s"
-  assumes t: "sc_obj_at n ptr s"
-  shows "obj_at' (\<lambda>sc::sched_context. objBits sc = minSchedContextBits + n) ptr s'"
-  using assms
-  apply (clarsimp simp: obj_at_def is_sc_obj)
-  apply (drule (1) pspace_relation_absD, clarsimp)
-  apply (case_tac z; simp)
-  apply (rename_tac sc')
-  apply (drule (3) aligned_distinct_ko_at'I[where 'a=sched_context], simp)
-  by (clarsimp simp: scBits_simps objBits_simps sc_relation_def obj_at'_def)
-
-lemma real_cte_at_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes ps: "pspace_aligned s" "pspace_distinct s"
-  assumes t: "real_cte_at ptr s"
-  shows "real_cte_at' (cte_map ptr) s'"
-  using assms
-  apply (clarsimp simp: obj_at_def is_ntfn)
-  apply (drule (1) pspace_relation_absD)
-  apply (clarsimp simp: is_cap_table other_obj_relation_def well_formed_cnode_n_def)
-  apply (prop_tac "\<exists>z. ksPSpace s' (cte_map (fst ptr, snd ptr)) = Some z \<and>
-    cte_relation (snd ptr) (CNode (length (snd ptr)) cs) z")
-  apply fastforce
-  apply (clarsimp split: kernel_object.split_asm simp: cte_relation_def)
-  by (fastforce dest!: aligned_distinct_ko_at'I[where 'a=cte] elim: obj_at'_weakenE)
-
-lemma valid_tcb_state_cross:
-  assumes "pspace_relation (kheap s) (ksPSpace s')"
-          "thread_state_relation ts ts'"
-          "pspace_aligned s"
-          "pspace_distinct s"
-          "valid_tcb_state ts s"
-  shows "valid_tcb_state' ts' s'" using assms
-  by (fastforce dest: ep_at_cross reply_at_cross ntfn_at_cross
-                simp: valid_bound_obj'_def valid_tcb_state_def valid_tcb_state'_def
-               split: Structures_A.thread_state.split_asm option.split_asm)
-
-lemma state_refs_of_cross_eq:
-  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s\<rbrakk>
-       \<Longrightarrow> state_refs_of' s' = state_refs_of s"
-  apply (rule sym)
-  apply (rule ext, rename_tac p)
-  apply (frule state_relation_pspace_relation)
-  apply (frule (2) pspace_distinct_cross)
-  apply (frule (1) pspace_aligned_cross)
-  apply (clarsimp simp: state_refs_of_def state_refs_of'_def
-                 split: option.split)
-  apply (rule conjI; clarsimp)
-   apply (rename_tac ko')
-   apply (erule (1) pspace_dom_relatedE)
-   apply (rename_tac ko P; case_tac ko; clarsimp split: if_split_asm simp: cte_relation_def)
-   apply (rename_tac ako; case_tac ako; clarsimp simp: pte_relation_def pde_relation_def)
-  apply (rule conjI; clarsimp)
-   apply (drule (1) pspace_relation_None; clarsimp)
-  apply (rule conjI[rotated]; clarsimp)
-   apply (frule pspace_relation_pspace_bounded'[OF state_relation_pspace_relation])
-   apply (frule pspace_alignedD'; frule pspace_boundedD'; clarsimp dest!: pspace_distinctD')
-  apply (rename_tac ko ko')
-  apply (frule (1) pspace_relation_absD)
-  apply (case_tac ko; clarsimp split: if_split_asm)
-        apply (rename_tac n sz, drule_tac x=p and y="cte_relation (replicate n False)" in spec2)
-        apply (fastforce simp: cte_relation_def cte_map_def well_formed_cnode_n_def)
-       apply (find_goal \<open>match premises in "_ = Some (ArchObj _)" \<Rightarrow> -\<close>)
-       apply (rename_tac ako; case_tac ako; simp)
-          apply (case_tac ko'; clarsimp simp: other_obj_relation_def)
-         apply ((drule_tac x=0 in spec, clarsimp simp:  pte_relation_def pde_relation_def)+)[2]
-       apply (drule_tac x=p in spec, clarsimp)
-       apply (rename_tac b sz)
-       apply (drule_tac x="\<lambda>_ obj. obj = (if b then KOUserDataDevice else KOUserData)" in spec, clarsimp)
-       apply (simp only: imp_ex)
-       apply (drule_tac x=0 in spec, clarsimp simp: pageBitsForSize_def pageBits_def split: vmpage_size.split_asm)
-      apply (all \<open>case_tac ko'; clarsimp simp: other_obj_relation_def\<close>)
-      apply (rename_tac tcb tcb';
-             clarsimp simp: tcb_relation_def arch_tcb_relation_def fault_rel_optionation_def
-                            thread_state_relation_def tcb_st_refs_of_def tcb_st_refs_of'_def;
-             rename_tac tcb'; case_tac "tcb_state tcb"; case_tac "tcbState tcb'";
-             clarsimp simp: tcb_bound_refs'_def get_refs_def2 split: option.splits)
-     apply (clarsimp simp: ep_q_refs_of_def ep_relation_def split: Structures_A.endpoint.splits)
-    apply (clarsimp simp: ntfn_q_refs_of_def ntfn_relation_def split: Structures_A.ntfn.splits)
-   apply (clarsimp simp: sc_relation_def get_refs_def2)
-   apply (drule state_relation_sc_replies_relation)
-   apply (frule sc_replies_relation_scReplies_of)
-     apply (fastforce simp: obj_at_def is_sc_obj_def)
-    apply (clarsimp simp: opt_map_def)
-   apply (clarsimp simp: opt_map_def sc_replies_of_scs_def map_project_def scs_of_kh_def)
-  apply (clarsimp simp: reply_relation_def split: Structures_A.ntfn.splits)
-  done
-
-end
-
-lemma state_refs_of_cross:
-  "\<lbrakk>P (state_refs_of s); (s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s\<rbrakk>
-      \<Longrightarrow> P (state_refs_of' s')"
-  by (clarsimp simp: state_refs_of_cross_eq elim!: rsubst[where P=P])
-
-lemma ct_not_inQ_cross:
-  "\<lbrakk>(s,s') \<in> state_relation; ct_not_in_q s; valid_queues' s'; cur_tcb s; pspace_aligned s;
-    pspace_distinct s\<rbrakk>
-   \<Longrightarrow> ct_not_inQ s'"
-  apply (frule (3) cur_tcb_cross)
-  apply (clarsimp simp: ct_not_inQ_def ct_not_in_q_def)
-  apply (prop_tac "scheduler_action s = resume_cur_thread")
-   apply (clarsimp simp: state_relation_def)
-   apply (metis sched_act_relation.simps Structures_A.scheduler_action.exhaust
-                scheduler_action.simps)
-  apply (clarsimp simp: not_queued_def)
-  apply (rule ccontr)
-  apply (prop_tac "obj_at' tcbQueued (ksCurThread s') s'")
-   apply (clarsimp simp: obj_at_simps cur_tcb'_def)
-  apply (frule curthread_relation)
-  apply (frule state_relation_ready_queues_relation)
-  apply (clarsimp simp: valid_queues'_def inQ_def ready_queues_relation_def obj_at_simps)
-  by (metis Structures_H.kernel_object.case(6))
-
-lemma sch_act_wf_cross:
-  "\<lbrakk>(s,s') \<in> state_relation; valid_sched_action s; cur_tcb s; pspace_aligned s; pspace_distinct s\<rbrakk>
-   \<Longrightarrow> sch_act_wf (ksSchedulerAction s') s'"
-  apply (clarsimp simp: sch_act_wf_def)
-  apply (cases "ksSchedulerAction s'"; clarsimp)
-   apply (prop_tac "scheduler_action s = resume_cur_thread")
-    apply (clarsimp simp: state_relation_def)
-    apply (metis sched_act_relation.simps Structures_A.scheduler_action.exhaust
-                 scheduler_action.simps)
-   apply (frule curthread_relation)
-   apply (frule state_relation_pspace_relation)
-   apply (frule (2) cur_tcb_cross)
-    apply fastforce
-   apply (clarsimp simp: valid_sched_action_def is_activatable_def vs_all_heap_simps
-                         ct_in_state'_def st_tcb_at'_def)
-   apply (clarsimp simp: pspace_relation_def)
-   apply (drule_tac x="cur_thread s" in bspec, fastforce)
-   apply (drule_tac x="(cur_thread s, other_obj_relation)" in bspec, fastforce)
-   apply (clarsimp simp: other_obj_relation_def)
-   apply (rename_tac tcb)
-   apply (case_tac "tcb_state tcb"; clarsimp simp: tcb_relation_def obj_at_simps cur_tcb'_def)
-  apply (rename_tac target)
-  apply (clarsimp simp: valid_sched_action_def weak_valid_sched_action_def vs_all_heap_simps)
-  apply (prop_tac "scheduler_action s = switch_thread target")
-   apply (clarsimp simp: state_relation_def)
-   apply (metis sched_act_relation.simps Structures_A.scheduler_action.exhaust
-                scheduler_action.simps)
-  apply (prop_tac "tcb_at' target s'")
-   apply (fastforce intro!: tcb_at_cross
-                      simp: obj_at_def is_tcb_def)
-  apply (frule state_relation_pspace_relation)
-  apply (clarsimp simp: pspace_relation_def)
-  apply (drule_tac x=target in bspec, fastforce)
-  apply (drule_tac x="(target, other_obj_relation)" in bspec, fastforce)
-  apply (clarsimp simp: other_obj_relation_def)
-  apply (intro conjI)
-   apply (fastforce intro!: st_tcb_at_runnable_cross
-                      simp: obj_at_def pred_tcb_at_def)
-  apply (clarsimp simp: tcb_relation_def obj_at_simps switch_in_cur_domain_def
-                        state_relation_def in_cur_domain_def tcb_in_cur_domain'_def
-                        etcb_at'_def vs_all_heap_simps)
-  done
-
-lemma ct_idle_or_in_cur_domain'_cross:
-  "\<lbrakk>(s,s') \<in> state_relation; ct_in_cur_domain s; cur_tcb s; pspace_aligned s; pspace_distinct s\<rbrakk>
-   \<Longrightarrow> ct_idle_or_in_cur_domain' s'"
-  apply (clarsimp simp: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def ct_in_cur_domain_def)
-  apply (case_tac "cur_thread s = idle_thread s"; clarsimp)
-   apply (clarsimp simp: state_relation_def)
-  apply (frule curthread_relation)
-  apply (frule (2) cur_tcb_cross)
-   apply fastforce
-  apply (prop_tac "scheduler_action s = resume_cur_thread")
-   apply (clarsimp simp: state_relation_def)
-   apply (metis sched_act_relation.simps Structures_A.scheduler_action.exhaust
-                scheduler_action.simps)
-  apply (clarsimp simp: in_cur_domain_def etcb_at_def vs_all_heap_simps obj_at_simps cur_tcb'_def)
-  apply (frule state_relation_pspace_relation)
-  apply (clarsimp simp: pspace_relation_def)
-  apply (drule_tac x="cur_thread s" in bspec)
-   apply (clarsimp simp: cur_tcb_def obj_at_def)
-  apply (drule_tac x="(cur_thread s, other_obj_relation)" in bspec)
-   apply (clarsimp simp: cur_tcb_def obj_at_def is_tcb_def)
-   apply (rename_tac tcb)
-   apply (case_tac tcb; clarsimp)
-  apply (clarsimp simp: cur_tcb_def obj_at_def is_tcb_def)
-  apply (rename_tac tcb)
-  apply (case_tac tcb; clarsimp)
-  apply (clarsimp simp: other_obj_relation_def tcb_relation_def state_relation_def)
-  done
-
-lemma valid_idle'_cross:
-  "\<lbrakk>(s,s') \<in> state_relation; valid_idle s; pspace_aligned s; pspace_distinct s; valid_objs s\<rbrakk>
-   \<Longrightarrow> valid_idle' s'"
-  apply (clarsimp simp: valid_idle'_def valid_idle_def pred_tcb_at_def obj_at_def)
-  apply (prop_tac "ksIdleThread s' = idle_thread s")
-   apply (clarsimp simp: state_relation_def)
-  apply clarsimp
-  apply (prop_tac "tcb_at' (ksIdleThread s') s'")
-   apply (fastforce intro!: tcb_at_cross simp: obj_at_def state_relation_def is_tcb_def)
-  apply (prop_tac "sc_at' (idle_sc_ptr) s'")
-   apply (fastforce intro!: sc_at_cross valid_objs_valid_sched_context_size
-                      simp: obj_at_def state_relation_def is_sc_obj_def)
-  apply (frule state_relation_pspace_relation)
-  apply (clarsimp simp: pspace_relation_def)
-  apply (intro conjI)
-   apply (drule_tac x="idle_thread s" in bspec, fastforce)
-   apply (drule_tac x="(idle_thread s, other_obj_relation)" in bspec, fastforce)
-   apply (clarsimp simp: obj_at_simps idle_tcb'_def tcb_relation_def)
-  apply (drule_tac x="idle_sc_ptr" in bspec, fastforce)
-  apply (drule_tac x="(idle_sc_ptr, sc_relation_cut)" in bspec)
-   apply (fastforce intro: valid_objs_valid_sched_context_size)
-  by (fastforce dest: sc_replies_prevs_walk
-                simp: heap_walk_Nil_None obj_at_simps sc_relation_def state_relation_def)
-
-lemma ksReadyQueues_distinct_cross:
-   "\<lbrakk>(s,s') \<in> state_relation; valid_ready_qs s\<rbrakk> \<Longrightarrow> \<forall>d p. distinct (ksReadyQueues s' (d, p))"
-   by (clarsimp simp: valid_ready_qs_def state_relation_def ready_queues_relation_def)
-
-lemma ready_qs_runnable_cross:
-  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_ready_qs s\<rbrakk>
-   \<Longrightarrow> ready_qs_runnable s'"
-  unfolding ready_qs_runnable_def
-  by (fastforce simp: state_relation_def ready_queues_relation_def
-                      in_ready_q_def st_tcb_at_runnable_cross
-                dest: valid_ready_qs_in_ready_qD)
-
-lemma replyTCBs_of_cross:
-  "\<lbrakk>(s, s') \<in> state_relation; reply_tcb_reply_at P rptr s\<rbrakk>
-   \<Longrightarrow> P (replyTCBs_of s' rptr)"
-  apply (clarsimp simp: reply_at_ppred_def obj_at_def state_relation_def)
-  apply (drule (1) pspace_relation_absD, clarsimp simp: other_obj_relation_def)
-  apply (case_tac z; simp)
-  apply (clarsimp simp: opt_map_def reply_relation_def)
-  done
-
-lemma replySCs_of_cross:
-  "\<lbrakk>(s, s') \<in> state_relation; reply_sc_reply_at P rptr s\<rbrakk>
-   \<Longrightarrow> P (replySCs_of s' rptr)"
-  apply (clarsimp simp: reply_at_ppred_def obj_at_def is_tcb state_relation_def)
-  apply (drule (1) pspace_relation_absD, clarsimp simp: other_obj_relation_def)
-  apply (case_tac z; simp)
-  apply (clarsimp simp: opt_map_def reply_relation_def)
-  done
-
-lemma valid_replies_sc_cross:
-  "\<lbrakk>(s, s') \<in> state_relation; valid_replies s; sym_refs (state_refs_of s);
-    pspace_aligned s; pspace_distinct s; reply_at rptr s\<rbrakk>
-   \<Longrightarrow> valid_replies'_sc_asrt rptr s'"
-  apply (clarsimp simp: valid_replies_defs valid_replies'_sc_asrt_def elim!: opt_mapE)
-  apply (rename_tac scptr rp ko)
-  apply (prop_tac "sc_replies_sc_at (\<lambda>rs. rptr \<in> set rs) scptr s")
-   apply (frule_tac sc_ptr=scptr and reply_ptr=rptr in sym_refs_sc_replies_sc_at)
-    apply (rule ccontr)
-    apply (drule not_sk_obj_at_pred)
-     apply (fastforce simp: sk_obj_at_pred_def obj_at_def is_obj_defs)
-    apply (frule (1) replySCs_of_cross)
-    apply (clarsimp simp: obj_at'_def projectKOs opt_map_def)
-   apply (clarsimp simp: sc_at_pred_n_eq_commute sc_at_ppred_def obj_at_def)
-  apply (drule subsetD, force)
-  apply (clarsimp simp: pred_tcb_at_eq_commute[symmetric])
-  apply (frule (1) st_tcb_reply_state_refs)
-  apply (drule (3) st_tcb_at_coerce_concrete)
-  apply (drule replyTCBs_of_cross[where P="\<lambda>rtcb. rtcb = (Some tptr)" for tptr])
-   apply (fastforce simp: sk_obj_at_pred_def2)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma getCurThread_sp:
-  "\<lbrace>P\<rbrace> getCurThread \<lbrace>\<lambda>rv. P and (\<lambda>s. rv = ksCurThread s)\<rbrace>"
-  by (wpsimp simp: getCurThread_def)
-
-lemma getSchedulerAction_sp:
-  "\<lbrace>P\<rbrace> getSchedulerAction \<lbrace>\<lambda>rv. P and (\<lambda>s. rv = ksSchedulerAction s)\<rbrace>"
-  by (wpsimp simp: getSchedulerAction_def)
-
-lemma getReprogramTimer_sp:
-  "\<lbrace>P\<rbrace> getReprogramTimer \<lbrace>\<lambda>rv. P and (\<lambda>s. rv = ksReprogramTimer s)\<rbrace>"
-  by (wpsimp simp: getReprogramTimer_def)
-
-lemma getIdleThread_sp:
-  "\<lbrace>P\<rbrace> getIdleThread \<lbrace>\<lambda>rv. P and (\<lambda>s. rv = ksIdleThread s)\<rbrace>"
-  by wpsimp
-
-lemma getIdleSC_sp:
-  "\<lbrace>P\<rbrace> getIdleSC \<lbrace>\<lambda>rv. P and (\<lambda>s. rv = ksIdleSC s)\<rbrace>"
-  by wpsimp
-
-lemma getReprogramTimer_wp[wp]:
-  "\<lbrace>\<lambda>s. P (ksReprogramTimer s) s\<rbrace> getReprogramTimer \<lbrace>P\<rbrace>"
-  by (wpsimp simp: getReprogramTimer_def)
-
-lemma getConsumedTime_wp[wp]:
-  "\<lbrace>\<lambda>s. P (ksConsumedTime s) s\<rbrace> getConsumedTime \<lbrace>P\<rbrace>"
-  by (wpsimp simp: getConsumedTime_def)
-
-lemma isRoundRobin_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko sc s \<longrightarrow> P (scPeriod ko = 0) s\<rbrace> isRoundRobin sc \<lbrace>P\<rbrace>"
-  by (wpsimp simp: isRoundRobin_def)
-
-lemma getCurSc_wp[wp]:
-  "\<lbrace>\<lambda>s. P (ksCurSc s) s\<rbrace> getCurSc \<lbrace>P\<rbrace>"
-  unfolding getCurSc_def
-  by wpsimp
-
-lemma getCurTime_wp[wp]:
-  "\<lbrace>\<lambda>s. P (ksCurTime s) s\<rbrace> getCurTime \<lbrace>P\<rbrace>"
-  unfolding getCurTime_def
-  by wpsimp
-
-lemma curDomain_wp[wp]:
-  "\<lbrace>\<lambda>s. P (ksCurDomain s) s\<rbrace> curDomain \<lbrace>P\<rbrace>"
-  unfolding curDomain_def
-  by wpsimp
-
-lemma curDomain_sp:
-  "\<lbrace>P\<rbrace> curDomain \<lbrace>\<lambda>rv. P and (\<lambda>s. rv = ksCurDomain s)\<rbrace>"
-  by wpsimp
-
-lemma getReleaseQueue_wp[wp]:
-  "\<lbrace>\<lambda>s. P (ksReleaseQueue s) s\<rbrace> getReleaseQueue \<lbrace>P\<rbrace>"
-  unfolding getReleaseQueue_def
-  by wpsimp
-
-lemma getObject_sc_wp:
-  "\<lbrace>\<lambda>s. sc_at' p s \<longrightarrow> (\<exists>t::sched_context. ko_at' t p s \<and> Q t s)\<rbrace> getObject p \<lbrace>Q\<rbrace>"
-  by (clarsimp simp: getObject_def valid_def in_monad
-                     split_def objBits_simps' loadObject_default_def
-                     projectKOs obj_at'_def in_magnitude_check
-              dest!: readObject_misc_ko_at')
-
-lemma getRefillNext_getSchedContext:
-  "getRefillNext scPtr index = do sc \<leftarrow> getSchedContext scPtr;
-                                  return $ if index = scRefillMax sc - 1 then 0 else index + 1
-                               od"
-  apply (clarsimp simp: getRefillNext_def readRefillNext_def readSchedContext_def
-                        getSchedContext_def getObject_def[symmetric])
-  done
-
-lemma getRefillNext_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko scPtr s \<longrightarrow> P (if index = scRefillMax ko - Suc 0 then 0 else index + 1) s\<rbrace>
-   getRefillNext scPtr index
-   \<lbrace>P\<rbrace>"
-  apply (simp add: getRefillNext_getSchedContext)
-  apply (wpsimp wp: getObject_sc_wp)
-  done
-
-lemma getRefillSize_def2:
-  "getRefillSize scPtr = liftM scRefillCount (gets_the (readSchedContext scPtr))"
-  apply (clarsimp simp: getRefillSize_def readRefillSize_def liftM_def oliftM_def)
-  done
-
-lemma getRefillSize_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko scp s \<longrightarrow> P (scRefillCount ko) s\<rbrace> getRefillSize scp \<lbrace>P\<rbrace>"
-  apply (clarsimp simp: getRefillSize_def2)
-  apply (wpsimp wp: simp: readSchedContext_def)
-  done
-
-lemma refillEmpty_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko scp s \<longrightarrow> P (scRefillCount ko = 0) s\<rbrace> refillEmpty scp \<lbrace>P\<rbrace>"
-  unfolding refillEmpty_def
-  by (wpsimp wp:)
-
-lemma refillFull_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko scp s \<longrightarrow> P (scRefillCount ko = scRefillMax ko) s\<rbrace> refillFull scp \<lbrace>P\<rbrace>"
-  unfolding refillFull_def
-  by (wpsimp wp:)
-
-lemma no_ofail_readCurTime[simp]:
-  "no_ofail \<top> readCurTime"
-  unfolding readCurTime_def by clarsimp
-
-lemma ovalid_readCurTime[wp]:
-  "\<lblot>\<lambda>s. P (ksCurTime s) s\<rblot> readCurTime \<lblot>\<lambda>r s. P r s \<and> r = ksCurTime s\<rblot>"
-  by (simp add: readCurTime_def asks_def obind_def ovalid_def)
-
-lemma ovalid_readRefillReady[rule_format, simp]:
-  "ovalid (\<lambda>s. \<forall>ko. ko_at' ko scp s \<longrightarrow> P (rTime (refillHd ko) \<le> ksCurTime s + kernelWCETTicks) s)
-              (readRefillReady scp) P"
-  unfolding readRefillReady_def readSchedContext_def ovalid_def
-  by (fastforce simp: obind_def split: option.split_asm
-                dest: use_ovalid[OF ovalid_readCurTime]
-               dest!: readObject_misc_ko_at')
-
-
-lemma refillReady_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko scp s \<longrightarrow> P (rTime (refillHd ko) \<le> ksCurTime s + kernelWCETTicks) s\<rbrace> refillReady scp \<lbrace>P\<rbrace>"
-  unfolding refillReady_def
-  by wpsimp (drule use_ovalid[OF ovalid_readRefillReady])
-
-lemma scActive_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko scp s \<longrightarrow> P (0 < scRefillMax ko) s\<rbrace> scActive scp \<lbrace>P\<rbrace>"
-  unfolding scActive_def
-  by wpsimp
-
-lemma getRefills_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko scp s \<longrightarrow> P (scRefills ko) s\<rbrace>
-   getRefills scp
-   \<lbrace>P\<rbrace>"
-  unfolding getRefills_def
-  by wpsimp
-
-lemma refillSufficient_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko scp s \<longrightarrow> P (minBudget \<le> refillsCapacity k (scRefills ko) (scRefillHead ko)) s\<rbrace> refillSufficient scp k \<lbrace>P\<rbrace>"
-  unfolding refillSufficient_def
-  apply (wpsimp wp: getRefills_wp)
-  by (clarsimp simp: sufficientRefills_def obj_at'_def)
-
-(* projection rewrites *)
-
-lemma pred_map_rewrite:
-  "pred_map P proj = opt_pred P proj"
-  by (fastforce simp: pred_map_def2 opt_pred_def)
-
-abbreviation sc_of2 :: "Structures_A.kernel_object \<rightharpoonup> Structures_A.sched_context" where
-  "sc_of2 ko \<equiv> case ko of kernel_object.SchedContext sc n \<Rightarrow> Some sc | _ \<Rightarrow> None"
-
-abbreviation scs_of2 :: "'z state \<Rightarrow> obj_ref \<rightharpoonup> Structures_A.sched_context" where
-  "scs_of2 \<equiv> (\<lambda>s. kheap s |> sc_of2)"
-
-lemma scs_of_rewrite:
-  "scs_of s = scs_of2 s"
-  by (fastforce simp: sc_heap_of_state_def opt_map_def
-              split: option.splits Structures_A.kernel_object.splits)
-
-abbreviation
-  "sc_replies_of2 s \<equiv> scs_of2 s ||> sc_replies"
-
-lemma sc_replies_of_rewrite:
-  "sc_replies_of s = sc_replies_of2 s"
-  by (fastforce simp: sc_heap_of_state_def sc_replies_of_scs_def opt_map_def map_project_def
-              split: option.splits Structures_A.kernel_object.splits)
-
-definition
-  sc_replies_relation2_2 ::
-  "(obj_ref \<rightharpoonup> obj_ref list) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> bool" where
-  "sc_replies_relation2_2 sc_repls scRepl replPrevs \<equiv>
-     \<forall>p replies. sc_repls p = Some replies \<longrightarrow> heap_ls replPrevs (scRepl p) replies"
-
-abbreviation sc_replies_relation2 :: "det_state \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "sc_replies_relation2 s s' \<equiv>
-    sc_replies_relation2_2 (sc_replies_of2 s) (scReplies_of s') (replyPrevs_of s')"
-
-lemmas sc_replies_relation2_def = sc_replies_relation2_2_def
-
-lemma sc_replies_relation_rewrite:
-  "sc_replies_relation s s' = sc_replies_relation2 s s'"
-  unfolding sc_replies_relation_def sc_replies_relation2_def sc_replies_of_rewrite
-  by simp
-
-definition is_active_sc2 where
-  "is_active_sc2 p s \<equiv> ((\<lambda>sc. 0 < sc_refill_max sc) |< scs_of2 s) p"
-
-lemma is_active_sc_rewrite:
-  "is_active_sc p s = is_active_sc2 p s"
-  by (fastforce simp: is_active_sc2_def vs_all_heap_simps is_active_sc_def
-                      active_sc_def opt_map_red opt_map_def opt_pred_def
-               split: option.split_asm Structures_A.kernel_object.splits)
-
-abbreviation
-  "valid_refills2 scp s \<equiv>
-     ((\<lambda>sc. if sc_period sc = 0 then rr_valid_refills (sc_refills sc) (sc_refill_max sc) (sc_budget sc)
-      else sp_valid_refills (sc_refills sc) (sc_refill_max sc) (sc_period sc) (sc_budget sc)) |<
-     scs_of2 s) scp"
-
-lemmas valid_refills2_def = rr_valid_refills_def sp_valid_refills_def
-
-lemma valid_refills_rewrite:
-  "valid_refills scp s = valid_refills2 scp s"
-  by (fastforce simp: opt_map_red vs_all_heap_simps valid_refills_def opt_pred_def
-               elim!: opt_mapE
-               split: option.splits Structures_A.kernel_object.splits)
-
-definition
-  round_robin2 :: "obj_ref \<Rightarrow> 'z state \<Rightarrow> bool"
-where
-  "round_robin2 sc_ptr s \<equiv> ((\<lambda>sc. sc_period sc = 0) |< scs_of2 s) sc_ptr"
-
-lemma round_robin_rewrite:
-  "round_robin scp s = round_robin2 scp s"
-  by (clarsimp simp: round_robin_def round_robin2_def vs_all_heap_simps opt_map_def opt_pred_def
-               elim!: opt_mapE
-              split: option.splits Structures_A.kernel_object.splits)
-
-abbreviation
-  sc_refills_sc_at2 where
-  "sc_refills_sc_at2 P scp s \<equiv> ((\<lambda>sc. P (sc_refills sc)) |< scs_of2 s) scp"
-
-lemma sc_refills_sc_at_rewrite:
-  "sc_refills_sc_at P scp s = sc_refills_sc_at2 P scp s"
-  by (fastforce simp: sc_refills_sc_at_def obj_at_def is_sc_obj opt_map_red opt_pred_def
-               elim!: opt_mapE
-               split: option.splits Structures_A.kernel_object.split_asm)
-
-lemmas projection_rewrites = pred_map_rewrite scs_of_rewrite is_active_sc_rewrite
-                             sc_heap_of_state_def sc_refills_sc_at_rewrite
-                             active_sc_at'_rewrite valid_refills_rewrite round_robin_rewrite
-
-lemma is_active_sc'_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes t: "is_active_sc2 ptr s"
-  shows "is_active_sc' ptr s'"
-  using assms
-  supply projection_rewrites[simp]
-  apply (clarsimp simp: projectKOs is_active_sc2_def is_active_sc'_def opt_pred_def
-                 split: option.split_asm Structures_A.kernel_object.split_asm elim!: opt_mapE)
-  apply (drule (1) pspace_relation_absD, clarsimp split: if_split_asm)
-  by (case_tac z; simp add: sc_relation_def opt_map_red)
-
-lemma set_refills_is_active_sc2[wp]:
-  "set_refills ptr new \<lbrace>is_active_sc2 ptr'\<rbrace>"
-  apply (wpsimp simp: is_active_sc2_def wp: set_refills_wp)
-  by (clarsimp simp: obj_at_def opt_map_def opt_pred_def)
-
-(* end : projection rewrites *)
-
-(* updateSchedContext *)
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemma state_relation_sc_update:
-  assumes
-      R1: "\<forall>s s'. (s, s') \<in> state_relation \<longrightarrow>
-         P s \<longrightarrow> P' s' \<longrightarrow> sc_at ptr s \<longrightarrow> sc_at' ptr s' \<longrightarrow>
-           (\<forall>n. (((\<lambda>ko. obj_bits ko = min_sched_context_bits + n) |< kheap s) ptr) \<longrightarrow>
-           sc_relation (the ((scs_of2 s ||> f) ptr)) n (the ((scs_of' s' ||> f') ptr)))"
-  and R2: "\<forall>s s'. (s, s') \<in> state_relation \<longrightarrow>
-         P s \<longrightarrow> P' s' \<longrightarrow> sc_at ptr s \<longrightarrow> sc_at' ptr s' \<longrightarrow>
-           heap_ls (replyPrevs_of s')  (scReply (the ((scs_of' s' ||> f') ptr)))
-             (sc_replies (the ((scs_of2 s ||> f) ptr)))"
-  and sz: "\<forall>sc'::sched_context. objBits sc' = objBits (f' sc')"
-  shows
-  "\<lbrakk>(s, s') \<in> state_relation; P s; P' s'; sc_at ptr s; sc_at' ptr s'\<rbrakk> \<Longrightarrow>
-     (kheap_update (\<lambda>hp p. if p = ptr
-                           then
-                             case hp ptr of
-                                Some (kernel_object.SchedContext sc n)
-                                   \<Rightarrow> Some (kernel_object.SchedContext (f sc) n)
-                               | _ \<Rightarrow> hp ptr
-                           else hp p) s,
-     (ksPSpace_update (\<lambda>hp' p. if p = ptr
-                               then case hp' ptr of
-                                  Some (KOSchedContext sc')
-                                     \<Rightarrow> Some (KOSchedContext (f' sc'))
-                                 | _ \<Rightarrow> hp' ptr
-                                else hp' p)) s') \<in> state_relation"
-  supply pred_map_rewrite[simp] scs_of_rewrite[simp] opt_map_red[simp]
-         sc_replies_of_rewrite[simplified, simp]
-  proof -
-  have z': "\<And>s. sc_at' ptr s
-               \<Longrightarrow> \<forall>sc'::sched_context. map_to_ctes ((\<lambda>hp' p. if p = ptr then case hp' ptr of
-                              Some (KOSchedContext sc') \<Rightarrow> Some (KOSchedContext (f' sc'))
-                            | _ \<Rightarrow> hp' ptr else hp' p) (ksPSpace s)) = map_to_ctes (ksPSpace s)"
-    by (clarsimp simp: obj_at_simps fun_upd_def[symmetric])
-  have z: "\<And>s sc'::sched_context. ko_at' sc' ptr s
-               \<Longrightarrow> map_to_ctes ((ksPSpace s)(ptr \<mapsto> KOSchedContext (f' sc'))) = map_to_ctes (ksPSpace s)"
-    by (clarsimp simp: obj_at_simps)
-  assume H: "(s, s') \<in> state_relation" "P s" "P' s'" "sc_at ptr s" "sc_at' ptr s'"
-  show ?thesis
-    using H sz
-    apply -
-    apply (insert R1[rule_format, OF H]
-                  R2[rule_format, OF H])
-    apply (clarsimp simp: state_relation_def)
-    apply (clarsimp simp: obj_at_def is_sc_obj)
-    apply (prop_tac "obj_at (same_caps (kernel_object.SchedContext _ n)) ptr s")
-     apply (clarsimp simp: obj_at_def obj_bits_def)
-    apply (clarsimp simp: obj_at'_def projectKOs fun_upd_def[symmetric]
-                          z[simplified obj_at'_def projectKO_eq projectKO_opts_defs])
-    apply (rename_tac n sc sc')
-    apply (rule conjI)
-     (* pspace_relation *)
-     apply (simp only: pspace_relation_def simp_thms
-                       pspace_dom_update[where x="kernel_object.SchedContext _ _"
-                                           and v="kernel_object.SchedContext _ _",
-                                         simplified a_type_def, simplified])
-     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: project_inject opt_pred_def
-                    split: if_split_asm kernel_object.split_asm)
-     apply (drule_tac x=sc' in spec)
-     apply (rename_tac bb aa ba)
-     apply (drule_tac x="(aa, ba)" in bspec, simp)
-     apply (clarsimp simp: objBits_def)
-     apply (frule_tac ko'="kernel_object.SchedContext sc n" and x'=ptr in obj_relation_cut_same_type)
-        apply simp+
-     apply (erule obj_relation_cutsE)
-            apply ((simp split: if_split_asm)+)[8]
-    (* sc_replies_relation *)
-    apply (frule (2) sc_replies_relation_prevs_list[simplified])
-    apply (subst replyPrevs_of_non_reply_update[simplified]; (simp add: typ_at'_def ko_wp_at'_def)?)
-    apply (simp add: sc_replies_relation_def)
-    apply (rule conjI)
-     (* ghost relation *)
-     apply (clarsimp simp add: ghost_relation_def)
-     apply (erule_tac x=ptr in allE)+
-     apply (clarsimp simp: obj_at_def a_type_def is_sc_obj
-                     split: Structures_A.kernel_object.splits if_split_asm)
-    apply (rule conjI)
-     (* cdt_relation *)
-     apply (clarsimp simp add: cte_wp_at_cases cdt_relation_def)
-    (* revokable_relation *)
-    apply (prop_tac "kheap_update
-                      (\<lambda>hp x.
-                          if x = ptr
-                          then case hp ptr of None \<Rightarrow> hp ptr
-                               | Some (kernel_object.SchedContext sc n) \<Rightarrow>
-                                   Some (kernel_object.SchedContext (f sc) n)
-                               | Some _ \<Rightarrow> hp ptr
-                          else hp x) s
-             = s\<lparr> kheap := (kheap s)(ptr \<mapsto> kernel_object.SchedContext (f sc) n)\<rparr>" )
-     apply (clarsimp simp: fun_upd_def cong: if_cong)
-    apply (simp only: fun_upd_def)
-    apply (simp add: caps_of_state_after_update)
-    done
-qed
-
-(* update wp rules without ko_at' *)
-lemma updateSchedContext_wp:
-  "\<lbrace> \<lambda>s. sc_at' sc_ptr s \<longrightarrow>
-       Q (s\<lparr>ksPSpace := (ksPSpace s)(sc_ptr \<mapsto> KOSchedContext (f' (the (scs_of' s sc_ptr))))\<rparr>) \<rbrace>
-   updateSchedContext sc_ptr f'
-   \<lbrace> \<lambda>rv. Q \<rbrace>"
-  by (wpsimp simp: updateSchedContext_def wp: set_sc'.set_wp)
-     (clarsimp simp: obj_at'_def projectKOs opt_map_red elim!: rsubst[where P=Q])
-
-lemma no_fail_setSchedContext[wp]:
-  "no_fail (sc_at' ptr and (\<lambda>s'. ((\<lambda>k::sched_context. objBits k = objBits new) |< scs_of' s') ptr))
-           (setSchedContext ptr new)"
-  unfolding setSchedContext_def by (wpsimp simp: opt_map_def obj_at'_def projectKOs opt_pred_def)
-
-lemma no_fail_updateSchedContext[wp]:
-  "no_fail (sc_at' ptr and (\<lambda>s'. ((\<lambda>k::sched_context. objBits k = objBits (f k)) |< scs_of' s') ptr))
-           (updateSchedContext ptr f)"
-  by (wpsimp simp: updateSchedContext_def obj_at'_def projectKOs opt_map_def opt_pred_def)
-
-lemma update_sched_context_rewrite:
-  "monadic_rewrite False True (sc_obj_at n scp)
-    (update_sched_context scp f)
-      (do sc \<leftarrow> get_sched_context scp;
-          set_object scp (kernel_object.SchedContext (f sc) n) od)"
-  apply (clarsimp simp: update_sched_context_def get_sched_context_def bind_assoc)
-  apply (rule monadic_rewrite_bind_tail)
-   defer
-   apply (rule get_object_sp)
-  apply (case_tac obj; clarsimp simp: monadic_rewrite_pre_imp_eq set_object_def)
-  apply (rule monadic_rewrite_bind_tail)
-   defer
-   apply (rule get_object_sp)
-  apply (clarsimp simp: monadic_rewrite_def obj_at_def is_sc_obj_def)
-  done
-
-lemmas sc_inv_state_eq' = getObject_sc_inv[THEN use_valid[rotated], rotated
-                                           , where s=s and P="(=) s" for s, OF _ refl]
-
-lemma sc_inv_state_eq:
-  "(a :: sched_context, s') \<in> fst (getSchedContext p s) \<Longrightarrow> s' = s"
-  by (fastforce dest: sc_inv_state_eq' simp: getSchedContext_def)
-
-lemma getObject_idempotent:
-  "monadic_rewrite False True (sc_at' ptr)
-   (do rv \<leftarrow> (getObject ptr :: sched_context kernel);
-       getObject ptr
-    od)
-   (getObject ptr :: sched_context kernel)"
-  apply (clarsimp simp: monadic_rewrite_def)
-  apply (rule monad_state_eqI)
-    apply ((clarsimp simp: in_monad getObject_def split_def
-                           loadObject_default_def projectKOs scBits_pos_power2 objBits_simps'
-                           lookupAround2_known1 in_magnitude_check)+)[2]
-  apply (fastforce dest!: sc_inv_state_eq[simplified getSchedContext_def]
-                          no_fail_getObject_misc[simplified no_fail_def, rule_format]
-                    simp: snd_bind)
-  done
-
-lemma getSchedContext_setSchedContext_decompose:
-   "monadic_rewrite False True
-     (sc_at' scPtr and K (\<forall>sc. objBits (f sc) = objBits sc) and K (\<forall>sc. objBits (g sc) = objBits sc))
-     (do sc \<leftarrow> getSchedContext scPtr;
-         setSchedContext scPtr (g (f sc))
-      od)
-     (do sc \<leftarrow> getSchedContext scPtr;
-         setSchedContext scPtr (f sc);
-         sc \<leftarrow> getSchedContext scPtr;
-         setSchedContext scPtr (g sc)
-      od)"
-  apply (clarsimp simp: monadic_rewrite_def)
-  apply (rule monad_state_eqI)
-    apply (simp add: in_monad getSchedContext_def getObject_def)
-    apply (frule no_ofailD[OF no_ofail_sc_at'_readObject])
-    apply (clarsimp del: readObject_misc_ko_at' simp del: readObject_misc_obj_at')
-    apply (clarsimp simp: setSchedContext_def setObject_def obj_at'_def projectKOs objBits_simps'
-                          in_monad scBits_pos_power2 updateObject_default_def
-                          in_magnitude_check ps_clear_upd magnitudeCheck_assert split_def
-                     del: readObject_misc_ko_at'
-                   split: option.split_asm)
-     apply (rename_tac sc sc')
-     apply (rule_tac x="f sc" in exI)
-     apply (rule conjI;
-            fastforce simp: readObject_def obind_def omonad_defs split_def
-                            ps_clear_upd loadObject_default_def lookupAround2_known1 projectKOs
-                            objBits_simps' scBits_pos_power2 lookupAround2_None2 lookupAround2_char2
-                     split: option.splits if_split_asm dest!: readObject_misc_ko_at')
-    apply (rename_tac sc p sc')
-    apply (rule_tac x="f sc" in exI)
-    apply (rule conjI)
-     apply (thin_tac "scSize _ = _")
-     apply (clarsimp simp: readObject_def obind_def omonad_defs fun_upd_def split_def
-                           ps_clear_upd loadObject_default_def lookupAround2_known1 projectKOs
-                           objBits_simps' scBits_pos_power2 lookupAround2_None2 lookupAround2_char2
-                    split: option.splits if_split_asm)
-     apply (metis option.simps(3) word_le_less_eq word_le_not_less)
-    apply (clarsimp simp: split: option.splits)
-    apply (metis (no_types) array_rules(2) lookupAround2_char2 mcs(1) order.strict_trans2
-                            word_le_less_eq word_le_not_less)
-   apply (simp add: in_monad getSchedContext_def getObject_def)
-   apply (frule no_ofailD[OF no_ofail_sc_at'_readObject])
-   apply (clarsimp del: readObject_misc_ko_at' simp del: readObject_misc_obj_at')
-   apply (clarsimp simp: setSchedContext_def setObject_def projectKOs in_monad ps_clear_upd obj_at'_def
-                         split_def updateObject_default_def magnitudeCheck_assert
-                  dest!: readObject_misc_ko_at')
-
-   apply (frule no_failD[OF no_fail_getMiscObject(4)])
-  apply (simp add: snd_bind)
-  apply (rule iffI; clarsimp simp: snd_bind split_def setSchedContext_def; rename_tac sc s')
-   apply (frule sc_inv_state_eq, simp)
-   apply (rule_tac x="(sc, s)" in bexI[rotated], simp)
-   apply (rule disjI2)
-   apply (drule use_valid[OF _ get_sc_ko'], simp)
-   apply (clarsimp simp: obj_at'_def)
-   apply (prop_tac "obj_at' (\<lambda>k. objBits k = objBits (g (f sc))) scPtr s")
-    apply (clarsimp simp: obj_at'_def)
-    apply (rule_tac x=sc in exI, clarsimp simp: projectKO_opt_sc)
-   apply (drule_tac ob1="g (f sc)" in no_failD[OF no_fail_setObject_other, rotated])
-    apply simp
-   apply clarsimp
-  apply (frule sc_inv_state_eq, simp)
-  apply (rule_tac x="(sc, s)" in bexI[rotated], simp)
-  apply (drule use_valid[OF _ get_sc_ko'], simp)
-  apply (erule disjE; clarsimp)
-   apply (clarsimp simp: obj_at'_def projectKOs)
-   apply (prop_tac "obj_at' (\<lambda>k. objBits k = objBits (f sc)) scPtr s")
-    apply (clarsimp simp: obj_at'_def projectKOs projectKO_opt_sc)
-    apply (rule_tac x=sc in exI, clarsimp simp: projectKO_opt_sc)
-   apply (drule_tac ob1="(f sc)" in no_failD[OF no_fail_setObject_other, rotated])
-    apply simp+
-
-  apply (rename_tac s'; erule disjE; clarsimp?)
-   apply (drule_tac Q2="\<lambda>s'. s' = (s\<lparr>ksPSpace := (ksPSpace s)(scPtr \<mapsto> injectKO (f sc))\<rparr>)"
-                 in use_valid[OF _ setObject_sc_wp])
-    apply simp+
-
-   apply (prop_tac "sc_at' scPtr (s\<lparr>ksPSpace := (ksPSpace s)(scPtr \<mapsto> KOSchedContext (f sc))\<rparr>)")
-    apply (clarsimp simp: obj_at'_def objBits_simps' ps_clear_upd projectKOs)
-   apply (frule_tac s="s\<lparr>ksPSpace := (ksPSpace s)(scPtr \<mapsto> KOSchedContext (f sc))\<rparr>"
-                 in no_failD[OF no_fail_getMiscObject(4)])
-   apply clarsimp
-
-  apply (rename_tac s')
-  apply (drule_tac Q2="\<lambda>s'. s' = (s\<lparr>ksPSpace := (ksPSpace s)(scPtr \<mapsto> injectKO (f sc))\<rparr>)"
-                in use_valid[OF _ setObject_sc_wp])
-   apply simp+
-
-  apply (frule sc_inv_state_eq, simp)
-  apply (drule use_valid[OF _ get_sc_ko'], simp)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (prop_tac "obj_at' (\<lambda>k. objBits k = objBits (g (f sc))) scPtr
-                           (s\<lparr>ksPSpace := (ksPSpace s)(scPtr \<mapsto> KOSchedContext (f sc))\<rparr>)")
-   apply (clarsimp simp: obj_at'_def projectKOs)
-   apply (rule_tac x="f sc" in exI, clarsimp)
-  apply (drule_tac ob1="g (f sc)" in no_failD[OF no_fail_setObject_other, rotated])
-   apply simp+
-  done
-
-lemmas getSchedContext_setSchedContext_decompose_decompose_ext
-  = getSchedContext_setSchedContext_decompose[where f="f x" and g="g y" for f g x y]
-lemmas getSchedContext_setSchedContext_decompose_decompose2
-  = getSchedContext_setSchedContext_decompose[where g="\<lambda>sc. g (h sc)" for g h]
-lemmas getSchedContext_setSchedContext_decompose_decompose_ext2
-  = getSchedContext_setSchedContext_decompose[where f="f x" and g="g y" for f g x y]
-
-(* rewrite rules for updateSchedContext *)
-lemma updateSchedContext_decompose:
-   "monadic_rewrite False True
-     (sc_at' scPtr and K (\<forall>sc. objBits (f sc) = objBits sc) and K (\<forall>sc. objBits (g sc) = objBits sc))
-     (updateSchedContext scPtr (g o f))
-     (do updateSchedContext scPtr f;
-         updateSchedContext scPtr g
-      od)"
-  unfolding updateSchedContext_def bind_assoc o_def
-  using getSchedContext_setSchedContext_decompose by blast
-
-lemma updateSchedContext_decompose_fold:
-  "\<lbrakk>\<forall>f\<in> set fs. \<forall>sc. objBits (f sc) = objBits sc; \<forall>sc. objBits (f sc) = objBits sc\<rbrakk> \<Longrightarrow>
-   monadic_rewrite False True
-     (sc_at' scPtr)
-     (updateSchedContext scPtr (fold (o) fs f))
-     (do _ \<leftarrow> updateSchedContext scPtr f;
-        mapM_x (updateSchedContext scPtr) fs
-      od)"
-  apply (induction fs arbitrary: f)
-   apply (clarsimp simp: mapM_x_Nil)
-   apply (rule monadic_rewrite_guard_imp)
-    apply (rule monadic_rewrite_refl, simp)
-  apply (clarsimp simp: mapM_x_Cons)
-  apply (drule_tac x="a o f" in meta_spec)
-  apply (rule monadic_rewrite_guard_imp)
-   apply (rule monadic_rewrite_trans)
-    apply simp
-   apply (subst bind_assoc[symmetric])
-   apply (rule monadic_rewrite_guard_imp)
-    apply (rule monadic_rewrite_bind_head)
-    apply (rule updateSchedContext_decompose[simplified])
-   apply simp
-  apply simp
+  apply (clarsimp simp: bit_simps objBits_simps' word_bits_def
+                 split: kernel_object.splits arch_kernel_object.splits)
   done
 
-lemmas updateSchedContext_decompose_x2 = updateSchedContext_decompose_fold[where fs="[g, h]" for f g h,
- simplified mapM_x_Cons mapM_x_Nil fold_Cons fold_Nil id_def, simplified]
-
-lemmas updateSchedContext_decompose_x3 = updateSchedContext_decompose_fold[where fs="[g, h, k]" for f g h k,
- simplified mapM_x_Cons mapM_x_Nil fold_Cons fold_Nil id_def, simplified]
-
-lemma updateSchedContext_corres_gen:
-  assumes
-      R1: "\<forall>s s'. (s, s') \<in> state_relation \<longrightarrow>
-           P s \<longrightarrow> P' s' \<longrightarrow> sc_at ptr s \<longrightarrow> sc_at' ptr s' \<longrightarrow>
-           (\<forall>n. (((\<lambda>ko. obj_bits ko = min_sched_context_bits + n) |< kheap s) ptr)\<longrightarrow>
-           sc_relation (the ((scs_of2 s ||> f) ptr)) n (the ((scs_of' s' ||> f') ptr)))"
-  and R2: "\<forall>s s'. (s, s') \<in> state_relation \<longrightarrow>
-          P s \<longrightarrow> P' s' \<longrightarrow> sc_at ptr s \<longrightarrow> sc_at' ptr s' \<longrightarrow>
-           heap_ls (replyPrevs_of s')  (scReply (the ((scs_of' s' ||> f') ptr)))
-             (sc_replies (the ((scs_of2 s ||> f) ptr)))"
-  and sz: "\<forall>sc'::sched_context. objBits sc' = objBits (f' sc')"
-  shows "corres dc
-         (sc_at ptr and P)
-         (sc_at' ptr and P')
-            (update_sched_context ptr f)
-            (updateSchedContext ptr f')"
-  unfolding corres_underlying_def using sz
-  apply clarsimp
-  apply (rename_tac s s')
-  apply (drule obj_at_ko_at)
-  apply (drule obj_at_ko_at')
-  apply (clarsimp simp: is_sc_obj)
-  apply (rename_tac sc' n sc)
-  apply (rule conjI, clarsimp)
-   apply (erule use_valid[OF _ updateSchedContext_wp])
-   apply clarsimp
-   apply (rule_tac x="((), s\<lparr>kheap := (kheap s)(ptr \<mapsto>
-                  kernel_object.SchedContext (f sc) n)\<rparr>)" in bexI)
-    apply clarsimp
-    apply (drule state_relation_sc_update[OF R1 R2 sz, simplified])
-      apply ((fastforce simp: obj_at_def is_sc_obj obj_at'_def projectKOs)+)[4]
-    apply (clarsimp simp: obj_at_def obj_at'_def projectKOs fun_upd_def[symmetric] opt_map_red)
-    apply (case_tac s; case_tac s'; fastforce)
-   apply (clarsimp simp: update_sched_context_def obj_at_def in_monad
-                         get_object_def set_object_def a_type_def)
-  apply (clarsimp intro!: no_failD[OF no_fail_updateSchedContext]
-                    simp: obj_at'_def projectKOs opt_map_def opt_pred_def)
+lemma aligned'_distinct'_ko_wp_at'I:
+  "\<lbrakk>ksPSpace s' x = Some ko; P ko; pspace_aligned' s'; pspace_distinct' s'\<rbrakk>
+   \<Longrightarrow> ko_wp_at' P x s'"
+  apply (simp add: ko_wp_at'_def pspace_distinct'_def pspace_aligned'_def)
+  apply (drule bspec, erule domI)+
+  apply (cases ko; force)
   done
 
-lemmas updateSchedContext_corres = updateSchedContext_corres_gen[where P=\<top> and P'=\<top>, simplified]
-
-(* end : updateSchedContext *)
+lemma aligned'_distinct'_ko_at'I:
+  "\<lbrakk>ksPSpace s' x = Some ko;  pspace_aligned' s'; pspace_distinct' s';
+    ko = injectKO (v:: 'a :: pspace_storable)\<rbrakk>
+   \<Longrightarrow> ko_at' v x s'"
+  by (fastforce elim: aligned'_distinct'_ko_wp_at'I simp: obj_at'_real_def project_inject)
 
+lemmas setEndpoint_valid_globals[wp]
+    = valid_global_refs_lift' [OF set_ep_ctes_of set_ep_arch'
+                                  setEndpoint_it setEndpoint_ksInterruptState]
 end
-
-(* this let us cross the sc size information from concrete to abstract *)
-lemma ko_at_sc_cross:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes t: "ko_at' (sc'::sched_context) ptr s'"
-  shows "sc_obj_at (objBits sc' - minSchedContextBits) ptr s" using assms
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (erule (1) pspace_dom_relatedE)
-  by (clarsimp simp: obj_relation_cuts_def2 obj_at_def is_sc_obj cte_relation_def
-                     other_obj_relation_def pte_relation_def pde_relation_def
-                     scBits_simps sc_relation_def objBits_simps
-              split: Structures_A.kernel_object.split_asm if_split_asm
-                     ARM_A.arch_kernel_obj.split_asm)
-
-lemma update_sc_no_reply_stack_update_ko_at'_corres:
-  assumes x: "\<And>sc n. sc_relation sc n sc' \<longrightarrow> sc_relation (f sc) n (f' sc')"
-  assumes y: "\<And>sc. sc_replies sc = sc_replies (f sc)"
-  assumes z: "objBits sc' = objBits (f' sc')"
-  assumes r: "scReply sc' = scReply (f' sc')"
-  shows
-    "corres dc (sc_at ptr) (ko_at' sc' ptr)
-            (update_sched_context ptr f)
-            (setSchedContext ptr (f' sc'))"
-  unfolding update_sched_context_def
-  apply (rule corres_guard_imp)
-    apply (rule corres_symb_exec_l'[where Q'="\<lambda>r s. ko_at r ptr s \<and> (\<exists>n. is_sc_obj n r)",
-                                    where P="\<lambda>s. obj_at \<top> ptr s"])
-      apply (rule corres_guard_imp[where P'=R and Q'=R for R])
-        apply (rule_tac F="(\<exists>n. is_sc_obj n obj)" in corres_gen_asm)
-        apply (case_tac obj; simp add: is_sc_obj_def)
-        apply (rule setSchedContext_no_stack_update_corres[where f'=f'])
-           apply (clarsimp simp: x obj_at_def intro!: y z r)+
-     apply (fastforce simp: exs_valid_def get_object_def in_monad)
-    apply (wpsimp wp: get_object_wp)
-   apply (fastforce simp: obj_at_def)
-  apply simp
-  done
-
-lemma update_sc_no_reply_stack_update_corres:
-  "\<lbrakk>\<forall>sc n sc'. sc_relation sc n sc' \<longrightarrow> sc_relation (f sc) n (f' sc');
-    \<forall>sc. sc_replies sc = sc_replies (f sc); \<forall>sc'. objBits sc' = objBits (f' sc');
-    \<forall>sc'. scReply (f' sc') = scReply sc' \<rbrakk> \<Longrightarrow>
-   corres dc (sc_at ptr and pspace_aligned and pspace_distinct) \<top>
-          (update_sched_context ptr f)
-         (do sc' <- getSchedContext ptr;
-             setSchedContext ptr (f' sc')
-          od)"
-  apply (rule_tac Q="sc_at' ptr" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD sc_at_cross simp: obj_at'_def)
-  apply (rule corres_symb_exec_r)
-     apply (rule corres_guard1_imp)
-      apply (rule update_sc_no_reply_stack_update_ko_at'_corres; simp)
-     apply clarsimp
-    apply (wpsimp wp: get_sched_context_exs_valid simp: is_sc_obj_def obj_at_def)
-   apply (rename_tac ko; case_tac ko; simp)
-   apply (wpsimp simp: obj_at_def is_sc_obj_def)+
-  done
-
-lemma ko_at'_inj:
-  "ko_at' ko ptr  s \<Longrightarrow> ko_at' ko' ptr s \<Longrightarrow> ko' = ko"
-  by (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-
-(* FIXME RT: Move these to AInvs where possible *)
-(* FIXME RT: Try to unify with existing notions.
-             See https://sel4.atlassian.net/browse/VER-1382 *)
-definition injective_ref where
-  "injective_ref ref heap \<equiv> (\<forall>q p1 p2. (p1, ref) \<in> heap q \<and> (p2, ref) \<in> heap q \<longrightarrow> p1 = p2)"
-
-lemma sym_refs_inj:
-  "\<lbrakk>sym_refs heap; injective_ref (symreftype ref) heap; (x, ref) \<in> heap y; (x, ref) \<in> heap y'\<rbrakk>
-   \<Longrightarrow> y = y' "
-  apply (clarsimp simp: sym_refs_def injective_ref_def)
-  apply fastforce
-  done
-
-lemma sym_refs_inj2:
-  "\<lbrakk>sym_refs heap; injective_ref ref heap; (x, ref) \<in> heap y; (y, symreftype ref) \<in> heap z\<rbrakk>
-   \<Longrightarrow> x = z "
-  apply (subgoal_tac "(y, symreftype ref) \<in> heap x")
-   apply (erule (3) sym_refs_inj[where ref="symreftype ref", simplified])
-  apply (fastforce simp: sym_refs_def)
-  done
-
-lemma injective_ref_SCTcb[simp]:
-  "injective_ref SCTcb (state_refs_of' s) "
-  apply (clarsimp simp: state_refs_of'_def injective_ref_def split: option.splits if_splits)
-  apply (clarsimp simp: refs_of'_def)
-  apply (rename_tac p0 ko p1 p2)
-  apply (prop_tac "\<exists>z. ko = KOSchedContext z")
-   apply (clarsimp split: kernel_object.splits)
-      apply (clarsimp split: Structures_H.endpoint.splits simp: ep_q_refs_of'_def)
-     apply (clarsimp split: Structures_H.ntfn.splits option.splits
-                      simp: ntfn_q_refs_of'_def get_refs_def)
-    apply (clarsimp simp: tcb_st_refs_of'_def tcb_bound_refs'_def get_refs_def
-                   split: Structures_H.thread_state.splits if_splits option.splits)
-   apply (clarsimp simp: get_refs_def split: option.splits)
-  apply (clarsimp simp: get_refs_def split: option.splits)
-  done
-
-lemma reply_at'_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and reply_at t) (reply_at' t)"
-  unfolding cross_rel_def state_relation_def
-  apply clarsimp
-  by (erule (3) reply_at_cross)
-
-lemma sch_act_simple_cross_rel:
-  "cross_rel simple_sched_action sch_act_simple"
-  apply (clarsimp simp: cross_rel_def)
-  by (fastforce simp: simple_sched_action_def sch_act_simple_def
-                dest: state_relation_sched_act_relation
-               split: Structures_A.scheduler_action.splits)
-
-lemma valid_tcb_state'_simps[simp]:
-  "valid_tcb_state' Running = \<top>"
-  "valid_tcb_state' Inactive = \<top>"
-  "valid_tcb_state' Restart = \<top>"
-  "valid_tcb_state' IdleThreadState = \<top>"
-  "valid_tcb_state' (BlockedOnSend ref b c d e) = ep_at' ref"
-  "valid_tcb_state' (BlockedOnReply r) = valid_bound_reply' r"
-  by (rule ext, simp add: valid_tcb_state'_def)+
-
-lemma tcb_at'_ex1_ko_at':
-  "tcb_at' t s \<Longrightarrow> \<exists>!tcb. ko_at' (tcb::tcb) t s"
-  by (clarsimp simp: obj_at'_def)
-
-lemma ex1_ex_eq_all:
-  "\<exists>!x. Q x \<Longrightarrow> (\<exists>x. Q x \<and> P x) = (\<forall>x. Q x \<longrightarrow> P x)"
-  by fastforce
-
-lemmas tcb_at'_ex_eq_all = ex1_ex_eq_all[OF tcb_at'_ex1_ko_at']
-
-lemma receiveBlocked_equiv:
-  "receiveBlocked st = is_BlockedOnReceive st"
-  unfolding receiveBlocked_def
-  by (case_tac st; simp)
-
-lemma threadGet_getObject:
-  "threadGet f t = do x <- getObject t;
-                         return (f x)
-                   od"
-  apply (simp add: threadGet_def threadRead_def oliftM_def getObject_def[symmetric])
-  done
-
-lemma obj_at'_typ_at'[elim!]:
-  "obj_at' (P :: ('a :: pspace_storable) \<Rightarrow> bool) p s \<Longrightarrow>
-   obj_at' (\<top> :: ('a :: pspace_storable) \<Rightarrow> bool) p s"
-  by (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-
-lemma shows
-  obj_at'_sc_tcbs_of_equiv:
-    "obj_at' (\<lambda>x. scTCB x = Some t) p s = (sc_at' p s \<and> scTCBs_of s p = Some t)"
-  and obj_at'_tcb_scs_of_equiv:
-    "obj_at' (\<lambda>x. tcbSchedContext x = Some sc) p s = (tcb_at' p s \<and> tcbSCs_of s p = Some sc)"
-  and obj_at'_replySCs_of_equiv:
-    "obj_at' (\<lambda>a. replyNext a = Some (Head sc)) p s = (reply_at' p s \<and> replySCs_of s p = Some sc)"
-  and obj_at'_scReplies_of_equiv:
-    "obj_at' (\<lambda>a. scReply a = Some sc) p s = (sc_at' p s \<and> scReplies_of s p = Some sc)"
-  by (intro iffI; clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs opt_map_def)+
-
-lemma not_idle_scTCB:
-  "\<lbrakk>sym_heap_tcbSCs s; valid_objs' s; valid_idle' s; p \<noteq> idle_sc_ptr; sc_at' p s\<rbrakk> \<Longrightarrow>
-   obj_at' (\<lambda>x. scTCB x \<noteq> Some idle_thread_ptr) p s"
-  apply (subgoal_tac "\<not>obj_at' (\<lambda>x. scTCB x = Some idle_thread_ptr) p s")
-   apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-  apply (subst (asm) sym_heap_symmetric)
-  apply (clarsimp simp: obj_at'_sc_tcbs_of_equiv sym_heap_def)
-  apply (clarsimp simp: valid_idle'_def obj_at'_real_def ko_wp_at'_def idle_tcb'_def projectKOs
-                 elim!: opt_mapE)
-  done
-
-lemma not_idle_tcbSC:
-  "\<lbrakk>sym_heap_tcbSCs s; valid_objs' s; valid_idle' s; p \<noteq> idle_thread_ptr; tcb_at' p s\<rbrakk> \<Longrightarrow>
-   obj_at' (\<lambda>x. tcbSchedContext x \<noteq> Some idle_sc_ptr) p s"
-  apply (subgoal_tac "\<not>obj_at' (\<lambda>x. tcbSchedContext x = Some idle_sc_ptr) p s")
-   apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-  apply (clarsimp simp: obj_at'_tcb_scs_of_equiv sym_heap_def)
-  apply (clarsimp simp: valid_idle'_def obj_at'_real_def ko_wp_at'_def idle_tcb'_def projectKOs
-                 elim!: opt_mapE)
-  done
-
-lemma setObject_tcb_tcbs_of':
-  "\<lbrace>\<lambda>s. P' ((tcbs_of' s)(c \<mapsto> tcb))\<rbrace>
-  setObject c (tcb::tcb)
-  \<lbrace>\<lambda>_ s. P' (tcbs_of' s)\<rbrace>"
-  by (setObject_easy_cases, clarsimp simp: ARM_H.fromPPtr_def)
-
-lemma setObject_other_tcbs_of'[wp]:
-  "setObject c (r::reply) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
-  "setObject c (e::endpoint) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
-  "setObject c (n::notification) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
-  "setObject c (sc::sched_context) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
-  by setObject_easy_cases+
-
-lemma setObject_cte_tcbSCs_of[wp]:
-  "setObject c (reply::cte) \<lbrace>\<lambda>s. P' (tcbSCs_of s)\<rbrace>"
-  by setObject_easy_cases
-
-lemma threadSet_tcbSCs_of_inv:
-  "\<forall>x. tcbSchedContext (f x) = tcbSchedContext x \<Longrightarrow>
-  threadSet f t \<lbrace>\<lambda>s. P (tcbSCs_of s)\<rbrace>"
-  unfolding threadSet_def
-  apply (rule bind_wp[OF _ get_tcb_sp'])
-  apply (wpsimp wp: setObject_tcb_tcbs_of')
-  apply (erule subst[where P=P, rotated], rule ext)
-  apply (clarsimp simp: opt_map_def obj_at'_real_def ko_wp_at'_def projectKO_tcb
-                 split: option.splits)
-  done
-
-lemma aligned'_distinct'_obj_at'I:
-  "\<lbrakk> \<exists>y. ksPSpace s p = Some (injectKO (y:: 'a::pspace_storable));
-    pspace_aligned' s; pspace_distinct' s;
-    (if koTypeOf (the (ksPSpace s p))  = SchedContextT then pspace_bounded' s else True)\<rbrakk>
-   \<Longrightarrow> obj_at' (\<top> :: 'a::pspace_storable \<Rightarrow> bool) p s"
-  apply (clarsimp)
-  apply (frule_tac v=y in aligned'_distinct'_ko_at'I; simp?)
-  apply (case_tac "injectKO y"; clarsimp simp: valid_sz_simps dest!: pspace_boundedD')
-  done
-
-lemma sym_refs_tcbSCs:
-  "\<lbrakk>sym_refs (state_refs_of' s); pspace_aligned' s; pspace_distinct' s; pspace_bounded' s\<rbrakk>
-   \<Longrightarrow> sym_heap_tcbSCs s"
-  apply (clarsimp simp: sym_heap_def)
-  apply (rule iffI)
-   apply (drule_tac tp=SCTcb and x=p and y=p' in sym_refsE;
-          force simp: get_refs_def2 state_refs_of'_def projectKOs opt_map_red refs_of_rev'
-                dest: pspace_alignedD' pspace_distinctD' pspace_boundedD' elim!: opt_mapE
-               split: if_split_asm option.split_asm)+
-  by (drule_tac tp=TCBSchedContext and x=p' and y=p in sym_refsE;
-      force simp: get_refs_def2 state_refs_of'_def projectKOs opt_map_red refs_of_rev'
-            dest: pspace_alignedD' pspace_distinctD' pspace_boundedD'
-           elim!: opt_mapE split: if_split_asm option.split_asm)+
-
-lemma sym_refs_scReplies:
-  "\<lbrakk>sym_refs (state_refs_of' s); pspace_aligned' s; pspace_distinct' s; pspace_bounded' s\<rbrakk>
-   \<Longrightarrow> sym_heap_scReplies s"
-  apply (clarsimp simp: sym_heap_def)
-  apply (rule iffI)
-   apply (drule_tac tp=ReplySchedContext and x=p and y=p' in sym_refsE;
-          force simp: get_refs_def2 state_refs_of'_def projectKOs opt_map_red refs_of_rev'
-                dest: pspace_alignedD' pspace_distinctD' pspace_boundedD'
-               elim!: opt_mapE
-               split: if_split_asm option.split_asm)+
-  by (drule_tac tp=SCReply and x=p' and y=p in sym_refsE;
-      force simp: get_refs_def2 state_refs_of'_def projectKOs opt_map_red refs_of_rev'
-               dest: pspace_alignedD' pspace_distinctD' pspace_boundedD'
-              elim!: opt_mapE
-              split: if_split_asm option.split_asm)+
-
-lemma setSchedContext_scTCBs_of:
-  "\<lbrace>\<lambda>s. P (\<lambda>a. if a = scPtr then scTCB sc else scTCBs_of s a)\<rbrace>
-   setSchedContext scPtr sc
-   \<lbrace>\<lambda>_ s. P (scTCBs_of s)\<rbrace>"
-  unfolding setSchedContext_def
-  apply (wpsimp wp: setObject_sc_wp)
-  apply (erule back_subst[where P=P], rule ext)
-  by (clarsimp simp: opt_map_def)
-
-lemma setSchedContext_scReplies_of:
-  "\<lbrace>\<lambda>s. P (\<lambda>a. if a = scPtr then scReply sc else scReplies_of s a)\<rbrace>
-   setSchedContext scPtr sc
-   \<lbrace>\<lambda>_ s. P (scReplies_of s)\<rbrace>"
-  unfolding setSchedContext_def
-  apply (wpsimp wp: setObject_sc_wp)
-  apply (erule back_subst[where P=P], rule ext)
-  by (clarsimp simp: opt_map_def)
-
-lemma getObject_tcb_wp:
-  "\<lbrace>\<lambda>s. tcb_at' p s \<longrightarrow> (\<exists>t::tcb. ko_at' t p s \<and> Q t s)\<rbrace> getObject p \<lbrace>Q\<rbrace>"
-  by (clarsimp simp: getObject_def valid_def in_monad
-                     split_def objBits_simps' loadObject_default_def
-                     projectKOs obj_at'_def in_magnitude_check
-              dest!: readObject_misc_ko_at')
-
-
-lemma threadSet_tcbSCs_of:
-  "\<lbrace>\<lambda>s. P (\<lambda>a. if a = t then tcbSchedContext (f (the (tcbs_of' s a))) else tcbSCs_of s a)\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_ s. P (tcbSCs_of s)\<rbrace>"
-  unfolding threadSet_def
-  apply (wpsimp wp: setObject_tcb_wp getObject_tcb_wp)
-  apply (clarsimp simp: tcb_at'_ex_eq_all)
-  apply (erule back_subst[where P=P], rule ext)
-  apply (clarsimp simp: opt_map_def obj_at'_real_def ko_wp_at'_def projectKOs)
-  done
-
-lemma shows
-  replyNexts_Some_replySCs_None:
-  "replyNexts_of s rp \<noteq> None \<Longrightarrow> replySCs_of s rp = None" and
-  replySCs_Some_replyNexts_None:
-  "replySCs_of s rp \<noteq> None \<Longrightarrow> replyNexts_of s rp = None"
-  by (clarsimp simp: opt_map_def projectKOs split: option.splits reply_next.splits)+
-
-lemma sym_heap_remove_only:
-  "\<lbrakk> sym_heap h1 h2; h2 y = Some x \<rbrakk> \<Longrightarrow>
-   sym_heap (\<lambda>a. if a = x then None else h1 a) (\<lambda>a. if a = y then None else h2 a)"
-  supply opt_mapE [rule del]
-  apply (clarsimp simp: sym_heap_def)
-  apply (subst (asm) sym_heap_symmetric[simplified sym_heap_def], simp)
-  done
-
-lemma pred_tcb_at'_equiv:
-  "pred_tcb_at' p P t s = (tcb_at' t s \<and> P (p (tcb_to_itcb' (the (tcbs_of' s t)))))"
-  by (rule iffI;
-      clarsimp simp: pred_tcb_at'_def pred_map_def obj_at'_real_def ko_wp_at'_def projectKOs
-                     opt_map_def)
-
-lemma isBlockedOnSend_equiv:
-  "isBlockedOnSend st = is_BlockedOnSend st"
-  by (case_tac st; simp add: isBlockedOnSend_def)
-
-lemma isSend_equiv:
-  "isSend st = is_BlockedOnSend st"
-  by (case_tac st; simp add: isSend_def)
-
-lemma sch_act_wf_not_runnable_sch_act_not:
-  "\<lbrakk>st_tcb_at' P t s; sch_act_wf (ksSchedulerAction s) s; \<forall>st. P st \<longrightarrow> \<not> runnable' st\<rbrakk> \<Longrightarrow>
-   sch_act_not t s"
-   by (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-
-lemma isTimeoutFault_fault_map[simp]:
-  "isTimeoutFault (fault_map a) = is_timeout_fault a"
-  by (clarsimp simp: isTimeoutFault_def fault_map_def is_timeout_fault_def
-              split: ExceptionTypes_A.fault.splits)
-
-lemma valid_bound_obj_lift:
-  "f \<lbrace>P (the x)\<rbrace> \<Longrightarrow> f \<lbrace>valid_bound_obj P x\<rbrace>"
-  unfolding valid_bound_obj_def
-  by (case_tac x; wpsimp)
-
-lemma valid_bound_obj'_lift:
-  "f \<lbrace>P (the x)\<rbrace> \<Longrightarrow> f \<lbrace>valid_bound_obj' P x\<rbrace>"
-  unfolding valid_bound_obj'_def
-  by (case_tac x; wpsimp)
-
-lemma ep_at'_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and ep_at t) (ep_at' t)"
-  unfolding cross_rel_def state_relation_def
-  apply clarsimp
-  by (erule (3) ep_at_cross)
-
-lemma sch_act_not_cross_rel:
-  "cross_rel (scheduler_act_not t) (sch_act_not t)"
-  unfolding cross_rel_def state_relation_def
-  apply clarsimp
-  apply (case_tac "scheduler_action s"; simp)
-  by (clarsimp simp: scheduler_act_not_def sched_act_relation_def)
-
-global_interpretation set_simple_ko: typ_at_pres "set_simple_ko C ptr ep"
-  unfolding typ_at_pres_def by wpsimp
-
-global_interpretation update_sk_obj_ref: typ_at_pres "update_sk_obj_ref C update ref new"
-  unfolding typ_at_pres_def by wpsimp
-
-lemma getReprogramTimer_corres:
-  "corres (=) \<top> \<top> (gets reprogram_timer) getReprogramTimer"
-  by (clarsimp simp: getReprogramTimer_def state_relation_def)
-
-lemma setDomainTime_corres:
-  "dt = dt' \<Longrightarrow>
-  corres dc \<top> \<top> (modify (domain_time_update (\<lambda>_. dt))) (setDomainTime dt')"
-  apply (clarsimp simp: setDomainTime_def, rule corres_modify)
-  by (clarsimp simp: state_relation_def swp_def)
-
-lemma setConsumedTime_corres:
-  "ct = ct' \<Longrightarrow>
-  corres dc \<top> \<top> (modify (consumed_time_update (\<lambda>_. ct))) (setConsumedTime ct')"
-  apply (clarsimp simp: setConsumedTime_def, rule corres_modify)
-  by (clarsimp simp: state_relation_def swp_def)
-
-lemma setCurSc_corres:
-  "sc = sc' \<Longrightarrow>
-   corres dc \<top> \<top> (modify (cur_sc_update (\<lambda>_. sc))) (setCurSc sc')"
-  apply (clarsimp simp: setCurSc_def, rule corres_modify)
-  by (clarsimp simp: state_relation_def swp_def)
-
-lemma refillSingle_equiv:
-  "sc_valid_refills' sc \<Longrightarrow>
-   (length (refills_map (scRefillHead sc) (scRefillCount sc) (scRefillMax sc) (scRefills sc)) = Suc 0)
-    = (scRefillHead sc = refillTailIndex sc)"
-  apply (clarsimp simp: valid_sched_context'_def refillTailIndex_def refills_map_def)
-  apply (case_tac "scRefillCount sc = Suc 0"; simp)
-  apply (auto simp: Let_def)
-  done
-
-lemma refillSingle_corres:
-  "scp = scp' \<Longrightarrow>
-   corres (=) (sc_at scp) (obj_at' sc_valid_refills' scp')
-     (refill_single scp)
-     (refillSingle scp')"
-  unfolding refill_single_def refillSingle_def
-  apply (simp add: refill_size_def get_refills_def)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule_tac R'="\<lambda>sc s. sc_valid_refills' sc" and R="\<lambda>_ _ . True" in corres_split)
-       apply (rule get_sc_corres)
-      apply simp
-      apply (metis (mono_tags, opaque_lifting) refillSingle_equiv sc_relation_def)
-     apply wpsimp+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma active_sc_at'_cross:
-  "\<lbrakk>(s,s') \<in> state_relation; pspace_aligned s; pspace_distinct s; is_active_sc sc_ptr s;
-    sc_at sc_ptr s\<rbrakk>
-   \<Longrightarrow> active_sc_at' sc_ptr s'"
-  apply (frule state_relation_pspace_relation)
-  apply (frule (3) sc_at_cross)
-  apply (clarsimp simp: pspace_relation_def obj_at_def is_sc_obj_def)
-  apply (drule_tac x=sc_ptr in bspec, blast)
-  apply (clarsimp simp: sc_relation_def vs_all_heap_simps active_sc_at'_def obj_at'_def projectKOs
-                        active_sc_def)
-  done
-
-lemma is_active_sc'2_cross:
-  "\<lbrakk>(s,s') \<in> state_relation; pspace_aligned s; pspace_distinct s; is_active_sc sc_ptr s;
-    sc_at sc_ptr s\<rbrakk>
-   \<Longrightarrow> is_active_sc' sc_ptr s'"
-  apply (frule state_relation_pspace_relation)
-  apply (frule (3) sc_at_cross)
-  apply (clarsimp simp: pspace_relation_def obj_at_def is_sc_obj_def)
-  apply (drule_tac x=sc_ptr in bspec, blast)
-  apply (clarsimp simp: sc_relation_def vs_all_heap_simps obj_at'_def projectKOs
-                        active_sc_def opt_map_red StateRelation.is_active_sc'_def opt_pred_def)
-  done
-
-lemma release_q_runnable_cross:
-  "\<lbrakk>(s,s') \<in> state_relation; valid_release_q s; pspace_aligned s; pspace_distinct s\<rbrakk> \<Longrightarrow>
-   \<forall>p. p \<in> set (ksReleaseQueue s') \<longrightarrow> obj_at' (runnable' \<circ> tcbState) p s'"
-  apply (frule state_relation_release_queue_relation)
-  apply (clarsimp simp: valid_release_q_def obj_at'_def release_queue_relation_def)
-  apply (drule_tac x=p in bspec, blast)
-  apply (clarsimp simp: vs_all_heap_simps)
-  apply (frule_tac t=p in st_tcb_at_coerce_concrete[rotated, where P=runnable], simp, simp)
-   apply (clarsimp simp: pred_tcb_at_def obj_at_def)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def sts_rel_runnable)
-  done
-
-
-\<comment> \<open>Some methods to add invariants to the concrete guard of a corres proof. Often used for properties
-    that are asserted to hold in the Haskell definition.\<close>
-
-method add_sym_refs =
-  rule_tac Q="\<lambda>s'. sym_refs (state_refs_of' s')" in corres_cross_add_guard,
-  (clarsimp simp: pred_conj_def)?,
-  (elim conjE)?,
-  (frule invs_sym_refs)?, (frule invs_psp_aligned)?, (frule invs_distinct)?,
-  fastforce dest: state_refs_of_cross_eq
-
-method add_ct_not_inQ =
-  rule_tac Q="\<lambda>s'. ct_not_inQ s'" in corres_cross_add_guard,
-  fastforce intro!: ct_not_inQ_cross simp: valid_sched_def
-
-method add_sch_act_wf =
-  rule_tac Q="\<lambda>s'. sch_act_wf (ksSchedulerAction s') s'" in corres_cross_add_guard,
-  fastforce intro!: sch_act_wf_cross simp: valid_sched_def
-
-method add_ct_idle_or_in_cur_domain' =
-  rule_tac Q="\<lambda>s'. ct_idle_or_in_cur_domain' s'" in corres_cross_add_guard,
-  fastforce intro!: ct_idle_or_in_cur_domain'_cross simp: valid_sched_def
-
-method add_valid_idle' =
-  rule_tac Q="\<lambda>s'. valid_idle' s'" in corres_cross_add_guard,
-  fastforce intro!: valid_idle'_cross
-
-method add_ready_qs_runnable =
-  rule_tac Q=ready_qs_runnable in corres_cross_add_guard,
-  (clarsimp simp: pred_conj_def)?,
-  (frule valid_sched_valid_ready_qs)?, (frule invs_psp_aligned)?, (frule invs_distinct)?,
-  fastforce dest: ready_qs_runnable_cross
-
-method add_release_q_runnable =
-  rule_tac Q="\<lambda>s'. \<forall>p. p \<in> set (ksReleaseQueue s') \<longrightarrow> obj_at' (runnable' \<circ> tcbState) p s'"
-        in corres_cross_add_guard,
-  (simp only: pred_conj_def)?,
-  (frule valid_sched_valid_release_q)?, (frule invs_psp_aligned)?, (frule invs_distinct)?,
-  fastforce dest: release_q_runnable_cross
-
-method add_valid_replies for rptr uses simp =
-  rule_tac Q="\<lambda>s. valid_replies'_sc_asrt rptr s" in corres_cross_add_guard,
-  fastforce elim: valid_replies_sc_cross simp: simp
-
 end
diff --git a/proof/refine/ARM/KernelInit_R.thy b/proof/refine/ARM/KernelInit_R.thy
index 9e5909072e..59d308fa31 100644
--- a/proof/refine/ARM/KernelInit_R.thy
+++ b/proof/refine/ARM/KernelInit_R.thy
@@ -40,8 +40,6 @@ axiomatization where
 
 axiomatization where
   ckernel_init_domain_list:
-  "((tc,s),x) \<in> Init_H
-   \<Longrightarrow> length (ksDomSchedule s) > 0
-       \<and> (\<forall>(d,time) \<in> set (ksDomSchedule s). us_to_ticks (time * \<mu>s_in_ms) > 0)"
+  "((tc,s),x) \<in> Init_H \<Longrightarrow> length (ksDomSchedule s) > 0 \<and> (\<forall>(d,time) \<in> set (ksDomSchedule s). time > 0)"
 
 end
diff --git a/proof/refine/ARM/LevityCatch.thy b/proof/refine/ARM/LevityCatch.thy
index 72c64a908d..de9fd7637e 100644
--- a/proof/refine/ARM/LevityCatch.thy
+++ b/proof/refine/ARM/LevityCatch.thy
@@ -14,33 +14,29 @@ begin
 (* Try again, clagged from Include *)
 no_notation bind_drop (infixl ">>" 60)
 
-lemma read_magnitudeCheck_assert:
-  "read_magnitudeCheck x y n = oassert (case y of None \<Rightarrow> True | Some z \<Rightarrow> 1 << n \<le> z - x)"
-  by (fastforce simp: read_magnitudeCheck_def split: option.split)
-
 lemma magnitudeCheck_assert:
   "magnitudeCheck x y n = assert (case y of None \<Rightarrow> True | Some z \<Rightarrow> 1 << n \<le> z - x)"
-  by (simp add: magnitudeCheck_def read_magnitudeCheck_assert)
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+  apply (simp add: magnitudeCheck_def assert_def when_def
+            split: option.split)
+  apply fastforce
+  done
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemmas makeObject_simps =
   makeObject_endpoint makeObject_notification makeObject_cte
   makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte
   makeObject_asidpool
 end
 
-lemma projectKO_inv : "\<lbrace>P\<rbrace> gets_the $ projectKO ko \<lbrace>\<lambda>rv. P\<rbrace>"
-  by wpsimp
+lemma projectKO_inv : "\<lbrace>P\<rbrace> projectKO ko \<lbrace>\<lambda>rv. P\<rbrace>"
+  by (simp add: projectKO_def fail_def valid_def return_def
+           split: option.splits)
 
 (****** From GeneralLib *******)
 
-lemma read_alignCheck_assert:
-  "read_alignCheck ptr n = oassert (is_aligned ptr n)"
-  by (simp add: is_aligned_mask read_alignCheck_def read_alignError_def ounless_def)
-
 lemma alignCheck_assert:
   "alignCheck ptr n = assert (is_aligned ptr n)"
-  by (simp add: read_alignCheck_assert alignCheck_def)
+  by (simp add: is_aligned_mask alignCheck_def assert_def
+                alignError_def unless_def when_def)
 
 lemma magnitudeCheck_inv:   "\<lbrace>P\<rbrace> magnitudeCheck x y n \<lbrace>\<lambda>rv. P\<rbrace>"
   apply (clarsimp simp add: magnitudeCheck_def split: option.splits)
@@ -59,7 +55,7 @@ lemma updateObject_default_inv:
   "\<lbrace>P\<rbrace> updateObject_default obj ko x y n \<lbrace>\<lambda>rv. P\<rbrace>"
   unfolding updateObject_default_def
   by (simp, wp magnitudeCheck_inv alignCheck_inv projectKO_inv, simp)
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma to_from_apiType [simp]: "toAPIType (fromAPIType x) = Some x"
   by (cases x) (auto simp add: fromAPIType_def ARM_H.fromAPIType_def
     toAPIType_def ARM_H.toAPIType_def)
diff --git a/proof/refine/ARM/Machine_R.thy b/proof/refine/ARM/Machine_R.thy
index 5fbb392db2..76ffc6375b 100644
--- a/proof/refine/ARM/Machine_R.thy
+++ b/proof/refine/ARM/Machine_R.thy
@@ -22,32 +22,7 @@ lemma irq_state_independent_HI[intro!, simp]:
    \<Longrightarrow> irq_state_independent_H P"
   by (simp add: irq_state_independent_H_def)
 
-definition "getCurrentTime_independent_H (P :: kernel_state \<Rightarrow> bool)
-  \<equiv> \<forall>f s. P s \<longrightarrow>
-           P (s\<lparr>ksMachineState :=
-                       ksMachineState s\<lparr>last_machine_time :=
-                          f (last_machine_time (ksMachineState s)) (time_state (ksMachineState s))\<rparr>\<rparr>)"
-
-lemma getCurrentTime_independent_HI[intro!, simp]:
-   "\<lbrakk>\<And>s f.
-     P (s\<lparr>ksMachineState
-          := (ksMachineState s)\<lparr>last_machine_time :=
-                                f (last_machine_time (ksMachineState s)) (time_state (ksMachineState s))\<rparr>\<rparr>)
-     = P s\<rbrakk>
-    \<Longrightarrow> getCurrentTime_independent_H P"
-   by (simp add: getCurrentTime_independent_H_def)
-
-definition "time_state_independent_H (P :: kernel_state \<Rightarrow> bool)
-  \<equiv> \<forall>f s. P s \<longrightarrow>
-           P (s\<lparr>ksMachineState := ksMachineState s\<lparr>time_state := f (time_state (ksMachineState s))\<rparr>\<rparr>)"
-
-lemma time_state_independent_HI[intro!, simp]:
-   "\<lbrakk>\<And>s f. P (s\<lparr>ksMachineState := ksMachineState s\<lparr>time_state := f (time_state (ksMachineState s))\<rparr>\<rparr>)
-            = P s\<rbrakk>
-    \<Longrightarrow> time_state_independent_H P"
-   by (simp add: time_state_independent_H_def)
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma dmo_getirq_inv[wp]:
   "irq_state_independent_H P \<Longrightarrow> \<lbrace>P\<rbrace> doMachineOp (getActiveIRQ in_kernel) \<lbrace>\<lambda>rv. P\<rbrace>"
@@ -79,7 +54,7 @@ lemma dmo_maskInterrupt:
 lemma dmo_maskInterrupt_True:
   "\<lbrace>invs'\<rbrace> doMachineOp (maskInterrupt True irq) \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (wp dmo_maskInterrupt)
-  apply (clarsimp simp: invs'_def valid_dom_schedule'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def)
   apply (simp add: valid_irq_masks'_def valid_machine_state'_def
                    ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
   done
diff --git a/proof/refine/ARM/PageTableDuplicates.thy b/proof/refine/ARM/PageTableDuplicates.thy
index 5162dd9fc6..46975c1950 100644
--- a/proof/refine/ARM/PageTableDuplicates.thy
+++ b/proof/refine/ARM/PageTableDuplicates.thy
@@ -1,5 +1,4 @@
 (*
- * Copyright 2022, Proofcraft Pty Ltd
  * Copyright 2014, General Dynamics C4 Systems
  *
  * SPDX-License-Identifier: GPL-2.0-only
@@ -9,7 +8,7 @@ theory PageTableDuplicates
 imports Syscall_R
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma set_ep_valid_duplicate' [wp]:
   "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
@@ -20,10 +19,9 @@ lemma set_ep_valid_duplicate' [wp]:
                         objBits_def[symmetric] lookupAround2_char1
                  split: if_split_asm)
   apply (frule pspace_storable_class.updateObject_type[where v = v,simplified])
-  apply (clarsimp simp: updateObject_default_def assert_def bind_def when_def
-                        alignError_def magnitudeCheck_def read_magnitudeCheck_def
-                        assert_opt_def return_def fail_def
-                 split: if_splits option.splits)
+  apply (clarsimp simp:updateObject_default_def assert_def bind_def
+    alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
+    assert_opt_def return_def fail_def split:if_splits option.splits)
    apply (rule_tac ko = ba in valid_duplicates'_non_pd_pt_I)
        apply simp+
   apply (rule_tac ko = ba in valid_duplicates'_non_pd_pt_I)
@@ -39,10 +37,9 @@ lemma set_ntfn_valid_duplicate' [wp]:
                         objBits_def[symmetric] lookupAround2_char1
                  split: if_split_asm)
   apply (frule pspace_storable_class.updateObject_type[where v = v,simplified])
-  apply (clarsimp simp: updateObject_default_def assert_def bind_def when_def
-                        alignError_def magnitudeCheck_def read_magnitudeCheck_def
-                        assert_opt_def return_def fail_def
-                 split: if_splits option.splits)
+  apply (clarsimp simp:updateObject_default_def assert_def bind_def
+    alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
+    assert_opt_def return_def fail_def split:if_splits option.splits)
    apply (rule_tac ko = ba in valid_duplicates'_non_pd_pt_I)
        apply simp+
   apply (rule_tac ko = ba in valid_duplicates'_non_pd_pt_I)
@@ -65,7 +62,7 @@ lemma setCTE_valid_duplicates'[wp]:
      apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+
   done
 
-crunch cteInsert
+crunch cteInsert, setupReplyMaster
   for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
   (wp: crunch_wps simp: crunch_simps)
 
@@ -75,7 +72,7 @@ lemma doMachineOp_ksPSpace_inv[wp]:
 
 crunch threadSet, setBoundNotification, setExtraBadge
   for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (wp: updateObject_default_inv)
+  (wp: setObject_ksInterrupt updateObject_default_inv)
 
 lemma transferCapsToSlots_duplicates'[wp]:
  "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
@@ -83,39 +80,11 @@ lemma transferCapsToSlots_duplicates'[wp]:
   \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   by (rule transferCapsToSlots_pres1; wp)
 
-lemma setObjectSC_valid_duplicates'[wp]:
-  "setObject a (sc::sched_context) \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (clarsimp simp: setObject_def split_def valid_def in_monad
-                        projectKOs pspace_aligned'_def ps_clear_upd
-                        objBits_def[symmetric] lookupAround2_char1
-                 split: if_split_asm)
-  apply (frule pspace_storable_class.updateObject_type[where v = sc,simplified])
-  apply (clarsimp simp: updateObject_default_def assert_def bind_def
-                        alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
-                        assert_opt_def return_def fail_def typeError_def
-                  split: if_splits option.splits Structures_H.kernel_object.splits)
-     apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+
-  done
-
-lemma setObjectReply_valid_duplicates'[wp]:
-  "setObject a (r::reply) \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (clarsimp simp: setObject_def split_def valid_def in_monad
-                        projectKOs pspace_aligned'_def ps_clear_upd
-                        objBits_def[symmetric] lookupAround2_char1
-                 split: if_split_asm)
-  apply (frule pspace_storable_class.updateObject_type[where v = r,simplified])
-  apply (clarsimp simp: updateObject_default_def assert_def bind_def
-                        alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
-                        assert_opt_def return_def fail_def typeError_def
-                  split: if_splits option.splits Structures_H.kernel_object.splits)
-     apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+
-  done
-
 crunch transferCaps, sendFaultIPC, handleFault, replyFromKernel, insertNewCap
   for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
   (ignore: transferCapsToSlots
-       wp: crunch_wps hoare_vcg_const_Ball_lift hoare_vcg_all_lift get_rs_cte_at' whileM_inv
-     simp: zipWithM_x_mapM ball_conj_distrib crunch_simps)
+       wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at'
+     simp: zipWithM_x_mapM ball_conj_distrib)
 
 lemma koTypeOf_pte:
   "koTypeOf ko = ArchT PTET \<Longrightarrow> \<exists>pte. ko = KOArch (KOPTE pte)"
@@ -138,16 +107,15 @@ lemma mapM_x_storePTE_updates:
   apply (thin_tac "valid P f Q" for P f Q)
   apply (simp add: storePTE_def setObject_def)
   apply (wp | simp add:split_def updateObject_default_def)+
-  apply (clarsimp cong: if_cong)
+  apply clarsimp
   apply (intro conjI ballI)
    apply (drule(1) bspec)
-   apply (clarsimp simp: typ_at'_def ko_wp_at'_def objBits_defs
-                   dest!: koTypeOf_pte
-                   split:  kernel_object.split_asm)
+   apply (clarsimp simp:typ_at'_def ko_wp_at'_def
+     objBits_simps archObjSize_def dest!:koTypeOf_pte
+     split:  Structures_H.kernel_object.split_asm)
    apply (simp add:ps_clear_def dom_fun_upd2[unfolded fun_upd_def])
-   apply (simp add: lookupAround2_known1)
   apply (erule rsubst[where P=Q])
-  apply (rule ext, clarsimp)
+  apply fastforce
   done
 
 lemma is_aligned_plus_bound:
@@ -377,7 +345,7 @@ lemma mapM_x_storePTE_update_helper:
       apply (drule pspace_alignedD')
        apply simp
       apply (simp add:objBits_simps' archObjSize_def pteBits_def
-        is_aligned_weaken[where y = 2] pageBits_def pdeBits_def vs_ptr_align_def
+        is_aligned_weaken[where y = 2] pageBits_def pdeBits_def
         split:kernel_object.splits arch_kernel_object.splits)
      apply (simp add:mask_lower_twice)
      apply (drule mask_out_first_mask_some[where m = ptBits])
@@ -435,15 +403,15 @@ lemma mapM_x_storePDE_updates:
   apply (thin_tac "valid P f Q" for P f Q)
   apply (simp add: storePDE_def setObject_def)
   apply (wp | simp add:split_def updateObject_default_def)+
-  apply (clarsimp cong: if_cong)
+  apply clarsimp
   apply (intro conjI ballI)
    apply (drule(1) bspec)
    apply (clarsimp simp:typ_at'_def ko_wp_at'_def
      objBits_simps archObjSize_def dest!:koTypeOf_pde
      split:  Structures_H.kernel_object.split_asm  arch_kernel_object.split_asm if_split)
-   apply (simp add:ps_clear_def dom_fun_upd2[unfolded fun_upd_def])+
+   apply (simp add:ps_clear_def dom_fun_upd2[unfolded fun_upd_def])
   apply (erule rsubst[where P=Q])
-  apply (rule ext, clarsimp)
+  apply fastforce
   done
 
 lemma mapM_x_storePDE_update_helper:
@@ -489,7 +457,7 @@ lemma mapM_x_storePDE_update_helper:
       apply (drule pspace_alignedD')
        apply simp
       apply (simp add:objBits_simps' archObjSize_def pteBits_def
-        is_aligned_weaken[where y = 2] pageBits_def pdeBits_def vs_ptr_align_def
+        is_aligned_weaken[where y = 2] pageBits_def pdeBits_def
         split:kernel_object.splits arch_kernel_object.splits)
      apply (simp add:mask_lower_twice)
      apply (drule mask_out_first_mask_some[where m = pdBits])
@@ -593,7 +561,9 @@ lemma globalPDEWindow_neg_mask:
   done
 
 lemma copyGlobalMappings_ksPSpace_stable:
-  notes blah[simp del] =  atLeastAtMost_simps
+  notes blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
   assumes ptr_al: "is_aligned ptr pdBits"
   shows
    "\<lbrace>\<lambda>s. ksPSpace s x = ko \<and> pspace_distinct' s \<and> pspace_aligned' s \<and>
@@ -608,10 +578,12 @@ lemma copyGlobalMappings_ksPSpace_stable:
       apply (rule ccontr)
       apply clarsimp
       apply (drule(1) pspace_alignedD')
-      apply (drule is_aligned_weaken[where y = 2]; simp?)
-      by (clarsimp simp: archObjSize_def pageBits_def pteBits_def pdeBits_def objBits_simps'
-                         minSchedContextBits_def
-                  split: arch_kernel_object.split kernel_object.splits)
+      apply (drule is_aligned_weaken[where y = 2])
+       apply (case_tac y, simp_all add: objBits_simps' pageBits_def)
+      apply (simp add: archObjSize_def pageBits_def
+                       pteBits_def pdeBits_def
+                  split: arch_kernel_object.splits)
+      done
     have ptr_eqD:
       "\<And>p a b. \<lbrakk>p + a = ptr + b;is_aligned p pdBits;
             a < 2^ pdBits; b < 2^pdBits \<rbrakk>
@@ -725,13 +697,12 @@ lemma copyGlobalMappings_ksPSpace_stable:
         | simp add: storePDE_def setObject_def split_def
         updateObject_default_def
         split: option.splits)+
-     apply (clarsimp simp: objBits_simps archObjSize_def obj_at'_def scBits_simps
-                           projectKO_def projectKO_opt_pde fail_def return_def oassert_opt_def)
-     apply (intro conjI impI)
-       apply (clarsimp simp: obj_at'_def objBits_simps scBits_simps
-                             projectKO_def projectKO_opt_pde fail_def return_def pde.exhaust
-                      split: Structures_H.kernel_object.splits  arch_kernel_object.splits)
-      apply (drule_tac x = xa in bspec)
+     apply (clarsimp simp:objBits_simps archObjSize_def)
+     apply (clarsimp simp:obj_at'_def objBits_simps
+        projectKO_def projectKO_opt_pde fail_def return_def
+        split: Structures_H.kernel_object.splits
+        arch_kernel_object.splits)
+     apply (drule_tac x = xa in bspec)
       apply simp
       apply (rule ccontr)
       apply (simp add: pdeBits_def)
@@ -748,11 +719,7 @@ lemma copyGlobalMappings_ksPSpace_stable:
        apply (drule postfix_listD)
        apply (clarsimp simp:pdBits_def pdeBits_def le_less_trans)
       apply (simp add:pdBits_def pageBits_def pdeBits_def)
-      apply (clarsimp simp: obj_at'_def objBits_simps scBits_simps
-                            projectKO_def projectKO_opt_pde fail_def return_def
-                     split: Structures_H.kernel_object.splits arch_kernel_object.splits)
-     apply (drule_tac x = xa in bspec)
-      apply (clarsimp simp:pdBits_def pdeBits_def le_less_trans)+
+     apply simp
     apply wp
    apply (clarsimp simp:objBits_simps archObjSize_def pdeBits_def)
   apply (rule hoare_name_pre_state)
@@ -772,6 +739,10 @@ lemma copyGlobalMappings_ksPSpace_stable:
 qed
 
 lemma copyGlobalMappings_ksPSpace_same:
+  notes blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
+  shows
   "\<lbrakk>is_aligned ptr pdBits\<rbrakk> \<Longrightarrow>
    \<lbrace>\<lambda>s. ksPSpace s x = ko \<and> pspace_distinct' s \<and> pspace_aligned' s \<and>
     is_aligned (armKSGlobalPD (ksArchState s)) pdBits \<and> ptr = armKSGlobalPD (ksArchState s)\<rbrace>
@@ -790,7 +761,7 @@ lemma copyGlobalMappings_ksPSpace_same:
     updateObject_default_def
     split: option.splits)+
     apply (clarsimp simp:objBits_simps archObjSize_def)
-    apply (clarsimp simp:obj_at'_def objBits_simps oassert_opt_def
+    apply (clarsimp simp:obj_at'_def objBits_simps
       projectKO_def projectKO_opt_pde fail_def return_def
       split: Structures_H.kernel_object.splits
       arch_kernel_object.splits)
@@ -802,7 +773,9 @@ lemmas copyGlobalMappings_ksPSpaceD = use_valid[OF _ copyGlobalMappings_ksPSpace
 lemmas copyGlobalMappings_ksPSpace_sameD = use_valid[OF _ copyGlobalMappings_ksPSpace_same]
 
 lemma copyGlobalMappings_ksPSpace_concrete:
-  notes blah[simp del] =  atLeastAtMost_simps
+  notes blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
   assumes monad: "(r, s') \<in> fst (copyGlobalMappings ptr s)"
   and ps: "pspace_distinct' s" "pspace_aligned' s"
   and al: "is_aligned (armKSGlobalPD (ksArchState s)) pdBits"
@@ -862,7 +835,7 @@ lemma copyGlobalMappings_ksPSpace_concrete:
     apply (frule_tac d1 = "0x3FFF" and p1="ptr" in is_aligned_add_helper[THEN conjunct2])
      apply (simp add: pdeBits_def)
     apply (frule_tac d1 = "pptrBase >> 20 << 2" and p1 = "ptr"
-      in is_aligned_add_helper[THEN conjunct2])
+                     in is_aligned_add_helper[THEN conjunct2])
      apply (simp add: pptrBase_def pdeBits_def)
     apply (simp add: pdeBits_def)
     apply (cut_tac copyGlobalMappings_ksPSpace_sameD)
@@ -875,7 +848,9 @@ qed
 
 
 lemma copyGlobalMappings_valid_duplicates':
-  notes blah[simp del] =  atLeastAtMost_simps
+  notes blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
   shows "\<lbrace>(\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and pspace_distinct'
     and pspace_aligned'
     and (\<lambda>s. is_aligned (armKSGlobalPD (ksArchState s)) pdBits)
@@ -1058,13 +1033,12 @@ lemma valid_duplicates'_update:
 
 lemma createObject_valid_duplicates'[wp]:
   "\<lbrace>(\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and pspace_aligned' and pspace_distinct'
-   and pspace_no_overlap' ptr (getObjectSize ty us) and pspace_bounded'
+   and pspace_no_overlap' ptr (getObjectSize ty us)
    and (\<lambda>s. is_aligned (armKSGlobalPD (ksArchState s)) pdBits)
    and K (is_aligned ptr (getObjectSize ty us))
    and K (ty = APIObjectType apiobject_type.CapTableObject \<longrightarrow> us < 28)\<rbrace>
   RetypeDecls_H.createObject ty ptr us d
   \<lbrace>\<lambda>xa s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  supply if_cong[cong]
   apply (rule hoare_gen_asm)
   apply (simp add:createObject_def)
   apply (rule hoare_pre)
@@ -1136,17 +1110,12 @@ lemma createObject_valid_duplicates'[wp]:
      ,simplified objBits_simps])
     apply simp
    apply (clarsimp simp: objBits_simps archObjSize_def pdBits_def pageBits_def)
-   apply (frule(3) retype_aligned_distinct'[where n = 4096 and ko = "KOArch (KOPDE makeObject)"])
-    apply (simp add:objBits_simps archObjSize_def)
-    apply (rule range_cover_rel[OF range_cover_full])
-       apply simp
-      apply (simp add:APIType_capBits_def word_bits_def pdeBits_def)+
-   apply (frule(3) retype_aligned_distinct'(2)[where n = 4096 and ko = "KOArch (KOPDE makeObject)"])
+   apply (frule(2) retype_aligned_distinct'[where n = 4096 and ko = "KOArch (KOPDE makeObject)"])
     apply (simp add:objBits_simps archObjSize_def)
     apply (rule range_cover_rel[OF range_cover_full])
        apply simp
       apply (simp add:APIType_capBits_def word_bits_def pdeBits_def)+
-   apply (frule(3) retype_aligned_distinct'(3)[where n = 4096 and ko = "KOArch (KOPDE makeObject)"])
+   apply (frule(2) retype_aligned_distinct'(2)[where n = 4096 and ko = "KOArch (KOPDE makeObject)"])
     apply (simp add:objBits_simps archObjSize_def)
     apply (rule range_cover_rel[OF range_cover_full])
        apply simp
@@ -1164,29 +1133,38 @@ lemma createObject_valid_duplicates'[wp]:
    apply (rule none_in_new_cap_addrs[where us =12,simplified]
      ,(simp add: objBits_simps pageBits_def word_bits_conv archObjSize_def pdeBits_def)+)[1]
   apply (intro conjI impI allI)
-        apply simp
-       apply (fastforce elim!: valid_duplicates'_update simp: vs_entry_align_def)+
-    apply (clarsimp simp:ARM_H.toAPIType_def word_bits_def
-                   split:ARM_H.object_type.splits)
-    apply (cut_tac ptr = ptr in new_cap_addrs_fold'[where n = "2^us"
-               and ko = "(KOCTE makeObject)",simplified])
-     apply (rule word_1_le_power)
-     apply (clarsimp simp: word_bits_def)
-    apply (drule_tac ptr = ptr and ko = "KOCTE makeObject" in
-           valid_duplicates'_insert_ko[where us = us,simplified])
-        apply (simp add: APIType_capBits_def is_aligned_mask toAPIType_def
-                  split: ARM_H.object_type.splits)
-       apply (simp add: vs_entry_align_def)
-      apply (simp add: objBits_simps')
-     apply (rule none_in_new_cap_addrs
-            ,(simp add: objBits_simps' pageBits_def APIType_capBits_def
-                        ARM_H.toAPIType_def
-                        word_bits_conv archObjSize_def is_aligned_mask
-                 split: ARM_H.object_type.splits)+)[1]
-    apply (clarsimp simp: word_bits_def)
-   apply (fastforce elim!: valid_duplicates'_update
-                     simp: vs_entry_align_def)+
-  done
+      apply simp
+     apply clarsimp
+     apply (drule(2) valid_duplicates'_update) prefer 3
+       apply fastforce
+      apply (simp add: vs_entry_align_def)
+     apply simp
+    apply clarsimp
+    apply (drule(2) valid_duplicates'_update) prefer 3
+      apply (fastforce simp: vs_entry_align_def)+
+   apply clarsimp
+   apply (drule(2) valid_duplicates'_update) prefer 3
+     apply (fastforce simp: vs_entry_align_def)+
+  apply (clarsimp simp:ARM_H.toAPIType_def word_bits_def
+                 split:ARM_H.object_type.splits)
+  apply (cut_tac ptr = ptr in new_cap_addrs_fold'[where n = "2^us"
+   and ko = "(KOCTE makeObject)",simplified])
+   apply (rule word_1_le_power)
+  apply (clarsimp simp: word_bits_def)
+  apply (drule_tac ptr = ptr and ko = "KOCTE makeObject" in
+    valid_duplicates'_insert_ko[where us = us,simplified])
+      apply (simp add: APIType_capBits_def is_aligned_mask ARM_H.toAPIType_def
+                split: ARM_H.object_type.splits)
+     apply (simp add: vs_entry_align_def)
+   apply (simp add: objBits_simps')
+   apply (rule none_in_new_cap_addrs
+     ,(simp add: objBits_simps' pageBits_def APIType_capBits_def
+                 ARM_H.toAPIType_def
+                 word_bits_conv archObjSize_def is_aligned_mask
+          split: ARM_H.object_type.splits)+)[1]
+  apply (clarsimp simp: word_bits_def)
+ done
+
 
 crunch createNewObjects
   for arch_inv[wp]: "\<lambda>s. P (armKSGlobalPD (ksArchState s))"
@@ -1194,13 +1172,11 @@ crunch createNewObjects
 
 
 lemma createNewObjects_valid_duplicates'[wp]:
- "\<lbrace>(\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and pspace_no_overlap' ptr sz and pspace_aligned'
-    and pspace_distinct' and pspace_bounded' and (\<lambda>s. is_aligned (armKSGlobalPD (ksArchState s)) pdBits)
-    and K (range_cover ptr sz (Types_H.getObjectSize ty us) (length dest))
-    and K (ptr \<noteq> 0)
-    and K (ty = APIObjectType ArchTypes_H.apiobject_type.CapTableObject \<longrightarrow> us < 28)
-    and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow> sc_size_bounds us)\<rbrace>
-  createNewObjects ty src dest ptr us d
+ "\<lbrace> (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and pspace_no_overlap' ptr sz
+  and pspace_aligned' and pspace_distinct' and (\<lambda>s. is_aligned (armKSGlobalPD (ksArchState s)) pdBits)
+  and K (range_cover ptr sz (Types_H.getObjectSize ty us) (length dest) \<and>
+      ptr \<noteq> 0 \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.CapTableObject \<longrightarrow> us < 28) ) \<rbrace>
+       createNewObjects ty src dest ptr us d
   \<lbrace>\<lambda>reply s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   proof (induct rule:rev_induct )
     case Nil
@@ -1209,24 +1185,24 @@ lemma createNewObjects_valid_duplicates'[wp]:
    next
    case (snoc dest dests)
    show ?case
-     apply (rule hoare_gen_asm)+
+     apply (rule hoare_gen_asm)
      apply clarsimp
      apply (frule range_cover.weak)
      apply (subst createNewObjects_Cons)
       apply (simp add: word_bits_def)
      apply wp
       apply (wp snoc.hyps)
-       (* first bundling up "pspace_xxx" conjuncts together to apply
-          createNewObjects_pspace_no_overlap' in an appropriate way *)
-      apply (subst conj_assoc[symmetric])
-      apply (subst conj_assoc[symmetric])
-      apply (subst conj_assoc[symmetric])
       apply (rule hoare_vcg_conj_lift)
        apply (rule hoare_post_imp[OF _ createNewObjects_pspace_no_overlap'[where sz = sz]])
        apply clarsimp
+      apply (rule hoare_vcg_conj_lift)
+       apply (rule hoare_post_imp[OF _ createNewObjects_pspace_no_overlap'[where sz = sz]])
+       apply clarsimp
+      apply (rule hoare_vcg_conj_lift)
+       apply (rule hoare_post_imp[OF _ createNewObjects_pspace_no_overlap'[where sz = sz]])
        apply (rule pspace_no_overlap'_le)
-         apply fastforce
-        apply (simp add: range_cover.sz[where 'a=32, folded word_bits_def])+
+        apply fastforce
+       apply (simp add: range_cover.sz[where 'a=32, folded word_bits_def])+
       apply wp
      apply clarsimp
      apply (frule range_cover.aligned)
@@ -1276,64 +1252,68 @@ lemma valid_duplicates_deleteObjects_helper:
   assumes inc: "\<And>p ko. \<lbrakk>m p = Some (KOArch ko);p \<in> {ptr .. ptr + 2 ^ sz - 1}\<rbrakk>
   \<Longrightarrow> 6 \<le> sz"
   assumes aligned:"is_aligned ptr sz"
-  notes blah[simp del] =  atLeastAtMost_simps
+  notes blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
   shows "vs_valid_duplicates'  (\<lambda>x. if x \<in> {ptr .. ptr + 2 ^ sz - 1} then None else m x)"
   apply (rule valid_duplicates'_diffI,rule vd)
-   apply (clarsimp simp: vs_valid_duplicates'_def split:option.splits)
+  apply (clarsimp simp: vs_valid_duplicates'_def split:option.splits)
   apply (clarsimp simp: vs_valid_duplicates'_def split:option.splits)
   apply (case_tac "the (m x)",simp_all add:vs_ptr_align_def)
-           apply fastforce+
+   apply fastforce+
   apply (rename_tac arch_kernel_object)
   apply (case_tac arch_kernel_object)
-      apply fastforce+
-     apply (clarsimp split:ARM_H.pte.splits)
-     apply auto[1]
-       apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
-         apply (simp add:vs_ptr_align_def)+
-       apply clarsimp
-       apply (drule(1) inc)
-       apply (drule(1) mask_out_first_mask_some)
-       apply (simp add:mask_lower_twice)
-       apply (simp add: mask_in_range[OF aligned,symmetric])
-      apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
-        apply simp
-       apply (simp add:vs_ptr_align_def)
-      apply simp
+    apply fastforce+
+   apply (clarsimp split:ARM_H.pte.splits)
+   apply auto[1]
      apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
-       apply simp
-      apply (simp add:vs_ptr_align_def)
-     apply simp
-    apply (clarsimp split:ARM_H.pde.splits)
-    apply auto[1]
-      apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
-        apply simp
-       apply (simp add:vs_ptr_align_def)
-      apply (drule(1) inc)
-      apply (drule(1) mask_out_first_mask_some)
+       apply (simp add:vs_ptr_align_def)+
+     apply clarsimp
+     apply (drule(1) inc)
+     apply (drule(1) mask_out_first_mask_some)
       apply (simp add:mask_lower_twice)
-      apply (simp add: mask_in_range[OF aligned,symmetric])
-     apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
-       apply simp
-      apply (simp add:vs_ptr_align_def)
+     apply (simp add: mask_in_range[OF aligned,symmetric])
+    apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
+      apply simp
+     apply (simp add:vs_ptr_align_def)
+    apply simp
+   apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
      apply simp
+    apply (simp add:vs_ptr_align_def)
+   apply simp
+  apply (clarsimp split:ARM_H.pde.splits)
+  apply auto[1]
     apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
       apply simp
      apply (simp add:vs_ptr_align_def)
+    apply (drule(1) inc)
+    apply (drule(1) mask_out_first_mask_some)
+    apply (simp add:mask_lower_twice)
+    apply (simp add: mask_in_range[OF aligned,symmetric])
+   apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
+     apply simp
+    apply (simp add:vs_ptr_align_def)
+   apply simp
+  apply (drule_tac p' = y in valid_duplicates'_D[OF vd])
     apply simp
-   apply fastforce+
+   apply (simp add:vs_ptr_align_def)
+  apply simp
   done
 
 lemma deleteObjects_valid_duplicates'[wp]:
-  notes [simp del] = atLeastAtMost_simps
+  notes blah[simp del] =  atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+          atLeastAtMost_iff
   shows
-  "\<lbrace>(\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and K (is_aligned ptr sz)\<rbrace>
-   deleteObjects ptr sz
-   \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+  "\<lbrace>(\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
+      K (is_aligned ptr sz)
+   \<rbrace> deleteObjects ptr sz
+   \<lbrace>\<lambda>r s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   apply (rule hoare_gen_asm)
-  apply (clarsimp simp: deleteObjects_def2)
-  apply (intro bind_wp[OF _ stateAssert_sp])
-  apply (wpsimp wp: hoare_drop_imps)
-  apply (clarsimp simp: deletionIsSafe_def)
+  apply (clarsimp simp:deleteObjects_def2)
+  apply (wp hoare_drop_imps|simp)+
+  apply clarsimp
+  apply (simp add:deletionIsSafe_def)
   apply (erule valid_duplicates_deleteObjects_helper)
    apply fastforce
   apply simp
@@ -1349,32 +1329,20 @@ crunch resetUntypedCap
 crunch updateFreeIndex
   for valid_duplicates[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
 
-lemma untypedCap_is_aligned:
-  "\<lbrakk>valid_objs' s; cte_wp_at' (isUntypedCap \<circ> cteCap) slot s; cte_wp_at' ((=) cap \<circ> cteCap) slot s\<rbrakk>
-   \<Longrightarrow> is_aligned (capPtr cap) (capBlockSize cap)"
-  apply (clarsimp simp: cte_wp_at_ctes_of)
-  apply (frule cte_wp_at_valid_objs_valid_cap'[OF ctes_of_cte_wpD], clarsimp+)
-  apply (clarsimp simp: valid_cap_simps' capAligned_def isCap_simps)
-  done
-
 lemma resetUntypedCap_valid_duplicates'[wp]:
   "\<lbrace>(\<lambda>s. vs_valid_duplicates' (ksPSpace s))
       and valid_objs' and cte_wp_at' (isUntypedCap o cteCap) slot\<rbrace>
-   resetUntypedCap slot
-   \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+    resetUntypedCap slot
+  \<lbrace>\<lambda>r s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   (is "\<lbrace>?P\<rbrace> ?f \<lbrace>\<lambda>_. ?Q\<rbrace>")
   apply (clarsimp simp: resetUntypedCap_def)
-  apply (rule validE_valid)
-  apply (rule_tac Q'="\<lambda>cap. ?P and cte_wp_at' ((=) cap \<circ> cteCap) slot" in bindE_wp_fwd)
-   apply wpsimp
-  apply (simp only: unlessE_def)
-  apply (clarsimp; safe; (solves wpsimp)?)
-    apply wpsimp
-    apply (fastforce elim: untypedCap_is_aligned)
-   apply wpsimp
-   apply (fastforce elim: untypedCap_is_aligned)
-  apply (wpsimp wp: mapME_x_inv_wp preemptionPoint_inv)
-  apply (fastforce elim: untypedCap_is_aligned)
+  apply (rule hoare_pre)
+   apply (wp | simp add: unless_def)+
+   apply (wp mapME_x_inv_wp preemptionPoint_inv | simp | wp (once) hoare_drop_imps)+
+   apply (wp getSlotCap_wp)
+  apply (clarsimp simp: cte_wp_at_ctes_of split del: if_split)
+  apply (frule cte_wp_at_valid_objs_valid_cap'[OF ctes_of_cte_wpD], clarsimp+)
+  apply (clarsimp simp add: isCap_simps valid_cap_simps' capAligned_def)
   done
 
 lemma is_aligned_armKSGlobalPD:
@@ -1394,8 +1362,8 @@ lemma invokeUntyped_valid_duplicates[wp]:
   notes whenE_wps[wp_split del] shows
   "\<lbrace>invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
          and valid_untyped_inv' ui and ct_active'\<rbrace>
-   invokeUntyped ui
-   \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s) \<rbrace>"
+     invokeUntyped ui
+   \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s) \<rbrace>"
   apply (simp only: invokeUntyped_def updateCap_def)
   apply (rule hoare_name_pre_state)
   apply (cases ui)
@@ -1450,7 +1418,8 @@ crunch
 lemma get_asid_valid_duplicates'[wp]:
   "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
   getObject param_b \<lbrace>\<lambda>(pool::asidpool) s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (simp add:getObject_def | wp)+
+  apply (simp add:getObject_def split_def| wp)+
+  apply (simp add:loadObject_default_def|wp)+
   done
 
 lemma set_asid_pool_valid_duplicates'[wp]:
@@ -1471,8 +1440,8 @@ lemma set_asid_pool_valid_duplicates'[wp]:
 
 crunch
   suspend
- for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (wp: crunch_wps gts_wp' simp: crunch_simps unless_def o_def)
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+  (wp: crunch_wps simp: crunch_simps unless_def o_def)
 
 crunch
 deletingIRQHandler
@@ -1508,7 +1477,7 @@ lemma storePDE_no_duplicates':
      Structures_H.kernel_object.splits ARM_H.pde.splits
      ARM_H.pte.splits)
   apply (clarsimp split:option.splits)
-  apply (drule_tac p = x in valid_duplicates'_D)
+  apply (drule_tac p = x and p' = y in valid_duplicates'_D)
    apply simp+
   done
 
@@ -1541,7 +1510,7 @@ lemma storePTE_no_duplicates':
      Structures_H.kernel_object.splits ARM_H.pde.splits
      ARM_H.pte.splits)
   apply (clarsimp split:option.splits)
-  apply (drule_tac p = x in valid_duplicates'_D)
+  apply (drule_tac p = x and p' = y in valid_duplicates'_D)
    apply simp+
   done
 
@@ -1557,7 +1526,7 @@ lemma checkMappingPPtr_SmallPage:
    apply (wp unlessE_wp getPTE_wp |wpc|simp add:)+
   apply (clarsimp simp:ko_wp_at'_def obj_at'_def)
   apply (clarsimp simp:projectKO_def projectKO_opt_pte
-    return_def fail_def vs_entry_align_def oassert_opt_def
+    return_def fail_def vs_entry_align_def
     split:kernel_object.splits
     arch_kernel_object.splits option.splits)
   done
@@ -1569,7 +1538,7 @@ lemma checkMappingPPtr_Section:
    apply (wp unlessE_wp getPDE_wp |wpc|simp add:)+
   apply (clarsimp simp:ko_wp_at'_def obj_at'_def)
   apply (clarsimp simp:projectKO_def projectKO_opt_pde
-    return_def fail_def vs_entry_align_def oassert_opt_def
+    return_def fail_def vs_entry_align_def
     split:kernel_object.splits
     arch_kernel_object.splits option.splits)
   done
@@ -1591,14 +1560,14 @@ crunch
   (wp: crunch_wps simp: crunch_simps unless_def)
 
 lemma lookupPTSlot_aligned:
-  "\<lbrace>\<lambda>s. valid_objs' s \<and> vmsz_aligned vptr sz \<and> sz \<noteq> ARMSuperSection\<rbrace>
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> vmsz_aligned' vptr sz \<and> sz \<noteq> ARMSuperSection\<rbrace>
    lookupPTSlot pd vptr
   \<lbrace>\<lambda>rv s. is_aligned rv ((pageBitsForSize sz) - 10)\<rbrace>,-"
   apply (simp add:lookupPTSlot_def)
   apply (wp|wpc|simp)+
   apply (wp getPDE_wp)
-  apply (clarsimp simp:obj_at'_def vmsz_aligned_def)
-  apply (clarsimp simp:projectKO_def fail_def oassert_opt_def
+  apply (clarsimp simp:obj_at'_def vmsz_aligned'_def)
+  apply (clarsimp simp:projectKO_def fail_def
     projectKO_opt_pde return_def lookup_pt_slot_no_fail_def
     split:option.splits Structures_H.kernel_object.splits
     arch_kernel_object.splits)
@@ -1628,7 +1597,7 @@ crunch
 lemma unmapPage_valid_duplicates'[wp]:
   notes checkMappingPPtr_inv[wp del] shows
   "\<lbrace>pspace_aligned' and valid_objs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
-   and K (vmsz_aligned vptr vmpage_size)\<rbrace>
+   and K (vmsz_aligned' vptr vmpage_size)\<rbrace>
   unmapPage vmpage_size asiv vptr word \<lbrace>\<lambda>r s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   apply (simp add:unmapPage_def)
    (* make sure checkMappingPPtr_SmallPage is first tried before checkMappingPPtr_inv *)
@@ -1661,10 +1630,10 @@ lemma unmapPage_valid_duplicates'[wp]:
    apply (clarsimp simp:conj_comms)
    apply (rule hoare_strengthen_postE_R[where Q'= "\<lambda>r. pspace_aligned' and
      (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-     K(vmsz_aligned vptr vmpage_size \<and> is_aligned r pdBits)
+     K(vmsz_aligned' vptr vmpage_size \<and> is_aligned r pdBits)
      and page_directory_at' (lookup_pd_slot r vptr && ~~ mask pdBits)"])
     apply (wp findPDForASID_page_directory_at' | simp)+
-   apply (clarsimp simp add:pdBits_def pageBits_def vmsz_aligned_def)
+   apply (clarsimp simp add:pdBits_def pageBits_def vmsz_aligned'_def)
    apply (drule is_aligned_lookup_pd_slot)
     apply (erule is_aligned_weaken,simp)
    apply simp
@@ -1708,9 +1677,7 @@ crunch
   for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
   (wp: crunch_wps simp: crunch_simps unless_def)
 
-crunch deleteASIDPool, unbindNotification, prepareThreadDelete, unbindFromSC,
-         schedContextUnbindAllTCBs, schedContextSetInactive, schedContextUnbindYieldFrom,
-         schedContextUnbindReply
+crunch deleteASIDPool, unbindNotification, prepareThreadDelete
   for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
   (wp: crunch_wps simp: crunch_simps unless_def)
 
@@ -1728,10 +1695,8 @@ lemma finaliseCap_valid_duplicates'[wp]:
   "\<lbrace>valid_objs' and pspace_aligned' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
   and (valid_cap' cap)\<rbrace>
   finaliseCap cap call final \<lbrace>\<lambda>r s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (cases cap; simp add: isCap_simps finaliseCap_def)
-               apply (wpsimp wp: crunch_wps hoare_vcg_all_lift
-                             simp: crunch_simps split: option.splits
-                      | rule conjI)+
+  apply (case_tac cap,simp_all add:isCap_simps finaliseCap_def)
+            apply (wp|intro conjI|clarsimp split: option.splits)+
   done
 
 crunch
@@ -1799,15 +1764,15 @@ lemma cteRevoke_valid_duplicates'[wp]:
        \<and> sch_act_simple s \<rbrace>"
   apply (rule cteRevoke_preservation)
    apply (wp cteDelete_invs' cteDelete_valid_duplicates' cteDelete_sch_act_simple)
-     apply (fastforce simp: cteDelete_def sch_act_simple_def)+
+     apply (simp add:cteDelete_def)+
   done
 
 lemma mapM_x_storePTE_invalid_whole:
   "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s) \<and>
-  s \<turnstile>' capability.ArchObjectCap (arch_capability.PageTableCap word option) \<and>
-  pspace_aligned' s\<rbrace>
-  mapM_x (swp storePTE InvalidPTE) [word , word + 2 ^ pteBits .e. word + 2 ^ ptBits - 1]
-  \<lbrace>\<lambda>y s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+        s \<turnstile>' capability.ArchObjectCap (arch_capability.PageTableCap word option) \<and>
+        pspace_aligned' s\<rbrace>
+   mapM_x (swp storePTE InvalidPTE) [word , word + 2 ^ pteBits .e. word + 2 ^ ptBits - 1]
+   \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   apply (wp mapM_x_storePTE_update_helper[where word = word and sz = ptBits and ptr = word])
   apply (clarsimp simp: valid_cap'_def capAligned_def pageBits_def ptBits_def objBits_simps
                         archObjSize_def pteBits_def)
@@ -1826,18 +1791,25 @@ crunch
 
 crunch
   isFinalCapability
- for valid_cap'[wp]: "\<lambda>s. valid_cap' cap s"
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+  (wp: crunch_wps filterM_preserved simp: crunch_simps unless_def)
+
+crunch
+  isFinalCapability
+  for valid_cap'[wp]: "\<lambda>s. valid_cap' cap s"
   (wp: crunch_wps filterM_preserved simp: crunch_simps unless_def)
 
 crunch
   sendSignal
- for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (wp: crunch_wps simp: crunch_simps)
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
 
 lemma invokeIRQControl_valid_duplicates'[wp]:
   "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s) \<rbrace> performIRQControl a
-   \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  unfolding performIRQControl_def by (wpsimp simp: ARM_H.performIRQControl_def)
+  \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+  apply (simp add:performIRQControl_def )
+  apply (rule hoare_pre)
+  apply (wp|wpc | simp add:ARM_H.performIRQControl_def)+
+ done
 
 crunch InterruptDecls_H.invokeIRQHandler
   for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
@@ -1856,8 +1828,14 @@ lemma invokeCNode_valid_duplicates'[wp]:
     apply (rule hoare_pre)
     apply (wp unless_wp | wpc | simp)+
    apply (simp add:invokeCNode_def)
+   apply (wp getSlotCap_inv hoare_drop_imp
+     |simp add:locateSlot_conv getThreadCallerSlot_def
+     |wpc)+
   apply (simp add:cteDelete_def invokeCNode_def)
-  apply (wp getSlotCap_inv hoare_drop_imp | simp add:locateSlot_conv whenE_def split_def | wpc)+
+  apply (wp getSlotCap_inv hoare_drop_imp
+     |simp add:locateSlot_conv getThreadCallerSlot_def
+    whenE_def split_def
+     |wpc)+
   apply (rule valid_validE)
    apply (rule hoare_post_imp[OF _ finaliseSlot_valid_duplicates'])
    apply simp
@@ -1945,7 +1923,8 @@ lemma performPageInvocation_valid_duplicates'[wp]:
   done
 
 lemma placeASIDPool_valid_duplicates'[wp]:
-  notes blah[simp del] = atLeastAtMost_simps
+  notes blah[simp del] = atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
   shows "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s) \<and> pspace_no_overlap' ptr pageBits s
    \<and> is_aligned ptr pageBits \<and> pspace_aligned' s\<rbrace>
   placeNewObject' ptr (KOArch (KOASIDPool makeObject)) 0
@@ -2009,7 +1988,7 @@ lemma performArchInvocation_valid_duplicates':
        apply fastforce
       apply (rule hoare_name_pre_state)
       apply (clarsimp simp: valid_arch_inv'_def isCap_simps valid_pti'_def
-        cte_wp_at_ctes_of is_arch_update'_def isPageTableCap_def
+                            cte_wp_at_ctes_of is_arch_update'_def isPageTableCap_def
                       split: arch_capability.splits)
       apply (clarsimp simp: performPageTableInvocation_def)
       apply (wp storePDE_no_duplicates' | simp)+
@@ -2043,7 +2022,7 @@ lemma performArchInvocation_valid_duplicates':
                          descendants_range'_def2 empty_descendants_range_in')
    apply (intro conjI; clarsimp)
    apply (drule(1) cte_cap_in_untyped_range, fastforce simp:cte_wp_at_ctes_of, simp_all)[1]
-    apply (clarsimp simp: invs'_def if_unsafe_then_cap'_def cte_wp_at_ctes_of)
+    apply (clarsimp simp: invs'_def valid_state'_def if_unsafe_then_cap'_def cte_wp_at_ctes_of)
    apply clarsimp
   apply (rename_tac asidpool_invocation)
   apply (case_tac asidpool_invocation)
@@ -2053,56 +2032,59 @@ lemma performArchInvocation_valid_duplicates':
 
 crunch restart
   for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
-  (wp: crunch_wps simp: crunch_simps)
+  (wp: crunch_wps)
 
 crunch setPriority, setMCPriority
   for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
   (ignore: threadSet
-       wp: setObject_ksInterrupt updateObject_default_inv crunch_wps
+       wp: setObject_ksInterrupt updateObject_default_inv
      simp: crunch_simps)
 
-crunch installTCBCap, installThreadBuffer
-  for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
-  (wp:  crunch_wps checkCap_inv
-   simp: crunch_simps getThreadVSpaceRoot_def getThreadFaultHandlerSlot_def
-         getThreadTimeoutHandlerSlot_def
-   ignore: checkCapAt)
-
-lemma tc_caps_valid_duplicates':
-  "\<lbrace>invs' and sch_act_simple and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-    tcb_at' t and ex_nonz_cap_to' t and
-    case_option \<top> (valid_cap' o fst) croot and
-    K (case_option True (isCNodeCap o fst) croot) and
-    case_option \<top> (valid_cap' o fst) vroot and
-    K (case_option True (isValidVTableRoot o fst) vroot) and
-    case_option \<top> (valid_cap' o fst) fault_h and
-    K (case_option True (isValidFaultHandler o fst) fault_h) and
-    case_option \<top> (valid_cap' o fst) timeout_h and
-    K (case_option True (isValidFaultHandler o fst) timeout_h) and
-    case_option \<top> (valid_cap') (case_option None (case_option None (Some o fst) o snd) ipcb) and
-    K (case_option True isArchObjectCap (case_option None (case_option None (Some o fst) o snd) ipcb))
-    and K (case_option True (swp is_aligned msg_align_bits o fst) ipcb)\<rbrace>
-      invokeTCB (ThreadControlCaps t sl fault_h timeout_h croot vroot ipcb)
+lemma tc_valid_duplicates':
+  "\<lbrace>invs' and sch_act_simple and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and tcb_at' a and ex_nonz_cap_to' a and
+    case_option \<top> (valid_cap' o fst) e' and
+    K (case_option True (isCNodeCap o fst) e') and
+    case_option \<top> (valid_cap' o fst) f' and
+    K (case_option True (isValidVTableRoot o fst) f') and
+    case_option \<top> (valid_cap') (case_option None (case_option None (Some o fst) o snd) g) and
+    K (valid_option_prio d) and
+    K (valid_option_prio mcp) and
+    K (case_option True isArchObjectCap (case_option None (case_option None (Some o fst) o snd) g))
+    and K (case_option True (swp is_aligned msg_align_bits o fst) g)\<rbrace>
+      invokeTCB (tcbinvocation.ThreadControl a sl b' mcp d e' f' g)
    \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (simp add: invokeTCB_def)
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_const_imp_lift
-                    installTCBCap_invs' installTCBCap_sch_act_simple)
-  apply (fastforce simp: isValidFaultHandler_def isCap_simps isValidVTableRoot_def)
-  done
-
-crunch schedContextBindTCB
-  for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma tc_sched_valid_duplicates':
-  "\<lbrace>invs' and sch_act_simple and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-    tcb_at' t and ex_nonz_cap_to' t and
-    case_option \<top> (valid_cap' o fst) sc_fh and
-    K (valid_option_prio pri) and
-    K (valid_option_prio mcp)\<rbrace>
-      invokeTCB  (ThreadControlSched t sl sc_fh pri mcp sc_opt)
-   \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  by (wpsimp simp: mapTCBPtr_def stateAssertE_def invokeTCB_def wp: hoare_drop_imps)
+  apply (rule hoare_gen_asm)
+  apply (simp add: split_def invokeTCB_def getThreadCSpaceRoot getThreadVSpaceRoot
+                   getThreadBufferSlot_def locateSlot_conv
+             cong: option.case_cong)
+  apply (simp only: eq_commute[where a="a"])
+  apply (rule hoare_walk_assmsE)
+    apply (clarsimp simp: pred_conj_def option.splits [where P="\<lambda>x. x s" for s])
+    apply ((wp case_option_wp threadSet_invs_trivial hoare_weak_lift_imp
+               hoare_vcg_all_lift threadSet_cap_to' | clarsimp simp: inQ_def)+)[2]
+  apply (rule hoare_walk_assmsE)
+    apply (clarsimp simp: pred_conj_def option.splits [where P="\<lambda>x. x s" for s])
+    apply ((wp case_option_wp threadSet_invs_trivial hoare_weak_lift_imp setMCPriority_invs'
+               typ_at_lifts[OF setMCPriority_typ_at']
+               hoare_vcg_all_lift threadSet_cap_to' | clarsimp simp: inQ_def)+)[2]
+  apply ((simp only: simp_thms cases_simp cong: conj_cong
+          | (wp cteDelete_deletes cteDelete_invs' cteDelete_sch_act_simple
+              threadSet_ipcbuffer_trivial
+              (* setPriority has no effect on vs_duplicates *)
+              case_option_wp[where m'="return ()", OF setPriority_valid_duplicates' return_inv,simplified]
+              checkCap_inv[where P="tcb_at' t" for t]
+              checkCap_inv[where P="valid_cap' c" for c]
+              checkCap_inv[where P="\<lambda>s. P (ksReadyQueues s)" for P]
+              checkCap_inv[where P="\<lambda>s. vs_valid_duplicates' (ksPSpace s)"]
+              checkCap_inv[where P=sch_act_simple] cteDelete_valid_duplicates' hoare_vcg_const_imp_liftE_R
+              typ_at_lifts[OF setPriority_typ_at'] assertDerived_wp threadSet_cte_wp_at'
+              hoare_vcg_all_liftE_R hoare_vcg_all_lift hoare_weak_lift_imp)[1]
+          | wpc
+          | simp add: inQ_def
+          | wp hoare_vcg_conj_liftE1 cteDelete_invs' cteDelete_deletes hoare_vcg_const_imp_lift)+)
+  apply (clarsimp simp: tcb_cte_cases_def cte_level_bits_def objBits_defs
+                        tcbIPCBufferSlot_def)
+  by (auto dest!: isCapDs isReplyCapD isValidVTableRootD simp: isCap_simps)
 
 crunch performTransfer, unbindNotification, bindNotification, setDomain
   for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
@@ -2114,65 +2096,74 @@ lemma invokeTCB_valid_duplicates'[wp]:
   "\<lbrace>invs' and sch_act_simple and ct_in_state' runnable' and tcb_inv_wf' ti and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))\<rbrace>
      invokeTCB ti
    \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (case_tac ti; simp only:)
-          apply (simp add: invokeTCB_def)
-          apply wp
-          apply (clarsimp simp: invs'_def
-                         dest!: global'_no_ex_cap)
-         apply (simp add: invokeTCB_def)
-         apply wp
-         apply (clarsimp simp: invs'_def
-                        dest!: global'_no_ex_cap)
-        apply (wpsimp wp: tc_caps_valid_duplicates' split: option.splits)
-       apply (wpsimp wp: tc_sched_valid_duplicates')
-      apply (simp add:invokeTCB_def | wp mapM_x_wp' | intro impI conjI | wpc)+
+  apply (case_tac ti, simp_all only:)
+       apply (simp add: invokeTCB_def)
+       apply wp
+       apply (clarsimp simp: invs'_def valid_state'_def
+                      dest!: global'_no_ex_cap)
+      apply (simp add: invokeTCB_def)
+      apply wp
+      apply (clarsimp simp: invs'_def valid_state'_def
+                     dest!: global'_no_ex_cap)
+     apply (wp tc_valid_duplicates')
+     apply (clarsimp split:option.splits)
+     apply (rename_tac option)
+     apply (case_tac option, simp_all)
+    apply (simp add:invokeTCB_def | wp mapM_x_wp' | intro impI conjI | wpc)+
   done
 
-crunch invokeSchedContext, invokeSchedControlConfigureFlags
-  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (simp: crunch_simps wp: crunch_wps hoare_vcg_all_lift)
-
 lemma performInvocation_valid_duplicates'[wp]:
   "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s) \<and> invs' s \<and> sch_act_simple s
     \<and> valid_invocation' i s \<and> ct_active' s\<rbrace>
-  RetypeDecls_H.performInvocation isBlocking isCall canDonate i
-  \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+  RetypeDecls_H.performInvocation isBlocking isCall i
+  \<lbrace>\<lambda>reply s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   apply (clarsimp simp: performInvocation_def)
-  apply (simp add: ct_in_state'_def)
+  apply (simp add:ct_in_state'_def)
   apply (rule hoare_name_pre_state)
   apply (rule hoare_pre)
-   apply wpc
-              apply (wpsimp wp: performArchInvocation_valid_duplicates'
-                          simp: stateAssertE_def stateAssert_def)+
+  apply wpc
+   apply (wp performArchInvocation_valid_duplicates' |simp)+
   apply (cases i)
-             apply (clarsimp simp: simple_sane_strg sch_act_simple_def ct_in_state'_def
-                        ct_active_runnable'[unfolded ct_in_state'_def]
-                    | wp tcbinv_invs' arch_performInvocation_invs'
-                    | rule conjI
-                    | erule active_ex_cap')+
+  apply (clarsimp simp: simple_sane_strg sch_act_simple_def
+                    ct_in_state'_def ct_active_runnable'[unfolded ct_in_state'_def]
+                  | wp tcbinv_invs' arch_performInvocation_invs'
+                  | rule conjI | erule active_ex_cap')+
   apply simp
   done
 
 lemma hi_valid_duplicates'[wp]:
   "\<lbrace>invs' and sch_act_simple and ct_active'
     and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))\<rbrace>
-      handleInvocation isCall isBlocking canDonate firstPhase cptr
+      handleInvocation isCall isBlocking
    \<lbrace>\<lambda>r s. vs_valid_duplicates' (ksPSpace s) \<rbrace>"
   apply (simp add: handleInvocation_def split_def
-                   ts_Restart_case_helper' ct_not_inQ_asrt_def)
-  apply (rule validE_valid)
-  apply (intro bindE_wp[OF _ stateAssertE_sp])
-  apply (wpsimp wp: syscall_valid' setThreadState_nonqueued_state_update rfk_invs' ct_in_state'_set
-                    hoare_drop_imp)
-  apply (fastforce simp: ct_in_state'_def simple_sane_strg sch_act_simple_def
-                  elim!: pred_tcb'_weakenE st_tcb_ex_cap''
-                   dest: st_tcb_at_idle_thread')
+                   ts_Restart_case_helper')
+  apply (wp syscall_valid' setThreadState_nonqueued_state_update
+    rfk_invs' ct_in_state'_set | simp)+
+    apply (fastforce simp add: tcb_at_invs' ct_in_state'_def
+                              simple_sane_strg
+                              sch_act_simple_def
+                       elim!: pred_tcb'_weakenE st_tcb_ex_cap''
+                        dest: st_tcb_at_idle_thread')+
   done
 
-crunch activateIdleThread, schedContextCompleteYieldTo
-  for valid_duplicates' [wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+crunch
+  activateIdleThread
+  for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
   (ignore: setNextPC threadSet simp:crunch_simps)
 
+crunch
+  tcbSchedAppend
+  for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
+  (simp:crunch_simps wp:unless_wp)
+
+lemma timerTick_valid_duplicates'[wp]:
+  "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
+  timerTick \<lbrace>\<lambda>x s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+  apply (simp add:timerTick_def decDomainTime_def)
+   apply (wp hoare_drop_imps|wpc|simp)+
+  done
+
 lemma handleInterrupt_valid_duplicates'[wp]:
   "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
   handleInterrupt irq \<lbrace>\<lambda>r s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
@@ -2183,29 +2174,53 @@ lemma handleInterrupt_valid_duplicates'[wp]:
           |wpc|simp add: handleReservedIRQ_def maskIrqSignal_def)+
   done
 
-crunch awaken
-  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (wp: crunch_wps)
 
 crunch
   schedule
- for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (ignore: setNextPC clearExMonitor threadSet simp: crunch_simps
-   wp: hoare_drop_imps)
+  for valid_duplicates'[wp]: "(\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
+  (ignore: setNextPC clearExMonitor threadSet simp:crunch_simps wp:findM_inv hoare_drop_imps)
 
 lemma activate_sch_valid_duplicates'[wp]:
-  "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
+  "\<lbrace>\<lambda>s. ct_in_state' activatable' s \<and> vs_valid_duplicates' (ksPSpace s)\<rbrace>
      activateThread \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   apply (simp add: activateThread_def getCurThread_def
              cong: if_cong Structures_H.thread_state.case_cong)
   apply (rule bind_wp [OF _ gets_sp])
-  apply (wpsimp wp: threadGet_wp hoare_drop_imps)
-  by (fastforce simp: obj_at'_def)
+  apply (rule bind_wp[where Q'="\<lambda>st s. (runnable' or idle') st \<and> vs_valid_duplicates' (ksPSpace s)"])
+   apply (rule hoare_pre)
+    apply (wp | wpc | simp add: setThreadState_runnable_simp)+
+  apply (clarsimp simp: ct_in_state'_def cur_tcb'_def pred_tcb_at'
+                 elim!: pred_tcb'_weakenE)
+  done
 
-crunch receiveSignal, receiveIPC, handleYield, "VSpace_H.handleVMFault", handleHypervisorFault,
-         lookupReply, checkBudgetRestart
+crunch
+  receiveSignal
   for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (wp: crunch_wps simp: crunch_simps)
+
+crunch
+  receiveIPC
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+  (wp: getNotification_wp gbn_wp' crunch_wps)
+
+crunch
+  deleteCallerCap
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+  (wp: crunch_wps)
+
+crunch
+  handleReply
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+  (wp: crunch_wps)
+
+crunch
+  handleYield
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+ (ignore: threadGet simp:crunch_simps wp:unless_wp)
+
+crunch
+  "VSpace_H.handleVMFault", handleHypervisorFault
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+ (ignore: getFAR getDFSR getIFSR simp:crunch_simps)
 
 lemma hs_valid_duplicates'[wp]:
   "\<lbrace>invs' and ct_active' and sch_act_simple and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))\<rbrace>
@@ -2217,91 +2232,42 @@ lemma hs_valid_duplicates'[wp]:
 
 lemma hc_valid_duplicates'[wp]:
   "\<lbrace>invs' and ct_active' and sch_act_simple and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))\<rbrace>
-   handleCall
-   \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (clarsimp simp: handleCall_def)
-  apply (rule validE_valid)
-  apply (rule bindE_wp[OF _ stateAssertE_sp])
-  apply wpsimp
-  done
+     handleCall
+   \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+  by (simp add: handleCall_def |  wp)+
 
 lemma handleRecv_valid_duplicates'[wp]:
   "\<lbrace>(\<lambda>s. vs_valid_duplicates' (ksPSpace s))\<rbrace>
-  handleRecv isBlocking canDonate \<lbrace>\<lambda>r s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (simp add: handleRecv_def cong: if_cong split del: if_split)
+  handleRecv isBlocking \<lbrace>\<lambda>r s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+  apply (simp add: handleRecv_def cong: if_cong)
   apply (rule hoare_pre)
    apply wp
-      apply ((wp getNotification_wp | wpc | simp add: whenE_def split del: if_split)+)[1]
-     apply (rule_tac Q'="\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)" in hoare_strengthen_postE[rotated])
-       apply (clarsimp simp: isCap_simps sch_act_sane_not)
-      apply assumption
-     apply (wp)+
-  apply (auto elim: st_tcb_ex_cap'' pred_tcb'_weakenE
-             dest!: st_tcb_at_idle_thread'
-              simp: ct_in_state'_def sch_act_sane_def)
-  done
+       apply ((wp getNotification_wp | wpc | simp add: whenE_def split del: if_split)+)[1]
 
-lemma checkBudget_true:
-  "\<lbrace>P\<rbrace> checkBudget \<lbrace>\<lambda>rv s. rv \<longrightarrow> P s\<rbrace>"
-  unfolding checkBudget_def
-  apply wpsimp
-  apply (wpsimp wp: hoare_drop_imp)
-  apply wpsimp
-  apply (wpsimp wp: hoare_drop_imp)+
-  done
+      apply (rule_tac Q'="\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)"
 
-lemma checkBudgetRestart_true:
-  "\<lbrace>P\<rbrace> checkBudgetRestart \<lbrace>\<lambda>rv s. rv \<longrightarrow> P s\<rbrace>"
-  unfolding checkBudgetRestart_def
-  apply wpsimp
-  apply (rule_tac Q'="\<lambda>rv s. rv \<longrightarrow> P s" in hoare_strengthen_post[rotated], clarsimp)
-  apply (wpsimp wp: checkBudget_true)+
-  done
-
-lemma checkBudgetRestart_gen:
-  "\<lbrace>R\<rbrace> checkBudgetRestart \<lbrace>\<lambda>_. Q\<rbrace> \<Longrightarrow>
-   \<lbrace>P and R\<rbrace> checkBudgetRestart \<lbrace>\<lambda>rv s. (rv \<longrightarrow> P s) \<and> (\<not>rv \<longrightarrow> Q s)\<rbrace>"
-  apply (wpsimp wp: checkBudgetRestart_true)
-  apply (wpsimp wp: hoare_drop_imp)+
-  done
+                   in hoare_strengthen_postE[rotated])
 
-lemma setCurTime_invs'[wp]:
-  "setCurTime v \<lbrace>invs'\<rbrace>"
-  unfolding setCurTime_def
-  apply wp
-  apply (clarsimp simp: invs'_def valid_machine_state'_def
-                        valid_irq_node'_def valid_release_queue_def valid_release_queue'_def)
-  apply (clarsimp simp: valid_dom_schedule'_def valid_queues'_def valid_queues_def valid_bitmapQ_def
-                        bitmapQ_def valid_queues_no_bitmap_def bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def)
+        apply (clarsimp simp: isCap_simps sch_act_sane_not)
+       apply assumption
+      apply (wp deleteCallerCap_nonz_cap)+
+  apply (auto elim: st_tcb_ex_cap'' pred_tcb'_weakenE
+             dest!: st_tcb_at_idle_thread'
+              simp: ct_in_state'_def sch_act_sane_def)
   done
 
-lemma updateTimeStamp_invs'[wp]:
-  "updateTimeStamp \<lbrace>invs'\<rbrace>"
-  unfolding updateTimeStamp_def
-  by (wpsimp wp: dmo_invs'_simple simp: getCurrentTime_def no_irq_def)
-
-lemma updateTimeStamp_sch_act_simple[wp]:
-  "updateTimeStamp \<lbrace>sch_act_simple\<rbrace>"
-  unfolding updateTimeStamp_def sch_act_simple_def setDomainTime_def
-  by (wpsimp wp: dmo_invs'_simple simp: setCurTime_def)
-
-crunch updateTimeStamp
-  for ksPSpace[wp]: "\<lambda>s. P (ksPSpace s)"
-  and tcb_at'[wp]: "tcb_at' t"
-
-crunch getCapReg, refillCapacity
-  for inv[wp]: P
 
 lemma handleEvent_valid_duplicates':
   "\<lbrace>invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
     sch_act_simple and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running' s)\<rbrace>
    handleEvent e
    \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  supply if_cong[cong]
-  apply (case_tac e; simp add: handleEvent_def)
-       apply (rename_tac syscall, case_tac syscall; simp)
-                 apply (wpsimp wp: checkBudgetRestart_gen stateAssertE_inv active_from_running'
-                                   hoare_vcg_if_lift2)+
+  apply (case_tac e, simp_all add: handleEvent_def)
+      apply (rename_tac syscall)
+      apply (case_tac syscall)
+            apply (wp handleReply_sane
+              | simp add: active_from_running' simple_sane_strg cong: if_cong
+              | wpc)+
   done
 
 (* nothing extra needed on this architecture *)
@@ -2314,8 +2280,19 @@ lemma callKernel_valid_duplicates':
     (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running' s)\<rbrace>
    callKernel e
    \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (simp add: callKernel_def mcsPreemptionPoint_def)
-  apply (wpsimp wp: hoare_drop_imp hoare_vcg_if_lift2 handleEvent_valid_duplicates')
+  apply (simp add: callKernel_def fastpathKernelAssertions_def)
+  apply (rule hoare_pre)
+   apply (wp activate_invs' activate_sch_act schedule_sch
+             schedule_sch_act_simple he_invs'
+          | simp add: no_irq_getActiveIRQ
+          | wp (once) hoare_drop_imps )+
+   apply (rule hoare_strengthen_postE)
+     apply (rule valid_validE)
+     prefer 2
+     apply assumption
+    apply (wp handleEvent_valid_duplicates')
+   apply simp
+  apply simp
   done
 
 end
diff --git a/proof/refine/ARM/RAB_FN.thy b/proof/refine/ARM/RAB_FN.thy
index eb7eea5bb4..969cb775de 100644
--- a/proof/refine/ARM/RAB_FN.thy
+++ b/proof/refine/ARM/RAB_FN.thy
@@ -78,7 +78,7 @@ declare resolveAddressBitsFn.simps[simp del]
 
 lemma isCNodeCap_capUntypedPtr_capCNodePtr:
   "isCNodeCap c \<Longrightarrow> capUntypedPtr c = capCNodePtr c"
-  by (clarsimp simp: isCap_simps State_H.ARM_H.PPtr_def)
+  by (clarsimp simp: isCap_simps)
 
 lemma resolveAddressBitsFn_eq:
   "monadic_rewrite F E (\<lambda>s. (isCNodeCap cap \<longrightarrow> (\<exists>slot. cte_wp_at' (\<lambda>cte. cteCap cte = cap) slot s))
diff --git a/proof/refine/ARM/Refine.thy b/proof/refine/ARM/Refine.thy
index 89474fd975..f8b1edefcf 100644
--- a/proof/refine/ARM/Refine.thy
+++ b/proof/refine/ARM/Refine.thy
@@ -16,7 +16,7 @@ imports
   PageTableDuplicates
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 text \<open>User memory content is the same on both levels\<close>
 lemma typ_at_AUserDataI:
@@ -86,7 +86,6 @@ lemma typ_at_UserDataI:
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
                      if_split_asm arch_kernel_obj.split_asm)
-  apply (case_tac ko; simp)
   apply (rename_tac vmpage_size n)
   apply (rule_tac x = vmpage_size in exI)
   apply (subst conjunct2 [OF is_aligned_add_helper])
@@ -118,7 +117,6 @@ lemma typ_at_DeviceDataI:
               split: Structures_A.kernel_object.split_asm
                      Structures_H.kernel_object.split_asm
                      if_split_asm arch_kernel_obj.split_asm)
-  apply (case_tac ko; simp)
   apply (rename_tac vmpage_size n)
   apply (rule_tac x = vmpage_size in exI)
   apply (subst conjunct2 [OF is_aligned_add_helper])
@@ -130,7 +128,7 @@ lemma typ_at_DeviceDataI:
   done
 
 lemma pointerInUserData_relation:
-  "\<lbrakk> (s,s') \<in> state_relation; invs' s'; valid_state s\<rbrakk>
+  "\<lbrakk> (s,s') \<in> state_relation; valid_state' s'; valid_state s\<rbrakk>
    \<Longrightarrow> pointerInUserData p s' = in_user_frame p s"
   apply (simp add: pointerInUserData_def in_user_frame_def)
   apply (rule iffI)
@@ -139,7 +137,7 @@ lemma pointerInUserData_relation:
   apply (drule_tac sz = sz and
                    n = "(p && mask (pageBitsForSize sz)) >> pageBits"
     in typ_at_AUserDataI [where s = s and s' = s'])
-      apply fastforce+
+      apply (fastforce simp: valid_state'_def)+
    apply (rule shiftr_less_t2n')
     apply (simp add: pbfs_atleast_pageBits mask_twice)
    apply (case_tac sz, simp_all)[1]
@@ -156,7 +154,7 @@ lemma pointerInUserData_relation:
   done
 
 lemma pointerInDeviceData_relation:
-  "\<lbrakk> (s,s') \<in> state_relation; invs' s'; valid_state s\<rbrakk>
+  "\<lbrakk> (s,s') \<in> state_relation; valid_state' s'; valid_state s\<rbrakk>
    \<Longrightarrow> pointerInDeviceData p s' = in_device_frame p s"
   apply (simp add: pointerInDeviceData_def in_device_frame_def)
   apply (rule iffI)
@@ -165,7 +163,7 @@ lemma pointerInDeviceData_relation:
   apply (drule_tac sz = sz and
                    n = "(p && mask (pageBitsForSize sz)) >> pageBits"
     in typ_at_ADeviceDataI [where s = s and s' = s'])
-      apply (fastforce simp: invs'_def)+
+      apply (fastforce simp: valid_state'_def)+
    apply (rule shiftr_less_t2n')
     apply (simp add: pbfs_atleast_pageBits mask_twice)
    apply (case_tac sz, simp_all)[1]
@@ -182,7 +180,7 @@ lemma pointerInDeviceData_relation:
   done
 
 lemma user_mem_relation:
-  "\<lbrakk>(s,s') \<in> state_relation; invs' s'; valid_state s\<rbrakk>
+  "\<lbrakk>(s,s') \<in> state_relation; valid_state' s'; valid_state s\<rbrakk>
    \<Longrightarrow> user_mem' s' = user_mem s"
   apply (rule ext)
   apply (clarsimp simp: user_mem_def user_mem'_def pointerInUserData_relation pointerInDeviceData_relation)
@@ -190,199 +188,140 @@ lemma user_mem_relation:
   done
 
 lemma device_mem_relation:
-  "\<lbrakk>(s,s') \<in> state_relation; invs' s'; valid_state s\<rbrakk>
+  "\<lbrakk>(s,s') \<in> state_relation; valid_state' s'; valid_state s\<rbrakk>
    \<Longrightarrow> device_mem' s' = device_mem s"
-  unfolding device_mem_def device_mem'_def
-  by (rule ext) (clarsimp simp: pointerInUserData_relation pointerInDeviceData_relation)
+  apply (rule ext)
+  apply (clarsimp simp: device_mem_def device_mem'_def pointerInUserData_relation
+     pointerInDeviceData_relation)
+  done
 
 lemma absKState_correct:
-  assumes invs: "einvs (s :: det_ext state)" and invs': "invs' s'"
-  assumes rel: "(s,s') \<in> state_relation"
-  shows "absKState s' = abs_state s"
+assumes invs: "einvs (s :: det_ext state)" and invs': "invs' s'"
+assumes rel: "(s,s') \<in> state_relation"
+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 simp: state_relation_sc_replies_relation)
-                      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 (simp add: state_relation_def)
-               apply (simp add: state_relation_def)
-              apply (simp add: 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 (fastforce simp: curry_def state_relation_def ready_queues_relation_def)
-       apply (simp add: state_relation_def release_queue_relation_def)
+           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:  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>
 
-lemma kernel_entry_invs_det_ext:
-  "\<lbrace>\<lambda>s. invs s \<and> schact_is_rct s \<and> cur_sc_active s \<and> ct_not_in_release_q s
-          \<and> (e \<noteq> Interrupt \<longrightarrow> ct_running s)\<rbrace>
-   kernel_entry e us
-   \<lbrace>\<lambda>_ s :: det_state. invs s \<and> (ct_running s \<or> ct_idle s)\<rbrace>"
-  apply (simp add: kernel_entry_def)
-  apply (wp akernel_invs_det_ext thread_set_invs_trivial thread_set_ct_in_state
-            hoare_weak_lift_imp hoare_vcg_disj_lift hoare_vcg_imp_lift'
-         | clarsimp simp add: tcb_cap_cases_def)+
+lemma set_thread_state_sched_act:
+  "\<lbrace>(\<lambda>s. runnable state) and (\<lambda>s. P (scheduler_action s))\<rbrace>
+  set_thread_state thread state
+  \<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 wp
+       apply (rule hoare_pre_cont)
+      apply (rule_tac Q'="\<lambda>rv. (\<lambda>s. runnable ts) and (\<lambda>s. P (scheduler_action s))"
+              in hoare_strengthen_post)
+       apply wp
+      apply force
+     apply (wp gts_st_tcb_at)+
+     apply (rule_tac Q'="\<lambda>rv. st_tcb_at ((=) state) thread and (\<lambda>s. runnable state) and (\<lambda>s. P (scheduler_action s))" in hoare_strengthen_post)
+     apply (simp add: st_tcb_at_def)
+     apply (wp obj_set_prop_at)+
+    apply (force simp: st_tcb_at_def obj_at_def)
+  apply wp
+  apply clarsimp
   done
 
-lemma kernel_entry_valid_sched:
-  "\<lbrace>\<lambda>s. valid_sched s \<and> invs s \<and> schact_is_rct s
-        \<and> cur_sc_active s \<and> ct_not_in_release_q s
-        \<and> (ct_running s \<or> ct_idle s) \<and> (e \<noteq> Interrupt \<longrightarrow> ct_running s)
-        \<and> valid_machine_time s \<and> current_time_bounded s \<and> consumed_time_bounded s
-        \<and> cur_sc_offset_ready (consumed_time s) s
-        \<and> cur_sc_offset_sufficient (consumed_time s) s\<rbrace>
-   kernel_entry e us
-   \<lbrace>\<lambda>_. valid_sched :: det_state \<Rightarrow> _\<rbrace>"
-  apply (simp add: kernel_entry_def)
-  apply (wp call_kernel_valid_sched thread_set_invs_trivial thread_set_ct_in_state
-            hoare_weak_lift_imp hoare_vcg_disj_lift thread_set_not_state_valid_sched
-         | clarsimp simp add: tcb_cap_cases_def)+
+lemma activate_thread_sched_act:
+  "\<lbrace>ct_in_state activatable and (\<lambda>s. P (scheduler_action s))\<rbrace>
+  activate_thread
+  \<lbrace>\<lambda>rs s. P (scheduler_action (s::det_state))\<rbrace>"
+  by (simp add: activate_thread_def set_thread_state_def arch_activate_idle_thread_def
+      | (wp set_thread_state_sched_act gts_wp)+ | wpc)+
+
+lemma schedule_sched_act_rct[wp]:
+  "\<lbrace>\<top>\<rbrace> Schedule_A.schedule
+  \<lbrace>\<lambda>rs (s::det_state). scheduler_action s = resume_cur_thread\<rbrace>"
+  unfolding Schedule_A.schedule_def
+  by (wpsimp)
+
+lemma call_kernel_sched_act_rct[wp]:
+  "\<lbrace>einvs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running s)
+     and (\<lambda>s. scheduler_action s = resume_cur_thread)\<rbrace>
+  call_kernel e
+  \<lbrace>\<lambda>rs (s::det_state). scheduler_action s = resume_cur_thread\<rbrace>"
+  apply (simp add: call_kernel_def)
+  apply (wp activate_thread_sched_act | simp)+
+  apply (clarsimp simp: active_from_running)
   done
 
-abbreviation (input) mcs_invs where
-  "mcs_invs s \<equiv> einvs s
-                 \<and> scheduler_action s = resume_cur_thread
-                 \<and> cur_sc_active s \<and> ct_not_in_release_q s
-                 \<and> valid_machine_time s \<and> current_time_bounded s \<and> consumed_time_bounded s
-                 \<and> (cur_sc_offset_ready (consumed_time s) s
-                    \<and> cur_sc_offset_sufficient (consumed_time s) s)
-                 \<and> valid_domain_list s "
-
 lemma kernel_entry_invs:
-  "\<lbrace>\<lambda>s. mcs_invs s \<and> (ct_running s \<or> ct_idle s) \<and> (e \<noteq> Interrupt \<longrightarrow> ct_running s)\<rbrace>
-   kernel_entry e us
-   \<lbrace>\<lambda>_ s. mcs_invs s \<and> (ct_running s \<or> ct_idle s)\<rbrace>"
-  apply (rule_tac Q'="\<lambda>_ s. (invs s \<and> (ct_running s \<or> ct_idle s))
-                           \<and> (cur_sc_offset_ready (consumed_time s) s
-                              \<and> cur_sc_offset_sufficient (consumed_time s) s)
-                           \<and> valid_sched s
-                           \<and> valid_domain_list s
-                           \<and> valid_list s \<and> scheduler_action s = resume_cur_thread
-                           \<and> cur_sc_active s \<and> ct_not_in_release_q s
-                           \<and> valid_machine_time s \<and> current_time_bounded s
-                           \<and> consumed_time_bounded s"
+  "\<lbrace>einvs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running s)
+    and (\<lambda>s. 0 < domain_time s) and valid_domain_list and (ct_running or ct_idle)
+    and (\<lambda>s. scheduler_action s = resume_cur_thread)\<rbrace>
+  kernel_entry e us
+  \<lbrace>\<lambda>rv. einvs and (\<lambda>s. ct_running s \<or> ct_idle s)
+    and (\<lambda>s. 0 < domain_time s) and valid_domain_list
+    and (\<lambda>s. scheduler_action s = resume_cur_thread)\<rbrace>"
+  apply (rule_tac Q'="\<lambda>rv. invs and (\<lambda>s. ct_running s \<or> ct_idle s) and valid_sched and
+                           (\<lambda>s. 0 < domain_time s) and valid_domain_list and
+                           valid_list and (\<lambda>s. scheduler_action s = resume_cur_thread)"
             in hoare_post_imp)
    apply clarsimp
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (wpsimp wp: kernel_entry_invs_det_ext)
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (clarsimp simp: kernel_entry_def)
-   apply (wp thread_set_invs_trivial thread_set_not_state_valid_sched hoare_vcg_disj_lift
-             ct_in_state_thread_state_lift thread_set_no_change_tcb_state
-             hoare_weak_lift_imp call_kernel_cur_sc_offset_ready_and_sufficient
-          | clarsimp simp: tcb_cap_cases_def)+
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (wpsimp wp: kernel_entry_valid_sched)
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (clarsimp simp: kernel_entry_def)
-   apply (wpsimp wp: call_kernel_domain_list_inv_det_ext | clarsimp simp: active_from_running)+
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (clarsimp simp: kernel_entry_def)
-   apply wpsimp
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (clarsimp simp: kernel_entry_def)
-   apply (wp thread_set_invs_trivial thread_set_not_state_valid_sched hoare_vcg_disj_lift
-             ct_in_state_thread_state_lift thread_set_no_change_tcb_state hoare_weak_lift_imp
-             call_kernel_schact_is_rct[unfolded schact_is_rct_def]
-          | clarsimp simp: tcb_cap_cases_def)+
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (clarsimp simp: kernel_entry_def)
-   apply (wp thread_set_invs_trivial thread_set_not_state_valid_sched hoare_vcg_disj_lift
-             ct_in_state_thread_state_lift thread_set_no_change_tcb_state hoare_weak_lift_imp
-             call_kernel_cur_sc_active
-          | clarsimp simp: tcb_cap_cases_def)+
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (clarsimp simp: kernel_entry_def)
-   apply (wp thread_set_invs_trivial thread_set_not_state_valid_sched hoare_vcg_disj_lift
-             ct_in_state_thread_state_lift thread_set_no_change_tcb_state
-             hoare_weak_lift_imp call_kernel_ct_not_in_release_q
-          | clarsimp simp: tcb_cap_cases_def)+
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (clarsimp simp: kernel_entry_def)
-   apply wpsimp
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (clarsimp simp: kernel_entry_def)
-   apply (wpsimp wp: call_kernel_current_time_bounded)
-  apply (clarsimp simp: kernel_entry_def)
-  apply (wpsimp wp: call_kernel_consumed_time_bounded)
+  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
+            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
+      | clarsimp simp add: tcb_cap_cases_def active_from_running)+
   done
 
 definition
-  "full_invs
-     \<equiv> {((tc, s :: det_ext state), m, e). mcs_invs s
-                                          \<and> (ct_running s \<or> ct_idle s)
-                                          \<and> (m = KernelMode \<longrightarrow> e \<noteq> None)
-                                          \<and> (m = UserMode \<longrightarrow> ct_running s)
-                                          \<and> (m = IdleMode \<longrightarrow> ct_idle s)
-                                          \<and> (e \<noteq> None \<and> e \<noteq> Some Interrupt \<longrightarrow> ct_running s)}"
-
-crunch do_user_op, check_active_irq
-  for valid_list[wp]: valid_list
-  and valid_sched[wp]: valid_sched
-  and sched_act[wp]: "\<lambda>s. P (scheduler_action s)"
-  and domain_time[wp]: "\<lambda>s. P (domain_time s)"
-  and cur_sc_active[wp]: cur_sc_active
-  and ct_not_in_release_q[wp]: ct_not_in_release_q
-  and current_time_bounded[wp]: current_time_bounded
-  and cur_sc_offset_ready[wp]: "\<lambda>s. cur_sc_offset_ready (consumed_time s) s"
-  and cur_sc_offset_sufficient[wp]: "\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s"
-  and consumed_time_bounded[wp]: consumed_time_bounded
-
-lemma device_update_valid_machine_time[wp]:
-  "do_machine_op (device_memory_update ds) \<lbrace>valid_machine_time\<rbrace>"
-  apply (simp add: do_machine_op_def device_memory_update_def simpler_modify_def select_f_def
-                   gets_def get_def bind_def valid_def return_def)
+  "full_invs \<equiv> {((tc, s :: det_ext state), m, e). einvs s \<and>
+                                 (ct_running s \<or> ct_idle s) \<and>
+                                 (m = KernelMode \<longrightarrow> e \<noteq> None) \<and>
+                                 (m = UserMode \<longrightarrow> ct_running s) \<and>
+                                 (m = IdleMode \<longrightarrow> ct_idle s) \<and>
+                                 (e \<noteq> None \<and> e \<noteq> Some Interrupt \<longrightarrow> ct_running s) \<and>
+                                 0 < domain_time s \<and> valid_domain_list s \<and>
+                                 (scheduler_action s = resume_cur_thread)}"
+
+lemma do_user_op_valid_list:"\<lbrace>valid_list\<rbrace> do_user_op f tc \<lbrace>\<lambda>_. valid_list\<rbrace>"
+  unfolding do_user_op_def
+  apply (wp | simp add: split_def)+
   done
 
-lemma user_memory_update_valid_machine_time[wp]:
-  "do_machine_op (user_memory_update ds) \<lbrace>valid_machine_time\<rbrace>"
-  apply (simp add: do_machine_op_def user_memory_update_def simpler_modify_def select_f_def
-                   gets_def get_def bind_def valid_def return_def)
+lemma do_user_op_valid_sched:"\<lbrace>valid_sched\<rbrace> do_user_op f tc \<lbrace>\<lambda>_. valid_sched\<rbrace>"
+  unfolding do_user_op_def
+  apply (wp | simp add: split_def)+
   done
 
-lemma do_user_op_valid_machine_time[wp]:
-  "do_user_op f tc \<lbrace>valid_machine_time\<rbrace>"
-  apply (simp add: do_user_op_def)
-  apply wpsimp
-  done
-
-lemma check_active_irq_valid_machine_time[wp]:
-  "check_active_irq \<lbrace>valid_machine_time\<rbrace>"
-  apply (clarsimp simp: check_active_irq_def)
-  apply (wpsimp wp: getActiveIRQ_inv)
+lemma do_user_op_sched_act:
+  "\<lbrace>\<lambda>s. P (scheduler_action s)\<rbrace> do_user_op f tc \<lbrace>\<lambda>_ s. P (scheduler_action s)\<rbrace>"
+  unfolding do_user_op_def
+  apply (wp | simp add: split_def)+
   done
 
 lemma do_user_op_invs2:
-  "do_user_op f tc
-   \<lbrace>\<lambda>s. mcs_invs s \<and> ct_running s\<rbrace>"
-  apply (rule_tac Q'="\<lambda>_ s. (invs s \<and> ct_running s) \<and> valid_list s \<and> valid_sched s
-                           \<and> scheduler_action s = resume_cur_thread
-                           \<and> valid_domain_list s
-                           \<and> cur_sc_active s \<and> ct_not_in_release_q s
-                           \<and> valid_machine_time s \<and> current_time_bounded s
-                           \<and> consumed_time_bounded s
-                           \<and> cur_sc_offset_ready (consumed_time s) s
-                           \<and> cur_sc_offset_sufficient (consumed_time s) s"
-               in hoare_post_imp, fastforce)
-  apply (rule hoare_vcg_conj_lift_pre_fix)
-   apply (wpsimp wp: do_user_op_invs[simplified pred_conj_def])
-  apply (wp do_user_op_valid_list do_user_op_valid_sched do_user_op_sched_act do_user_op_domain_time
-         | fastforce)+
+  "\<lbrace>einvs  and ct_running and (\<lambda>s. scheduler_action s = resume_cur_thread)
+    and (\<lambda>s. 0 < domain_time s) and valid_domain_list \<rbrace>
+  do_user_op f tc
+   \<lbrace>\<lambda>_. (einvs  and ct_running and (\<lambda>s. scheduler_action s = resume_cur_thread))
+        and (\<lambda>s. 0 < domain_time s) and valid_domain_list \<rbrace>"
+  apply (rule_tac Q'="\<lambda>_. valid_list and valid_sched and
+   (\<lambda>s. scheduler_action s = resume_cur_thread) and (invs and ct_running) and
+   (\<lambda>s. 0 < domain_time s) and valid_domain_list"
+   in hoare_strengthen_post)
+  apply (wp do_user_op_valid_list do_user_op_valid_sched do_user_op_sched_act
+    do_user_op_invs | simp | force)+
   done
 
 lemmas ext_init_def = ext_init_det_ext_ext_def ext_init_unit_def
@@ -396,68 +335,16 @@ 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 (insert getCurrentTime_buffer_bound MIN_BUDGET_le_MAX_PERIOD')
-  apply (clarsimp simp: init_kheap_def obj_at_def idle_thread_ptr_def init_globals_frame_def
-                        init_global_pd_def ct_not_in_q_def valid_sched_action_def is_activatable_def
-                        ct_in_cur_domain_2_def valid_idle_etcb_def etcb_at'_def
-                        valid_ready_qs_def ready_or_release_2_def in_queues_2_def
-                        idle_sc_ptr_def valid_blocked_defs default_domain_def minBound_word
-                        released_ipc_queues_defs active_reply_scs_def active_if_reply_sc_at_def
-                        active_sc_def MIN_REFILLS_def)
-  by (auto simp: vs_all_heap_simps active_scs_valid_def cfg_valid_refills_def
-                 rr_valid_refills_def MIN_REFILLS_def bounded_release_time_def
-                 default_sched_context_def MAX_PERIOD_def active_sc_def
-          intro: order_trans[OF mult_left_mono, OF us_to_ticks_helper])
+  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 init_globals_frame_def
+                    init_global_pd_def valid_queues_2_def ct_not_in_q_def not_queued_def
+                    valid_sched_action_def is_activatable_def
+                    ct_in_cur_domain_2_def valid_blocked_2_def valid_idle_etcb_def etcb_at'_def default_etcb_def)
+  done
 
 lemma valid_domain_list_init[simp]:
   "valid_domain_list init_A_st"
-  apply (insert domain_time_pos)
-  apply (simp add: init_A_st_def ext_init_def valid_domain_list_def)
-  done
-
-lemma cur_sc_active_init[simp]:
-  "cur_sc_active init_A_st"
-  apply (clarsimp simp: init_A_st_def init_kheap_def vs_all_heap_simps active_sc_def MIN_REFILLS_def)
-  done
-
-lemma ct_not_in_release_q_init[simp]:
-  "ct_not_in_release_q init_A_st"
-  apply (clarsimp simp: init_A_st_def init_kheap_def not_in_release_q_def in_queue_2_def)
-  done
-
-lemma valid_machine_time_init[simp]:
-  "valid_machine_time init_A_st"
-  apply (clarsimp simp: init_A_st_def valid_machine_time_def init_machine_state_def)
-  done
-
-lemma current_time_bounded_init[simp]:
-  "current_time_bounded init_A_st"
-  apply (insert getCurrentTime_buffer_no_overflow)
-  apply (clarsimp simp: current_time_bounded_def init_A_st_def)
-  done
-
-lemma consumed_time_bounded_init[simp]:
-  "consumed_time_bounded init_A_st"
-  apply (clarsimp simp: init_kheap_def init_A_st_def)
-  done
-
-lemma cur_sc_offset_ready_and_sufficient[simp]:
-  "cur_sc_offset_ready (consumed_time init_A_st) init_A_st
-   \<and> cur_sc_offset_sufficient (consumed_time init_A_st) init_A_st"
-  apply (clarsimp simp: init_A_st_def)
-  done
-
-lemma check_active_irq_invs:
-  "check_active_irq \<lbrace>\<lambda>s. mcs_invs s \<and> (ct_running s \<or> ct_idle s)\<rbrace>"
-  by (wpsimp simp: check_active_irq_def ct_in_state_def)
-
-lemma check_active_irq_invs_just_running:
-  "check_active_irq \<lbrace>\<lambda>s. mcs_invs s \<and> ct_running s\<rbrace>"
-  by (wpsimp simp: check_active_irq_def ct_in_state_def)
-
-lemma check_active_irq_invs_just_idle:
-  "check_active_irq \<lbrace>\<lambda>s. mcs_invs s \<and> ct_idle s\<rbrace>"
-  by (wpsimp simp: check_active_irq_def ct_in_state_def)
+  by (simp add: init_A_st_def ext_init_def valid_domain_list_def)
 
 lemma akernel_invariant:
   "ADT_A uop \<Turnstile> full_invs"
@@ -468,55 +355,44 @@ lemma akernel_invariant:
    apply (simp add: Let_def Init_A_def)
    apply (simp add: init_A_st_def ext_init_def)
   apply (clarsimp simp: ADT_A_def global_automaton_def)
+
   apply (rename_tac tc' s' mode' e' tc s mode e)
   apply (elim disjE)
              apply ((clarsimp simp: kernel_call_A_def
-                    | drule use_valid[OF _ kernel_entry_invs])+)[2]
+                   | drule use_valid[OF _ kernel_entry_invs])+)[2]
            apply ((clarsimp simp: do_user_op_A_def monad_to_transition_def
                                   check_active_irq_A_def
-                  | drule use_valid[OF _ do_user_op_invs2]
-                  | drule use_valid[OF _ check_active_irq_invs_just_running]
-                  | drule use_valid[OF _ do_user_op_cur_sc_active])+)[2]
+                 | drule use_valid[OF _ do_user_op_invs2]
+                 | drule use_valid[OF _ check_active_irq_invs_just_running])+)[2]
          apply ((clarsimp simp add: check_active_irq_A_def
-                | drule use_valid[OF _ check_active_irq_invs])+)[1]
+               | drule use_valid[OF _ check_active_irq_invs])+)[1]
         apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def)
        apply ((clarsimp simp add: do_user_op_A_def check_active_irq_A_def
-              | drule use_valid[OF _ do_user_op_invs2]
-              | drule use_valid[OF _ check_active_irq_invs_just_running])+)[1]
+             | drule use_valid[OF _ do_user_op_invs2]
+             | drule use_valid[OF _ check_active_irq_invs_just_running])+)[1]
       apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def)
      apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def)
     apply ((clarsimp simp add: check_active_irq_A_def
-           | drule use_valid[OF _ check_active_irq_invs])+)[1]
+         | drule use_valid[OF _ check_active_irq_invs])+)[1]
    apply ((clarsimp simp add: check_active_irq_A_def
-          | drule use_valid[OF _ check_active_irq_invs_just_idle])+)[1]
+        | drule use_valid[OF _ check_active_irq_invs_just_idle])+)[1]
   apply ((clarsimp simp add: check_active_irq_A_def
-         | drule use_valid[OF _ check_active_irq_invs])+)[1]
+        | drule use_valid[OF _ check_active_irq_invs])+)[1]
   done
 
 lemma ckernel_invs:
-  "\<lbrace>invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
-    and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running' s) and (ct_running' or ct_idle')
-    and (\<lambda>s. is_active_sc' (ksCurSc s) s) and sym_heap_tcbSCs
-    and (\<lambda>s. obj_at' (\<lambda>sc. scTCB sc = Some (ksCurThread s)) (ksCurSc s) s)
-    and (\<lambda>s. pred_map (\<lambda>tcb. \<not> tcbInReleaseQueue tcb) (tcbs_of' s) (ksCurThread s))
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
-   callKernel e
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: callKernel_def mcsPreemptionPoint_def)
+  "\<lbrace>invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
+               (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running' s) and
+               (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
+  callKernel e
+  \<lbrace>\<lambda>rs. (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
+    and (invs' and (ct_running' or ct_idle'))\<rbrace>"
+  apply (simp add: callKernel_def)
   apply (rule hoare_pre)
-   apply (wpsimp wp: hoare_drop_imp[where Q'="\<lambda>_. kernelExitAssertions"] activate_invs')
-     apply (rule hoare_drop_imp)
-     apply (wpsimp wp: schedule_invs')
-    apply (wpsimp wp: stateAssert_wp)
-   apply (wpsimp wp: isSchedulable_wp hoare_drop_imp)
-    apply (intro iffI; clarsimp simp: isScActive_def isSchedulable_bool_def)
-   apply (rule hoare_strengthen_postE[where E'="\<lambda>_. invs'" and Q=Q and R=Q for Q])
-     apply wpsimp
-    apply (clarsimp simp: active_from_running')+
-  apply (clarsimp simp: sym_heap_def pred_map_def)
-  apply (rule_tac x="ksCurSc s" in exI)
-  apply (clarsimp simp: obj_at_simps is_active_sc'_def isScActive_def opt_map_red pred_map_def
-                        opt_pred_def)
+   apply (wp activate_invs' activate_sch_act schedule_sch
+             schedule_sch_act_simple he_invs' schedule_invs'
+             hoare_drop_imp[where Q'="\<lambda>_. kernelExitAssertions"]
+          | simp add: no_irq_getActiveIRQ)+
   done
 
 (* abstract and haskell have identical domain list fields *)
@@ -539,59 +415,52 @@ lemma corres_cross_over_fastpathKernelAssertions:
      (fastforce elim: fastpathKernelAssertions_cross)+
 
 defs kernelExitAssertions_def:
-  "kernelExitAssertions s \<equiv> valid_domain_list' s"
+  "kernelExitAssertions s \<equiv> 0 < ksDomainTime s \<and> valid_domain_list' s"
 
 lemma callKernel_domain_time_left:
-  "\<lbrace> \<top> \<rbrace> callKernel e \<lbrace>\<lambda>_ s. valid_domain_list' s \<rbrace>"
+  "\<lbrace> \<top> \<rbrace> callKernel e \<lbrace>\<lambda>_ s. 0 < ksDomainTime s \<and> valid_domain_list' s \<rbrace>"
   unfolding callKernel_def kernelExitAssertions_def by wpsimp
 
-lemma threadSet_is_active_sc'[wp]:
-  "threadSet f tp \<lbrace>\<lambda>s. is_active_sc' scp s\<rbrace>"
-  by (wpsimp simp: is_active_sc'_def)
-
-lemma threadSet_sym_heap_tcbSCs:
-  "\<forall>x. tcbSchedContext (f x) = tcbSchedContext x \<Longrightarrow>
-  threadSet f t \<lbrace>\<lambda>s. P (tcbSCs_of s) (scTCBs_of s)\<rbrace>"
-  unfolding threadSet_def
-  apply (rule bind_wp[OF _ get_tcb_sp'])
-  apply (wpsimp wp: setObject_tcb_tcbs_of' | wps)+
-  apply (prop_tac "((\<lambda>a. if a = t then Some (f tcb) else tcbs_of' s a) |>
-              tcbSchedContext) = tcbSCs_of s")
-   apply (rule ext)
-   apply (clarsimp simp: obj_at'_def projectKOs opt_map_def)
-  apply simp
-  done
-
 lemma kernelEntry_invs':
-  "\<lbrace> invs' and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running' s)
-    and (ct_running' or ct_idle')
-    and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
-    and (\<lambda>s. is_active_sc' (ksCurSc s) s) and sym_heap_tcbSCs
-    and (\<lambda>s. obj_at' (\<lambda>sc. scTCB sc = Some (ksCurThread s)) (ksCurSc s) s)
-    and (\<lambda>s. pred_map (\<lambda>tcb. \<not> tcbInReleaseQueue tcb) (tcbs_of' s) (ksCurThread s))
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-    and valid_domain_list' \<rbrace>
+  "\<lbrace> invs' and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running' s) and
+           (ct_running' or ct_idle') and
+           (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
+           (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
+           (\<lambda>s. 0 < ksDomainTime s) and valid_domain_list' \<rbrace>
   kernelEntry e tc
-  \<lbrace>\<lambda>_. invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))\<rbrace>"
-  apply (rule_tac P'1="\<lambda>s. obj_at' (\<lambda>tcb. tcbSchedContext tcb = Some (ksCurSc s)) (ksCurThread s) s"
-         in hoare_pre_add[THEN iffD2])
-   apply (clarsimp simp: obj_at'_tcb_scs_of_equiv obj_at'_sc_tcbs_of_equiv sym_heap_def)
-   apply (fastforce simp: ct_in_state'_def pred_tcb_at'_def obj_at'_def)
+  \<lbrace>\<lambda>rs. (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
+         (invs' and (ct_running' or ct_idle')) and
+         (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
+         (\<lambda>s. 0 < ksDomainTime s) and valid_domain_list' \<rbrace>"
   apply (simp add: kernelEntry_def)
-  apply (wpsimp wp: ckernel_invs callKernel_valid_duplicates' threadSet_invs_trivial
-                    threadSet_ct_in_state' hoare_weak_lift_imp hoare_vcg_disj_lift threadSet_sym_heap_tcbSCs
-         | wps)+
-    apply (rule hoare_vcg_conj_lift)
-     apply (wpsimp wp: threadSet_wp)
-    apply (wpsimp wp: threadSet_invs_trivial; simp?)
-    apply (wpsimp wp: threadSet_ct_running' hoare_weak_lift_imp)+
-  apply (fastforce simp: obj_at'_def projectKOs pred_map_def opt_map_red)
+  apply (wp ckernel_invs callKernel_valid_duplicates' callKernel_domain_time_left
+            threadSet_invs_trivial threadSet_ct_running'
+            TcbAcc_R.dmo_invs' hoare_weak_lift_imp
+            callKernel_domain_time_left
+         | clarsimp simp: user_memory_update_def no_irq_def tcb_at_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"
-  by (rule absKState_correct)
+  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"
@@ -612,12 +481,13 @@ proof -
   from invs invs' rel have [simp]: "absKState s' = abs_state s"
     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 "
     by (rule ptable_rights_imp_frame[OF valid rights[simplified]
                                              trans[simplified]])
   thus ?thesis
-   by (auto simp add: pointerInUserData_relation[OF rel invs' valid]
-     pointerInDeviceData_relation[OF rel invs' valid])
+   by (auto simp add: pointerInUserData_relation[OF rel valid' valid]
+     pointerInDeviceData_relation[OF rel valid' valid])
 qed
 
 
@@ -626,8 +496,7 @@ lemma device_update_invs':
    \<lbrace>\<lambda>_. invs'\<rbrace>"
    apply (simp add: doMachineOp_def device_memory_update_def simpler_modify_def select_f_def
                     gets_def get_def bind_def valid_def return_def)
-   by (clarsimp simp: invs'_def valid_irq_states'_def valid_machine_state'_def
-                      valid_dom_schedule'_def)
+   by (clarsimp simp: invs'_def valid_state'_def valid_irq_states'_def valid_machine_state'_def)
 
 lemmas ex_abs_def = ex_abs_underlying_def[where sr=state_relation and P=G,abs_def] for G
 
@@ -637,11 +506,11 @@ crunch doMachineOp
 lemma doUserOp_invs':
   "\<lbrace>invs' and ex_abs einvs and
     (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and ct_running' and
-    valid_domain_list'\<rbrace>
+    (\<lambda>s. 0 < ksDomainTime s) and valid_domain_list'\<rbrace>
    doUserOp f tc
    \<lbrace>\<lambda>_. invs' and
         (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and ct_running' and
-        valid_domain_list'\<rbrace>"
+        (\<lambda>s. 0 < ksDomainTime s) and valid_domain_list'\<rbrace>"
   apply (simp add: doUserOp_def split_def ex_abs_def)
   apply (wp device_update_invs'
     | (wp (once) dmo_invs', wpsimp simp: no_irq_modify device_memory_update_def
@@ -663,155 +532,9 @@ lemma doUserOp_valid_duplicates':
 
 text \<open>The top-level correspondence\<close>
 
-lemma kernel_preemption_corres:
-  "corres (dc \<oplus> dc)
-     (einvs and current_time_bounded and scheduler_act_sane
-      and (\<lambda>s. schact_is_rct s \<longrightarrow> cur_sc_active s)
-      and (\<lambda>s. schact_is_rct s \<longrightarrow> ct_in_state activatable s)
-      and cur_sc_chargeable and ct_not_blocked
-      and (\<lambda>s. cur_sc_active s \<longrightarrow> cur_sc_offset_ready (consumed_time s) s) and ct_not_queued
-      and consumed_time_bounded and ct_not_in_release_q)
-      invs'
-     (liftE preemption_path)
-     (liftE (do irq_opt <- doMachineOp (getActiveIRQ True);
-                   _ <- mcsPreemptionPoint irq_opt;
-                   when (\<exists>y. irq_opt = Some y) (handleInterrupt (the irq_opt))
-                od))" (is "corres _ ?P ?P' _ _")
-  apply (rule_tac Q="\<lambda>s. sc_at' (ksCurSc s) s" in corres_cross_add_guard)
-   apply clarsimp
-   apply (frule (1) cur_sc_tcb_sc_at_cur_sc[OF invs_valid_objs invs_cur_sc_tcb])
-   apply (drule state_relationD, clarsimp)
-   apply (erule sc_at_cross; fastforce simp: invs_def valid_state_def valid_pspace_def)
-  apply (rule corres_guard_imp)
-    apply (simp add: preemption_path_def mcsPreemptionPoint_def bind_assoc)
-    apply (rule corres_split[OF corres_machine_op])
-       apply (rule corres_underlying_trivial)
-       apply (rule no_fail_getActiveIRQ)
-      apply (clarsimp simp: dc_def[symmetric])
-      apply (rule corres_split_eqr[OF getCurThread_corres])
-        apply (rule corres_split_eqr[OF isSchedulable_corres])
-          apply (rename_tac irq ct sched)
-          apply (rule corres_split[OF corres_if2])
-               apply simp
-              apply (rule_tac P="?P and (\<lambda>s. ct = cur_thread s) and (\<lambda>s. sched = schedulable ct s)
-                                 and K sched"
-                         and P'="?P' and (\<lambda>s. ct = ksCurThread s)
-                                 and (\<lambda>s. sched = isSchedulable_bool ct s)"
-                     in corres_inst)
-              apply (rule corres_gen_asm')
-              apply(rule corres_guard_imp)
-                apply (rule corres_split_eqr[OF checkBudget_corres])
-                  apply (simp only: K_bind_def)
-                  apply (rule corres_return_trivial)
-                 apply wpsimp
-                apply wpsimp
-               apply (clarsimp simp: valid_sched_def runnable_eq_active
-                                     schedulable_def2 active_sc_tcb_at_def2 tcb_at_kh_simps[symmetric]
-                                     pred_tcb_at_def obj_at_def)
-               apply (rename_tac scp tcb)
-               apply (prop_tac "cur_sc_tcb_are_bound s \<and> scp = cur_sc s")
-                apply (clarsimp simp: cur_sc_chargeable_def)
-                apply (drule_tac x=scp in spec, clarsimp simp: vs_all_heap_simps)
-               apply clarsimp
-              apply simp
-             apply (simp add: get_sc_active_def active_sc_def dc_def[symmetric])
-             apply (rule corres_split_eqr[OF getCurSc_corres])
-               apply (rule corres_split[OF get_sc_corres])
-                 apply (rename_tac csc sc sc')
-                 apply (rule corres_if2)
-                   apply (clarsimp simp: sc_relation_def)
-                  apply (rule_tac P="?P and (\<lambda>s. ct = cur_thread s) and (\<lambda>s. sched = schedulable ct s)
-                                     and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext sc n) (cur_sc s) s)
-                                     and K (\<not>sched) and K (0 < sc_refill_max sc)"
-                             and P'="?P' and (\<lambda>s. ct = ksCurThread s)
-                                     and (\<lambda>s. sched = isSchedulable_bool ct s)"
-                         in corres_inst)
-                  apply(rule corres_guard_imp)
-                    apply (rule corres_split_eqr[OF getConsumedTime_corres])
-                      apply (rule chargeBudget_corres)
-                     apply wpsimp
-                    apply wpsimp
-                   apply (prop_tac "cur_sc_active s")
-                    apply (clarsimp simp: obj_at_def is_sc_active_kh_simp[symmetric]
-                                          is_sc_active_def2)
-                    apply (clarsimp simp: active_sc_def)
-                   apply (clarsimp simp: valid_sched_def)
-                   apply clarsimp
-                 apply (rule setConsumedTime_corres)
-                 apply simp
-                apply wpsimp
-               apply wpsimp
-              apply wpsimp
-             apply wpsimp
-            apply (rule_tac x=irq in option_corres)
-              apply (rule_tac P=\<top> and P'=\<top> in corres_inst)
-              apply (simp add: when_def)
-             apply (rule corres_when, simp)
-             apply simp
-             apply (rule handleInterrupt_corres)
-            apply simp
-           apply (rule hoare_vcg_if_split)
-            apply (wpsimp wp: check_budget_valid_sched hoare_vcg_imp_lift')
-           apply (wpsimp wp: hoare_vcg_if_split)
-               apply (wpsimp wp: charge_budget_valid_sched hoare_vcg_imp_lift')
-              apply wpsimp
-             apply wpsimp
-            apply wpsimp
-           apply wpsimp
-          apply (rule_tac Q'="\<lambda>_ s. bound irq \<longrightarrow> invs' s \<and> (intStateIRQTable (ksInterruptState s) (the irq) \<noteq>
-                                   irqstate.IRQInactive)"
-                 in hoare_strengthen_post[rotated])
-           apply clarsimp
-          apply (wpsimp wp: hoare_vcg_imp_lift')
-         apply clarsimp
-         apply (wpsimp wp: is_schedulable_wp')
-        apply (wpsimp wp: isSchedulable_wp cong: conj_cong imp_cong)
-       apply wpsimp
-      apply wpsimp
-     apply (rule_tac Q'="\<lambda>_ s. invs s \<and>  valid_sched s \<and> valid_list s \<and> scheduler_act_sane s \<and>
-                              consumed_time_bounded s \<and> ct_not_blocked s \<and> ct_not_in_release_q s \<and>
-                              current_time_bounded s \<and> cur_sc_chargeable s \<and>
-                              (cur_sc_active s \<longrightarrow> cur_sc_offset_ready (consumed_time s) s) \<and>
-                              (schact_is_rct s \<longrightarrow> cur_sc_active s) \<and> ct_not_queued s \<and>
-                              (schact_is_rct s \<longrightarrow> ct_in_state activatable s)"
-            in hoare_strengthen_post[rotated])
-      apply clarsimp
-      apply (frule ct_not_blocked_cur_sc_not_blocked, clarsimp)
-      apply clarsimp
-      apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_objs_valid_tcbs
-                            valid_sched_def cur_tcb_def ct_in_state_kh_simp[symmetric])
-      apply (intro conjI; clarsimp simp: schedulable_def2 ct_in_state_def)
-        apply (clarsimp simp: current_time_bounded_def)
-        apply (rule context_conjI)
-         apply (clarsimp simp: cur_sc_tcb_def sc_tcb_sc_at_def obj_at_def is_sc_obj)
-         apply (erule (1) valid_sched_context_size_objsI)
-        apply clarsimp
-       apply (frule (1) cur_sc_chargeable_when_ct_active_sc)
-       apply (frule (1) active_sc_tcb_at_ct_cur_sc_active[THEN iffD2])
-       apply (clarsimp simp: current_time_bounded_def)
-      apply (rule context_conjI)
-       apply (clarsimp simp: vs_all_heap_simps obj_at_def)
-      apply (drule consumed_time_bounded_helper)
-       apply clarsimp
-      apply clarsimp
-     apply wpsimp
-    apply (rule_tac Q'="\<lambda>irq s. invs' s \<and> sc_at' (ksCurSc s) s \<and>
-                               (\<forall>irq'. irq = Some irq' \<longrightarrow>
-                                         intStateIRQTable (ksInterruptState s ) irq' \<noteq> IRQInactive)"
-           in hoare_post_imp)
-     apply (clarsimp simp: invs'_def valid_pspace'_def valid_objs'_valid_tcbs')
-    apply ((wp doMachineOp_getActiveIRQ_IRQ_active  | simp)+)[1]
-   apply clarsimp
-  apply (clarsimp simp: invs'_def)
-  done
-
 lemma kernel_corres':
   "corres dc (einvs and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running s) and (ct_running or ct_idle)
-              and current_time_bounded and consumed_time_bounded and valid_machine_time
-              and ct_not_in_release_q and cur_sc_active
-              and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-              and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s)
-              and (\<lambda>s. scheduler_action s = resume_cur_thread))
+               and (\<lambda>s. scheduler_action s = resume_cur_thread))
              (invs' and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running' s) and (ct_running' or ct_idle') and
               (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
               (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
@@ -819,155 +542,57 @@ lemma kernel_corres':
              (do _ \<leftarrow> runExceptT $
                       handleEvent event `~catchError~`
                         (\<lambda>_. withoutPreemption $ do
-                               irq_opt <- doMachineOp (getActiveIRQ True);
-                               _ \<leftarrow> mcsPreemptionPoint irq_opt;
-                               when (isJust irq_opt) $ handleInterrupt (fromJust irq_opt)
+                               irq <- doMachineOp (getActiveIRQ True);
+                               when (isJust irq) $ handleInterrupt (fromJust irq)
                              od);
-                 _ \<leftarrow> stateAssert rct_imp_activatable'_asrt [];
                  _ \<leftarrow> ThreadDecls_H.schedule;
-                 _ \<leftarrow> stateAssert rct_imp_activatable'_asrt [];
                  activateThread
-              od)" (is "corres _ ?P ?P' _ _")
-  unfolding call_kernel_def
-  apply add_cur_tcb'
-  apply (rule_tac Q="\<lambda>s. obj_at' (\<lambda>sc. scTCB sc = Some (ksCurThread s)) (ksCurSc s) s" in corres_cross_add_guard)
-   apply (fastforce simp: invs_def valid_state_def valid_pspace_def intro!: cur_sc_tcb_cross)
-  apply (rule_tac Q="\<lambda>s'. pred_map (\<lambda>tcb. \<not> tcbInReleaseQueue tcb) (tcbs_of' s') (ksCurThread s')"
-         in corres_cross_add_guard)
-   apply (clarsimp, frule tcb_at_invs)
-   apply (fastforce simp: not_in_release_q_def release_queue_relation_def pred_map_def opt_map_red obj_at'_def
-                          invs'_def valid_pspace'_def projectKOs valid_release_queue'_def cur_tcb'_def
-                   dest!: state_relationD)
-  apply (rule_tac Q="\<lambda>s'. pred_map (\<lambda>scPtr. isScActive scPtr s') (tcbSCs_of s') (ksCurThread s')"
-         in corres_cross_add_guard)
-   apply clarsimp
-   apply (frule invs_cur_sc_tcb_symref, clarsimp simp: schact_is_rct)
-   apply (prop_tac "sc_at (cur_sc s) s")
-    apply (frule invs_cur_sc_tcb)
-    apply (clarsimp simp: cur_sc_tcb_def sc_tcb_sc_at_def obj_at_def is_sc_obj)
-    apply (erule (1) valid_sched_context_size_objsI[OF invs_valid_objs])
-   apply (frule (4) active_sc_at'_cross[OF _ invs_psp_aligned invs_distinct])
-   apply (clarsimp simp: active_sc_at'_def obj_at'_def projectKOs cur_tcb'_def pred_tcb_at_def
-                         is_sc_obj obj_at_def  pred_map_def isScActive_def
-                  dest!: state_relationD)
-   apply (rule_tac x="cur_sc s" in exI, clarsimp simp: opt_map_red)
-   apply (frule_tac x="ksCurThread s'" in pspace_relation_absD, simp)
-   apply (fastforce simp: other_obj_relation_def tcb_relation_def)
-  apply simp
+              od)"
+  unfolding call_kernel_def callKernel_def
+  apply (simp add: call_kernel_def callKernel_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split)
        apply (rule corres_split_handle[OF handleEvent_corres])
-         (* handle *)
-         apply (rule kernel_preemption_corres)
-        apply (rule_tac E'="\<lambda>_ s. einvs s \<and> scheduler_act_sane s \<and> cur_sc_chargeable s \<and>
-                                 (schact_is_rct s \<longrightarrow> cur_sc_active s) \<and> ct_not_queued s \<and>
-                                 (schact_is_rct s \<longrightarrow> ct_in_state activatable s) \<and>
-                                 (cur_sc_active s \<longrightarrow> cur_sc_offset_ready (consumed_time s) s) \<and>
-                                 ct_not_blocked s \<and> current_time_bounded s \<and>
-                                 ct_not_in_release_q s \<and> consumed_time_bounded s"
-               in hoare_strengthen_postE[where Q=Q and R=Q for Q])
-          apply (wpsimp wp: handle_event_schact_is_rct_imp_ct_activatable
-                            handle_event_schact_is_rct_imp_cur_sc_active call_kernel_schact_is_rct
-                            handle_event_scheduler_act_sane handle_event_ct_not_queuedE_E
-                            handle_event_cur_sc_chargeable handle_event_cur_sc_more_than_ready
-                            handle_event_valid_sched)
          apply simp
-        apply (clarsimp simp: cur_sc_chargeable_def)
+         apply (rule corres_split[OF corres_machine_op])
+            apply (rule corres_underlying_trivial)
+            apply (rule no_fail_getActiveIRQ)
+           apply clarsimp
+           apply (rule_tac x=irq in option_corres)
+            apply (rule_tac P=\<top> and P'=\<top> in corres_inst)
+            apply (simp add: when_def)
+           apply (rule corres_when[simplified dc_def], simp)
+           apply simp
+           apply (rule handleInterrupt_corres[simplified dc_def])
+          apply simp
+          apply (wpsimp wp: hoare_drop_imps hoare_vcg_all_lift simp: schact_is_rct_def)[1]
+         apply simp
+         apply (rule_tac Q'="\<lambda>irq s. invs' s \<and>
+                              (\<forall>irq'. irq = Some irq' \<longrightarrow>
+                                 intStateIRQTable (ksInterruptState s ) irq' \<noteq>
+                                 IRQInactive)"
+                      in hoare_post_imp)
+          apply simp
+         apply (wp doMachineOp_getActiveIRQ_IRQ_active handle_event_valid_sched | simp)+
        apply (rule_tac Q'="\<lambda>_. \<top>" and E'="\<lambda>_. invs'" in hoare_strengthen_postE)
          apply wpsimp+
-      apply (rule_tac P="invs and valid_sched and current_time_bounded
-                         and ct_ready_if_schedulable and scheduler_act_sane
-                         and (\<lambda>s. schact_is_rct s \<longrightarrow> cur_sc_active s)
-                         and (\<lambda>s. schact_is_rct s \<longrightarrow> ct_in_state activatable s)
-                         and (\<lambda>s. schact_is_rct s \<longrightarrow> ct_not_in_release_q s)
-                         and cur_sc_more_than_ready and consumed_time_bounded
-                         and cur_sc_in_release_q_imp_zero_consumed"
-                  and P'=invs' in corres_inst)
-      apply (rule corres_stateAssert_add_assertion)
-       apply (simp add: rct_imp_activatable'_asrt_def)
-       apply (rule corres_guard_imp)
-         apply (rule corres_split[OF schedule_corres])
-           apply (rule_tac P="invs and valid_sched and current_time_bounded
-                              and cur_sc_active and schact_is_rct
-                              and ct_in_state activatable
-                              and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s \<and>
-                                       cur_sc_offset_sufficient (consumed_time s) s)"
-                       and P'="invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)"
-                  in corres_inst)
-           apply (rule corres_stateAssert_add_assertion)
-            apply (rule corres_guard_imp)
-              apply (rule activateThread_corres)
-             apply simp
-            apply simp
-           apply (clarsimp simp: ct_in_state_def ct_in_state'_def)
-           apply (drule (3) st_tcb_at_coerce_concrete[OF _ _ invs_psp_aligned invs_distinct])
-           apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs state_relation_def)
-           apply (rename_tac st; case_tac st; clarsimp)
-          apply (wpsimp wp: schedule_valid_sched
-                            schedule_cur_sc_active schedule_ct_activateable
-                            schedule_cur_sc_offset_ready_and_sufficient)
-         apply (wpsimp wp: schedule_invs' schedule_sch)
-        apply clarsimp
-       apply clarsimp
-      apply (clarsimp simp: rct_imp_activatable'_asrt_def)
-      apply (clarsimp simp: ct_in_state_def ct_in_state'_def)
-      apply (prop_tac "schact_is_rct s")
-       apply (clarsimp simp: state_relation_def schact_is_rct_def sched_act_relation_def)
-       apply (case_tac "scheduler_action s"; clarsimp)
-      apply (drule schact_is_rct, clarsimp)
-      apply (frule (3) st_tcb_at_coerce_concrete[OF _ _ invs_psp_aligned invs_distinct])
-      apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs state_relation_def)
-      apply (rename_tac st; case_tac st; clarsimp)
-     apply wpsimp
-      apply (wpsimp wp: preemption_path_valid_sched
-                        preemption_path_current_time_bounded
-                        preemption_point_scheduler_act_sane
-                        preemption_path_schact_is_rct_imp_ct_not_in_release_q
-                        preemption_path_cur_sc_more_than_ready
-                        preemption_path_consumed_time_bounded
-                        preemption_path_cur_sc_in_release_q_imp_zero_consumed
-                        preemption_path_ct_ready_if_schedulable)
-     apply ((wpsimp wp: he_invs handle_event_valid_sched handle_event_scheduler_act_sane
-                        handle_event_cur_sc_chargeable handle_event_schact_is_rct_imp_cur_sc_active
-                        handle_event_schact_is_rct_imp_ct_activatable
-                        handle_event_schact_is_rct_imp_ct_not_in_release_q
-                        handle_event_cur_sc_in_release_q_imp_zero_consumed
-             | strengthen ct_not_blocked_imp_ct_not_blocked_on_receive
-                          ct_not_blocked_imp_ct_not_blocked_on_ntfn)+)[1]
-    apply (wpsimp wp: he_invs')
-      apply (wpsimp simp: mcsPreemptionPoint_def wp: isSchedulable_wp)
-     apply (wpsimp wp: dmo_getirq_inv)
-     apply (clarsimp simp: isSchedulable_bool_def isScActive_def)
-    apply (rule_tac Q'="\<lambda>_. invs'" and E'="\<lambda>_. invs'" in hoare_strengthen_postE)
-      apply (wpsimp wp: he_invs')
-     apply simp
-    apply clarsimp
-   apply (clarsimp  cong: conj_cong)
-   apply (intro conjI, clarsimp simp: active_from_running)
-        apply (rule valid_sched_ct_not_queued; clarsimp?)
-       apply (erule (2) cur_sc_active_ct_not_in_release_q_imp_ct_running_imp_ct_schedulable, clarsimp)
-      apply (clarsimp simp: ct_in_state_def pred_tcb_at_def obj_at_def cur_tcb_def is_tcb
-                     dest!: invs_cur)
-     apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
-                           invs_strengthen_cur_sc_tcb_are_bound)
-    apply (fastforce simp: ct_in_state_def pred_tcb_at_def obj_at_def cur_tcb_def is_tcb
-                    dest!: invs_cur)
-   apply (clarsimp, rule schact_is_rct_ct_released; simp?)
-   apply (frule (1) cur_sc_not_idle_sc_ptr')
-    apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
-                          invs_strengthen_cur_sc_tcb_are_bound)
-   apply simp
+       apply (simp add: invs'_def valid_state'_def)
+      apply (rule corres_split[OF schedule_corres])
+        apply (rule activateThread_corres)
+       apply (wp handle_interrupt_valid_sched[unfolded non_kernel_IRQs_def, simplified]
+                 schedule_invs' hoare_vcg_if_lift2 hoare_drop_imps |simp)+
+     apply (rule_tac Q'="\<lambda>_. valid_sched and invs and valid_list" and
+                     E'="\<lambda>_. valid_sched and invs and valid_list"
+            in hoare_strengthen_postE)
+       apply (wp handle_event_valid_sched hoare_vcg_imp_lift' |simp)+
+   apply (clarsimp simp: active_from_running schact_is_rct_def)
   apply (clarsimp simp: active_from_running')
   done
 
 lemma kernel_corres:
-  "corres dc (einvs and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running s) and (ct_running or ct_idle)
-              and current_time_bounded and consumed_time_bounded and valid_machine_time
-              and ct_not_in_release_q and cur_sc_active
-              and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-              and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s)
-              and (\<lambda>s. scheduler_action s = resume_cur_thread)
-              and valid_domain_list)
+  "corres dc (einvs and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running s) and (ct_running or ct_idle) and
+              (\<lambda>s. scheduler_action s = resume_cur_thread) and
+              (\<lambda>s. 0 < domain_time s \<and> valid_domain_list s))
              (invs' and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running' s) and (ct_running' or ct_idle') and
               (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
               (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
@@ -979,7 +604,7 @@ lemma kernel_corres:
     apply (rule corres_add_noop_lhs2)
     apply (simp only: bind_assoc[symmetric])
     apply (rule corres_split[where r'=dc and
-                                   R="\<lambda>_ s. valid_domain_list s" and
+                                   R="\<lambda>_ s. 0 < domain_time s \<and> valid_domain_list s" and
                                    R'="\<lambda>_. \<top>"])
        apply (simp only: bind_assoc)
        apply (rule kernel_corres')
@@ -987,7 +612,7 @@ lemma kernel_corres:
        apply simp
       apply (simp add: kernelExitAssertions_def state_relation_def)
      apply (wp call_kernel_domain_time_inv_det_ext call_kernel_domain_list_inv_det_ext)
-    apply wpsimp
+    apply wp
    apply clarsimp
   apply clarsimp
   done
@@ -1004,51 +629,43 @@ lemma device_mem_corres:
                          invs_def invs'_def
                          corres_underlying_def device_mem_relation)
 
-crunch thread_set
- for domain_time_inv[wp]: "\<lambda>s. P (domain_time s)"
-
 lemma entry_corres:
-  "corres (=)
-      (\<lambda>s. mcs_invs s \<and> (ct_running s \<or> ct_idle s) \<and> (event \<noteq> Interrupt \<longrightarrow> ct_running s))
-      (invs' and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running' s) and (ct_running' or ct_idle')
-       and valid_domain_list'
-       and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-       and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
-      (kernel_entry event tc) (kernelEntry event tc)"
+  "corres (=) (einvs and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running s) and
+                  (\<lambda>s. 0 < domain_time s) and valid_domain_list and (ct_running or ct_idle) and
+                  (\<lambda>s. scheduler_action s = resume_cur_thread))
+                 (invs' and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running' s) and
+                  (\<lambda>s. 0 < ksDomainTime s) and valid_domain_list' and (ct_running' or ct_idle') and
+                  (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
+                  (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
+          (kernel_entry event tc) (kernelEntry event tc)"
   apply (simp add: kernel_entry_def kernelEntry_def)
-  apply add_cur_tcb'
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
       apply (rule corres_split)
          apply simp
-         apply (rule threadset_corresT)
-           apply (simp add: tcb_relation_def arch_tcb_relation_def
-                            arch_tcb_context_set_def atcbContextSet_def)
-          apply (clarsimp simp: tcb_cap_cases_def)
-         apply (clarsimp simp: tcb_cte_cases_def)
-        apply (rule corres_split [OF kernel_corres])
-          apply (rule_tac P=invs and P'=\<top> in corres_inst)
-          apply add_cur_tcb'
-          apply (rule corres_guard_imp)
-            apply (rule corres_split_eqr[OF getCurThread_corres])
-              apply (rule threadGet_corres)
-              apply (simp add: tcb_relation_def arch_tcb_relation_def
-                               arch_tcb_context_get_def atcbContextGet_def)
-             apply wp+
-           apply clarsimp
-          apply (clarsimp simp: cur_tcb'_def)
-         apply (rule hoare_strengthen_post, rule akernel_invs_det_ext, simp add: invs_def cur_tcb_def)
-        apply wpsimp
-       apply (wp thread_set_invs_trivial
+         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)
+          apply (clarsimp simp: tcb_cte_cases_def)
+         apply (simp add: exst_same_def)
+        apply (rule corres_split[OF kernel_corres])
+          apply (rule corres_split_eqr[OF getCurThread_corres])
+            apply (rule threadGet_corres)
+            apply (simp add: tcb_relation_def arch_tcb_relation_def
+                             arch_tcb_context_get_def atcbContextGet_def)
+           apply wp+
+         apply (rule hoare_strengthen_post, rule akernel_invs_det_ext, fastforce simp: invs_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
                  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
               | simp add: tcb_cap_cases_def ct_in_state'_def thread_set_no_change_tcb_state
                           schact_is_rct_def
               | (wps, wp threadSet_st_tcb_at2) )+
-   apply (clarsimp simp: invs_def cur_tcb_def)
-  apply (clarsimp simp: ct_in_state'_def cur_tcb'_def invs'_def valid_release_queue'_def
-                        projectKOs obj_at'_def)
+   apply (fastforce simp: invs_def cur_tcb_def)
+  apply (clarsimp simp: ct_in_state'_def)
   done
 
 lemma corres_gets_machine_state:
@@ -1058,7 +675,8 @@ lemma corres_gets_machine_state:
 
 lemma do_user_op_corres:
   "corres (=) (einvs and ct_running)
-              invs'
+                 (invs' and (%s. ksSchedulerAction s = ResumeCurrentThread) and
+                  ct_running')
           (do_user_op f tc) (doUserOp f tc)"
   apply (simp add: do_user_op_def doUserOp_def split_def)
   apply (rule corres_guard_imp)
@@ -1111,22 +729,25 @@ lemma ct_idle_related:
   done
 
 definition
-  "full_invs'
-     \<equiv> {((tc,s),m,e). invs' s \<and> vs_valid_duplicates' (ksPSpace s)
-                      \<and> ex_abs (\<lambda>s :: det_state. mcs_invs s
-                                                  \<and> (ct_running s \<or> ct_idle s)
-                                                  \<and> (e \<noteq> None \<and> e \<noteq> Some Interrupt \<longrightarrow> ct_running s)) s
-                      \<and> (m = KernelMode \<longrightarrow> e \<noteq> None)
-                      \<and> (m = UserMode \<longrightarrow> ct_running' s)
-                      \<and> (m = IdleMode \<longrightarrow> ct_idle' s)}"
+  "full_invs' \<equiv> {((tc,s),m,e). invs' s \<and> vs_valid_duplicates' (ksPSpace s) \<and>
+                          ex_abs (einvs::det_ext state \<Rightarrow> bool) s \<and>
+                          ksSchedulerAction s = ResumeCurrentThread \<and>
+                          (ct_running' s \<or> ct_idle' s) \<and>
+                          (m = KernelMode \<longrightarrow> e \<noteq> None) \<and>
+                          (m = UserMode \<longrightarrow> ct_running' s) \<and>
+                          (m = IdleMode \<longrightarrow> ct_idle' s) \<and>
+                          (e \<noteq> None \<and> e \<noteq> Some Interrupt \<longrightarrow> ct_running' s) \<and>
+                          0 < ksDomainTime s \<and> valid_domain_list' s}"
 
 lemma checkActiveIRQ_valid_duplicates':
-  "checkActiveIRQ \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+  "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
+   checkActiveIRQ
+   \<lbrace>\<lambda>_ s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   apply (simp add: checkActiveIRQ_def)
   apply wp
   done
 
-lemma checkActiveIRQ_corres':
+lemma check_active_irq_corres':
   "corres (=) \<top> \<top> (check_active_irq) (checkActiveIRQ)"
   apply (simp add: check_active_irq_def checkActiveIRQ_def)
   apply (rule corres_guard_imp)
@@ -1136,43 +757,48 @@ lemma checkActiveIRQ_corres':
      apply (wp | simp )+
   done
 
-lemma checkActiveIRQ_corres:
+lemma check_active_irq_corres:
   "corres (=)
     (invs and (ct_running or ct_idle) and einvs and (\<lambda>s. scheduler_action s = resume_cur_thread)
-     and valid_domain_list)
-    (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
+     and (\<lambda>s. 0 < domain_time s) and valid_domain_list)
+    (invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
+      and (\<lambda>s. 0 < ksDomainTime s) and valid_domain_list' and (ct_running' or ct_idle')
+      and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
     (check_active_irq) (checkActiveIRQ)"
   apply (rule corres_guard_imp)
-    apply (rule checkActiveIRQ_corres', auto)
+    apply (rule check_active_irq_corres', auto)
   done
 
 lemma checkActiveIRQ_just_running_corres:
   "corres (=)
     (invs and ct_running and einvs and (\<lambda>s. scheduler_action s = resume_cur_thread)
-      and valid_domain_list)
-    (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
+      and (\<lambda>s. 0 < domain_time s) and valid_domain_list)
+    (invs' and ct_running' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
+      and (\<lambda>s. 0 < ksDomainTime s) and valid_domain_list'
+      and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
     (check_active_irq) (checkActiveIRQ)"
   apply (rule corres_guard_imp)
-    apply (rule checkActiveIRQ_corres', auto)
+    apply (rule check_active_irq_corres', auto)
   done
 
 lemma checkActiveIRQ_just_idle_corres:
   "corres (=)
     (invs and ct_idle and einvs and (\<lambda>s. scheduler_action s = resume_cur_thread)
-      and valid_domain_list)
+      and (\<lambda>s. 0 < domain_time s)  and valid_domain_list)
     (invs' and ct_idle' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
-      and valid_domain_list'
+      and (\<lambda>s. 0 < ksDomainTime s) and valid_domain_list'
       and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
     (check_active_irq) (checkActiveIRQ)"
   apply (rule corres_guard_imp)
-    apply (rule checkActiveIRQ_corres', auto)
+    apply (rule check_active_irq_corres', auto)
   done
 
 lemma checkActiveIRQ_invs':
   "\<lbrace>invs' and ex_abs invs and (ct_running' or ct_idle')
     and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
    checkActiveIRQ
-   \<lbrace>\<lambda>_. invs' and (ct_running' or ct_idle') and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>"
+   \<lbrace>\<lambda>_. invs' and (ct_running' or ct_idle')
+    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>"
   apply (simp add: checkActiveIRQ_def ex_abs_def)
   apply (wp dmo_invs' | simp)+
   done
@@ -1181,7 +807,8 @@ lemma checkActiveIRQ_invs'_just_running:
   "\<lbrace>invs' and ex_abs invs and ct_running'
     and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
    checkActiveIRQ
-   \<lbrace>\<lambda>_. invs' and ct_running' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>"
+   \<lbrace>\<lambda>_. invs' and ct_running'
+    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>"
   apply (simp add: checkActiveIRQ_def)
   apply (wp | simp)+
   done
@@ -1190,7 +817,8 @@ lemma checkActiveIRQ_invs'_just_idle:
   "\<lbrace>invs' and ex_abs invs and ct_idle'
     and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
    checkActiveIRQ
-   \<lbrace>\<lambda>_. invs' and ct_idle' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>"
+   \<lbrace>\<lambda>_. invs' and ct_idle'
+    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>"
   apply (simp add: checkActiveIRQ_def)
   apply (wp | simp)+
   done
@@ -1200,11 +828,6 @@ lemma sched_act_rct_related:
      \<Longrightarrow> scheduler_action a = resume_cur_thread"
   by (case_tac "scheduler_action a", simp_all add: state_relation_def)
 
-lemma resume_cur_thread_cross:
-  "\<lbrakk> (a, c) \<in> state_relation; scheduler_action a = resume_cur_thread\<rbrakk>
-     \<Longrightarrow> ksSchedulerAction c = ResumeCurrentThread"
-  by (case_tac "scheduler_action a", simp_all add: state_relation_def)
-
 lemma domain_time_rel_eq:
   "(a, c) \<in> state_relation \<Longrightarrow> P (ksDomainTime c) = P (domain_time a)"
   by (clarsimp simp: state_relation_def)
@@ -1213,28 +836,6 @@ lemma domain_list_rel_eq:
   "(a, c) \<in> state_relation \<Longrightarrow> P (ksDomSchedule c) = P (domain_list a)"
   by (clarsimp simp: state_relation_def)
 
-lemma ct_running_cross:
-  "\<lbrakk>(a,c) \<in> state_relation; ct_running a; pspace_aligned a; pspace_distinct a\<rbrakk> \<Longrightarrow> ct_running' c"
-  apply (clarsimp simp: ct_in_state_def ct_in_state'_def)
-  apply (frule st_tcb_at_coerce_concrete)
-     apply fastforce+
-  apply (clarsimp simp: obj_at_simps state_relation_def)
-  done
-
-lemma ct_idle_cross:
-  "\<lbrakk>(a,c) \<in> state_relation; ct_idle a; pspace_aligned a; pspace_distinct a\<rbrakk> \<Longrightarrow> ct_idle' c"
-  apply (clarsimp simp: ct_in_state_def ct_in_state'_def)
-  apply (frule st_tcb_at_coerce_concrete)
-     apply fastforce+
-  apply (clarsimp simp: obj_at_simps state_relation_def)
-  done
-
-lemma ct_running_or_idle_cross:
-  "\<lbrakk>(a,c) \<in> state_relation; ct_running a \<or> ct_idle a; pspace_aligned a; pspace_distinct a\<rbrakk>
-   \<Longrightarrow> ct_running' c \<or> ct_idle' c"
-  apply (fastforce dest: ct_running_cross ct_idle_cross)
-  done
-
 lemma ckernel_invariant:
   "ADT_H uop \<Turnstile> full_invs'"
   unfolding full_invs'_def
@@ -1251,65 +852,28 @@ lemma ckernel_invariant:
     apply (frule akernel_init_invs[THEN bspec])
     apply (rule_tac x = s in exI)
     apply (clarsimp simp: Init_A_def)
-
-    apply (clarsimp simp: Init_A_def init_A_st_def)
-
    apply (insert ckernel_init_invs)[1]
    apply clarsimp
    apply (frule ckernel_init_sch_norm)
    apply (frule ckernel_init_ctr)
    apply (frule ckernel_init_domain_time)
    apply (frule ckernel_init_domain_list)
-   apply (clarsimp simp: ex_abs_def)
    apply (fastforce simp: Init_H_def valid_domain_list'_def)
-
   apply (clarsimp simp: ADT_A_def ADT_H_def global_automaton_def)
 
   apply (erule_tac P="a \<and> (\<exists>x. b x)" for a b in disjE)
-   apply (clarsimp simp: ex_abs_def kernel_call_H_def)
-   apply (rename_tac uc' conc_state' uc conc_state abs_state event)
-   apply (drule use_valid[OF _ valid_corres_combined])
-       apply (rule kernel_entry_invs)
-      apply (rule corres_guard_imp)
-        apply (rule entry_corres)
-       apply force
-      apply force
-     apply (rule hoare_weaken_pre)
-      apply (rule kernelEntry_invs')
-     apply clarsimp
-     apply (rename_tac s' s; intro conjI)
-        apply (prop_tac "cur_sc s = ksCurSc s'", fastforce dest!: state_relationD)
-        apply (prop_tac "sc_at (cur_sc s) s")
-         apply (rule cur_sc_tcb_sc_at_cur_sc[OF invs_valid_objs invs_cur_sc_tcb]; simp)
-        apply (prop_tac "sc_at' (ksCurSc s') s'")
-         apply (rule sc_at_cross[OF state_relation_pspace_relation invs_psp_aligned invs_distinct]; simp)
-        apply (prop_tac "is_active_sc' (ksCurSc s') s'")
-         apply (rule is_active_sc'2_cross[OF _ invs_psp_aligned invs_distinct], simp+)
-
-       apply (clarsimp simp: invs'_def valid_pspace'_def, rule sym_refs_tcbSCs; simp?)
-       apply (clarsimp simp: invs_def valid_state_def valid_pspace_def state_refs_of_cross_eq)
-      apply (fastforce dest!: cur_sc_tcb_cross[simplified schact_is_rct_def]
-                        simp: invs_def valid_state_def valid_pspace_def)
-     apply (clarsimp simp: invs'_def valid_release_queue'_def)
-     apply (prop_tac "cur_tcb' s'")
-      apply (rule cur_tcb_cross[OF invs_cur invs_psp_aligned invs_distinct]; simp?)
-     apply (clarsimp simp: cur_tcb'_def)
-     apply (clarsimp simp: pred_map_def obj_at'_def projectKOs opt_map_red not_in_release_q_def
-                           release_queue_relation_def
-                    dest!: state_relationD)
 
-    apply clarsimp
-    apply (rule_tac x=abs_state in exI)
-    apply (intro conjI; (clarsimp; fail)?)
-      subgoal by (fastforce intro: ct_running_cross)
-     apply (rule ct_running_or_idle_cross; simp?; fastforce)
-    subgoal by (fastforce intro!: resume_cur_thread_cross)
+  apply (clarsimp simp: kernel_call_H_def)
 
-   apply clarsimp
-   apply (intro conjI impI)
-     apply metis
-    apply metis
-   apply (fastforce dest!: ct_running_or_idle_cross)
+   apply (drule use_valid[OF _ valid_corres_combined
+                            [OF kernel_entry_invs entry_corres],
+                            OF _ kernelEntry_invs'[THEN hoare_weaken_pre]])
+     subgoal by fastforce
+    apply (fastforce simp: ex_abs_def sch_act_simple_def ct_running_related ct_idle_related
+                           sched_act_rct_related)
+   apply (clarsimp simp: kernel_call_H_def)
+   subgoal by (fastforce simp: ex_abs_def sch_act_simple_def ct_running_related ct_idle_related
+                              sched_act_rct_related)
 
   apply (erule_tac P="a \<and> b" for a b in disjE)
    apply (clarsimp simp add: do_user_op_H_def monad_to_transition_def)
@@ -1319,13 +883,11 @@ lemma ckernel_invariant:
      apply (rule valid_corres_combined[OF do_user_op_invs2 corres_guard_imp2[OF do_user_op_corres]])
       apply clarsimp
      apply (rule doUserOp_invs'[THEN hoare_weaken_pre])
-     apply (clarsimp simp: ex_abs_def)
-     apply (rule conjI)
-      apply metis
-     apply (fastforce intro: resume_cur_thread_cross ct_running_cross)
+     apply (fastforce simp: ex_abs_def)
     apply (clarsimp simp: ex_abs_def, rule_tac x=s in exI,
-           clarsimp simp: ct_running_related sched_act_rct_related)
-   apply (fastforce simp: ex_abs_def)
+            clarsimp simp: ct_running_related sched_act_rct_related)
+   apply (clarsimp simp: ex_abs_def)
+   apply (fastforce simp: ex_abs_def ct_running_related sched_act_rct_related)
 
   apply (erule_tac P="a \<and> b \<and> c \<and> (\<exists>x. d x)" for a b c d in disjE)
    apply (clarsimp simp add: do_user_op_H_def monad_to_transition_def)
@@ -1335,10 +897,7 @@ lemma ckernel_invariant:
      apply (rule valid_corres_combined[OF do_user_op_invs2 corres_guard_imp2[OF do_user_op_corres]])
       apply clarsimp
      apply (rule doUserOp_invs'[THEN hoare_weaken_pre])
-     apply (clarsimp simp: ex_abs_def)
-     apply (rule conjI)
-      apply metis
-     apply (fastforce intro: resume_cur_thread_cross ct_running_cross)
+     apply (fastforce simp: ex_abs_def)
     apply (fastforce simp: ex_abs_def ct_running_related sched_act_rct_related)
    apply (fastforce simp: ex_abs_def)
 
@@ -1347,13 +906,9 @@ lemma ckernel_invariant:
    apply (drule use_valid)
      apply (rule hoare_vcg_conj_lift)
       apply (rule checkActiveIRQ_valid_duplicates')
-     apply (rule valid_corres_combined[OF check_active_irq_invs_just_running corres_guard_imp2[OF checkActiveIRQ_just_running_corres]])
-      apply clarsimp
+     apply (rule valid_corres_combined[OF check_active_irq_invs_just_running checkActiveIRQ_just_running_corres])
      apply (rule checkActiveIRQ_invs'_just_running[THEN hoare_weaken_pre])
-     apply (clarsimp simp: ex_abs_def)
-     apply (rule conjI)
-      apply blast
-     apply (fastforce intro: resume_cur_thread_cross ct_running_cross)
+     apply (fastforce simp: ex_abs_def)
     apply (fastforce simp: ex_abs_def ct_running_related sched_act_rct_related)
    apply (fastforce simp: ex_abs_def)
 
@@ -1362,32 +917,22 @@ lemma ckernel_invariant:
    apply (drule use_valid)
      apply (rule hoare_vcg_conj_lift)
       apply (rule checkActiveIRQ_valid_duplicates')
-     apply (rule valid_corres_combined[OF check_active_irq_invs_just_idle corres_guard_imp2[OF checkActiveIRQ_just_idle_corres]])
-      apply clarsimp
+     apply (rule valid_corres_combined[OF check_active_irq_invs_just_idle checkActiveIRQ_just_idle_corres])
      apply (rule checkActiveIRQ_invs'_just_idle[THEN hoare_weaken_pre])
+     apply clarsimp
      apply (fastforce simp: ex_abs_def)
-    apply (clarsimp simp: ex_abs_def)
-    apply (rule_tac x=s in exI)
-    apply clarsimp
-    apply (intro conjI)
-     apply (fastforce intro: ct_idle_related)
-    apply (fastforce intro: resume_cur_thread_cross)
+    apply (fastforce simp: ex_abs_def ct_idle_related sched_act_rct_related)
    apply (fastforce simp: ex_abs_def)
 
   apply (clarsimp simp: check_active_irq_H_def)
    apply (drule use_valid)
-    apply (rule hoare_vcg_conj_lift)
+     apply (rule hoare_vcg_conj_lift)
      apply (rule checkActiveIRQ_valid_duplicates')
-    apply (rule valid_corres_combined[OF check_active_irq_invs_just_idle corres_guard_imp2[OF checkActiveIRQ_just_idle_corres]])
-     apply clarsimp
-    apply (rule checkActiveIRQ_invs'_just_idle[THEN hoare_weaken_pre])
-    apply (fastforce simp: ex_abs_def)
-   apply (clarsimp simp: ex_abs_def)
-   apply (rule_tac x=s in exI)
-   apply clarsimp
-   apply (intro conjI)
-    apply (fastforce intro: ct_idle_related)
-   apply (fastforce intro: resume_cur_thread_cross)
+    apply (rule valid_corres_combined[OF check_active_irq_invs check_active_irq_corres])
+    apply (rule checkActiveIRQ_invs'[THEN hoare_weaken_pre])
+    apply clarsimp
+     apply (fastforce simp: ex_abs_def)
+   apply (fastforce simp: ex_abs_def ct_running_related ct_idle_related sched_act_rct_related)
   apply (fastforce simp: ex_abs_def)
   done
 
@@ -1408,28 +953,26 @@ lemma fw_sim_A_H:
 
    apply (erule_tac P="a \<and> (\<exists>x. b x)" for a b in disjE)
     apply (clarsimp simp add: kernel_call_H_def kernel_call_A_def)
-    apply (rename_tac abs_state uc' conc_state' conc_state event)
-    apply (rule rev_mp, rule_tac tc=tc and event=event in entry_corres)
+    apply (rule rev_mp, rule_tac tc=tc and event=x in entry_corres)
     apply (clarsimp simp: corres_underlying_def)
-    apply (drule_tac x="(abs_state, conc_state)" in bspec, blast)
+    apply (drule (1) bspec)
+    apply (clarsimp simp: sch_act_simple_def)
+    apply (drule (1) bspec)
     apply clarsimp
-    apply (frule (1) ct_running_or_idle_cross; clarsimp)
-    apply (prop_tac "event \<noteq> Interrupt \<longrightarrow> ct_running' conc_state", fastforce dest!: ct_running_cross)
-    apply (prop_tac "valid_domain_list' conc_state \<and> ksSchedulerAction conc_state = ResumeCurrentThread")
-     apply (clarsimp simp: state_relation_def)
-    apply clarsimp
-    apply (drule_tac x="(uc', conc_state')" in bspec, blast)
-    apply clarsimp
-    apply (frule use_valid[OF _ kernel_entry_invs])
-     apply force
-    apply (rename_tac abs_state')
-    apply (intro conjI impI allI; simp)
-     apply (rule_tac x=abs_state' in exI)
-     apply (prop_tac "ct_running abs_state'", rule ct_running_related; simp)
+    apply (rule conjI)
+     apply clarsimp
+     apply (rule_tac x=b in exI)
+     apply (rule conjI)
+      apply (rule impI, simp)
+     apply (frule (2) ct_running_related)
     apply clarsimp
-    apply (rule_tac x=abs_state' in exI)
+    apply (rule_tac x=b in exI)
+    apply (drule use_valid, rule kernelEntry_invs')
+     apply (simp add: sch_act_simple_def)
     apply clarsimp
-    apply (drule_tac a=abs_state' in ct_running_cross; clarsimp)
+    apply (frule (1) ct_idle_related)
+    apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def)
+
    apply (erule_tac P="a \<and> b" for a b in disjE)
     apply (clarsimp simp: do_user_op_H_def do_user_op_A_def monad_to_transition_def)
     apply (rule rev_mp, rule_tac tc1=tc and f1=uop and P="ct_running and einvs" in corres_guard_imp2[OF do_user_op_corres])
@@ -1450,20 +993,20 @@ lemma fw_sim_A_H:
 
    apply (erule_tac P="a \<and> b" for a b in disjE)
     apply (clarsimp simp: check_active_irq_H_def check_active_irq_A_def)
-    apply (rule rev_mp, rule checkActiveIRQ_corres')
+    apply (rule rev_mp, rule check_active_irq_corres)
     apply (clarsimp simp: corres_underlying_def)
     apply fastforce
 
    apply (erule_tac P="a \<and> b" for a b in disjE)
     apply (clarsimp simp: check_active_irq_H_def check_active_irq_A_def)
-    apply (rule rev_mp, rule checkActiveIRQ_corres')
+    apply (rule rev_mp, rule check_active_irq_corres)
     apply (clarsimp simp: corres_underlying_def)
     apply fastforce
 
    apply (clarsimp simp: check_active_irq_H_def check_active_irq_A_def)
-   apply (rule rev_mp, rule checkActiveIRQ_corres')
+   apply (rule rev_mp, rule check_active_irq_corres)
    apply (clarsimp simp: corres_underlying_def)
-   apply fastforce
+    apply fastforce
 
   apply (clarsimp simp: absKState_correct dest!: lift_state_relationD)
   done
diff --git a/proof/refine/ARM/Reply_R.thy b/proof/refine/ARM/Reply_R.thy
deleted file mode 100644
index d28d035942..0000000000
--- a/proof/refine/ARM/Reply_R.thy
+++ /dev/null
@@ -1,1829 +0,0 @@
-(*
- * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
- *
- * SPDX-License-Identifier: GPL-2.0-only
- *)
-
-theory Reply_R
-imports Schedule_R
-begin
-
-defs replyUnlink_assertion_def:
-  "replyUnlink_assertion
-    \<equiv> \<lambda>replyPtr state s. state = BlockedOnReply (Some replyPtr)
-                          \<or> (\<exists>ep d. state = BlockedOnReceive ep d (Some replyPtr))"
-
-lemma valid_reply'_updates[simp]:
-  "\<And>f. valid_reply' reply (ksReprogramTimer_update f s) = valid_reply' reply s"
-  "\<And>f. valid_reply' reply (ksReleaseQueue_update f s) = valid_reply' reply s"
-  by (auto simp: valid_reply'_def valid_bound_obj'_def split: option.splits)
-
-crunch updateReply
-  for pred_tcb_at'[wp]: "\<lambda>s. P (pred_tcb_at' proj test t s)"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
-  and ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  and valid_queues[wp]: "valid_queues"
-  and sc_obj_at'[wp]: "\<lambda>s. Q (obj_at' (P :: sched_context \<Rightarrow> bool) scp s)"
-
-global_interpretation updateReply: typ_at_all_props' "updateReply p f"
-  by typ_at_props'
-
-lemma updateReply_replyNext_reply_projs[wp]:
-  "\<lbrace>\<lambda>s. P ((replyNexts_of s)(rptr := getReplyNextPtr next)) (replyPrevs_of s)
-          (replyTCBs_of s) ((replySCs_of s)(rptr := getHeadScPtr next))\<rbrace>
-   updateReply rptr (replyNext_update (\<lambda>_. next))
-   \<lbrace>\<lambda>_ s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)\<rbrace>"
-  unfolding updateReply_def
-  apply wpsimp
-  apply (erule rsubst4[where P=P])
-     apply (clarsimp simp: ext opt_map_def obj_at'_def projectKO_eq)+
-  done
-
-lemma updateReply_replyPrev_reply_projs[wp]:
-  "\<lbrace>\<lambda>s. P (replyNexts_of s) ((replyPrevs_of s)(rptr := prev))
-          (replyTCBs_of s) (replySCs_of s)\<rbrace>
-   updateReply rptr (replyPrev_update (\<lambda>_. prev))
-   \<lbrace>\<lambda>_ s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)\<rbrace>"
-  unfolding updateReply_def
-  apply wpsimp
-  apply (erule rsubst4[where P=P])
-     apply (clarsimp simp: ext opt_map_def obj_at'_def projectKO_eq)+
-  done
-
-lemma updateReply_replyTCB_reply_projs[wp]:
-  "\<lbrace>\<lambda>s. P (replyNexts_of s) (replyPrevs_of s)
-          ((replyTCBs_of s)(rptr := tptrOpt)) (replySCs_of s)\<rbrace>
-   updateReply rptr (replyTCB_update (\<lambda>_. tptrOpt))
-   \<lbrace>\<lambda>_ s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)\<rbrace>"
-  unfolding updateReply_def
-  apply wpsimp
-  apply (erule rsubst4[where P=P])
-     apply (clarsimp simp: ext opt_map_def obj_at'_def projectKO_eq)+
-  done
-
-lemma updateReply_reply_projs:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko rptr s \<longrightarrow>
-       P (\<lambda>a. if a = rptr then replyNext_of (f ko) else replyNexts_of s a)
-         (\<lambda>a. if a = rptr then replyPrev (f ko) else replyPrevs_of s a)
-         (\<lambda>a. if a = rptr then replyTCB (f ko) else replyTCBs_of s a)
-         (\<lambda>a. if a = rptr then replySC (f ko) else replySCs_of s a)\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>_ s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)\<rbrace>"
-  unfolding updateReply_def
-  by wpsimp
-
-lemma updateReply_list_refs_of_replies'_inv:
-  "\<forall>ko. replyNext_of (f ko) = replyNext_of ko \<Longrightarrow>
-   \<forall>ko. replyPrev (f ko) = replyPrev ko \<Longrightarrow>
-   updateReply rptr f \<lbrace>\<lambda>s. P (list_refs_of_replies' s)\<rbrace>"
-  unfolding updateReply_def
-  apply wpsimp
-  apply (erule rsubst[where P=P])
-  apply (rule ext)
-  apply (clarsimp simp: list_refs_of_reply'_def obj_at'_def projectKO_eq
-                        list_refs_of_replies'_def opt_map_def
-                 split: option.splits)
-  done
-
-crunch cleanReply
-  for st_tcb_at'[wp]: "st_tcb_at' P t"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-  (rule: weak_sch_act_wf_lift)
-
-global_interpretation cleanReply: typ_at_all_props' "cleanReply p"
-  by typ_at_props'
-
-lemma replyUnlink_st_tcb_at':
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> (t' = t \<longrightarrow> P (P' Inactive)) \<and> (t' \<noteq> t \<longrightarrow> P (st_tcb_at' P' t' s))\<rbrace>
-    replyUnlink r t
-   \<lbrace>\<lambda>rv s. P (st_tcb_at' P' t' s)\<rbrace>"
-  unfolding replyUnlink_def
-  by (wpsimp wp: sts_st_tcb_at'_cases_strong gts_wp' hoare_vcg_imp_lift
-           cong: conj_cong split: if_split_asm)
-
-lemma replyUnlink_st_tcb_at'_sym_ref:
-  "\<lbrace>\<lambda>s. reply_at' rptr s \<longrightarrow>
-          obj_at' (\<lambda>reply. replyTCB reply = Some tptr) rptr s \<and> test Inactive\<rbrace>
-   replyUnlink rptr tptr
-   \<lbrace>\<lambda>_. st_tcb_at' test tptr\<rbrace>"
-  apply (wpsimp simp: replyUnlink_def
-                  wp: sts_st_tcb_at'_cases gts_wp')
-  apply (fastforce simp: obj_at'_def projectKOs)
-  done
-
-lemma replyRemoveTCB_st_tcb_at'_Inactive':
-  "\<lbrace>\<top>\<rbrace>
-   replyRemoveTCB tptr
-   \<lbrace>\<lambda>_. st_tcb_at' ((=) Inactive) tptr\<rbrace>"
-  unfolding replyRemoveTCB_def
-  apply (wpsimp wp: replyUnlink_st_tcb_at' hoare_vcg_if_lift split_del: if_split)
-  done
-
-lemma replyRemoveTCB_st_tcb_at'[wp]:
-  "P Inactive \<Longrightarrow> \<lbrace>\<top>\<rbrace> replyRemoveTCB t \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
-  apply (rule hoare_strengthen_post)
-  apply (rule replyRemoveTCB_st_tcb_at'_Inactive')
-  apply (clarsimp elim!: pred_tcb'_weakenE)
-  done
-
-lemma replyRemoveTCB_st_tcb_at'_cases:
-  "\<lbrace>\<lambda>s. (t = t' \<longrightarrow> Q (P Inactive)) \<and> (t \<noteq> t' \<longrightarrow> Q (st_tcb_at' P t s))\<rbrace>
-   replyRemoveTCB t'
-   \<lbrace>\<lambda>_ s. Q (st_tcb_at' P t s)\<rbrace>"
-  unfolding replyRemoveTCB_def cleanReply_def
-  by (wpsimp wp: replyUnlink_st_tcb_at' gts_wp' hoare_vcg_imp_lift')
-
-lemma replyPop_st_tcb_at'_Inactive:
-  "\<lbrace>\<top>\<rbrace> replyPop replyPtr tcbPtr \<lbrace>\<lambda>_. st_tcb_at' ((=) Inactive) tcbPtr\<rbrace>"
-  apply (clarsimp simp: replyPop_def)
-  by (wpsimp wp: replyUnlink_st_tcb_at' hoare_vcg_if_lift)
-
-lemma replyPop_st_tcb_at'[wp]:
-  "P Inactive \<Longrightarrow> \<lbrace>\<top>\<rbrace> replyPop r t \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
-  apply (rule hoare_strengthen_post)
-  apply (rule replyPop_st_tcb_at'_Inactive)
-  apply (clarsimp elim!: pred_tcb'_weakenE)
-  done
-
-lemma replyRemove_st_tcb_at'_Inactive:
-  "\<lbrace>\<top>\<rbrace> replyRemove replyPtr tcbPtr \<lbrace>\<lambda>_. st_tcb_at' ((=) Inactive) tcbPtr\<rbrace>"
-  apply (clarsimp simp: replyRemove_def)
-  by (wpsimp wp: replyUnlink_st_tcb_at' hoare_vcg_if_lift)
-
-lemma replyRemove_st_tcb_at'[wp]:
-  "P Inactive \<Longrightarrow> \<lbrace>\<top>\<rbrace> replyRemove r t \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
-  apply (rule hoare_strengthen_post)
-  apply (rule replyRemove_st_tcb_at'_Inactive)
-  apply (clarsimp elim!: pred_tcb'_weakenE)
-  done
-
-lemma replyUnlink_tcb_obj_at'_no_change:
-  "\<lbrace>(\<lambda>s. P (obj_at' Q tptr s)) and
-    K (\<forall>tcb st. (Q (tcbState_update (\<lambda>_. Inactive) tcb) = Q tcb) \<and>
-                (Q (tcbState_update (\<lambda>_. replyObject_update Map.empty st) tcb) = Q tcb) \<and>
-                (Q (tcbQueued_update (\<lambda>_. True) tcb) = Q tcb))\<rbrace>
-   replyUnlink rptr tptr'
-   \<lbrace>\<lambda>_ s. P (obj_at' Q tptr s)\<rbrace>"
-  unfolding replyUnlink_def scheduleTCB_def rescheduleRequired_def
-            updateReply_def
-  apply (rule hoare_gen_asm)
-  apply (wpsimp wp: setThreadState_tcb_obj_at'_no_change gts_wp')
-  done
-
-lemma replyRemoveTCB_st_tcb_at'_sym_ref:
-  "\<lbrace>(\<lambda>s. tcb_at' tptr s \<longrightarrow>
-          (\<forall>rptr. st_tcb_at' (\<lambda>st. replyObject st = Some rptr) tptr s \<and> reply_at' rptr s \<longrightarrow>
-                    obj_at' (\<lambda>reply. replyTCB reply = Some tptr) rptr s))
-      and (K (test Inactive))\<rbrace>
-   replyRemoveTCB tptr
-   \<lbrace>\<lambda>_. st_tcb_at' test tptr\<rbrace>"
-  unfolding replyRemoveTCB_def cleanReply_def updateReply_def
-  apply (rule hoare_gen_asm)
-  supply set_reply'.get_wp[wp del] set_reply'.get_wp_state_only[wp] set_reply'.get_wp_rv_only[wp]
-  apply (wpsimp wp: hoare_vcg_if_lift hoare_vcg_all_lift replyUnlink_st_tcb_at'_sym_ref
-                    set_reply'.set_no_update[where upd="\<lambda>r. (replyNext_update Map.empty
-                                                              (replyPrev_update Map.empty r))"]
-                    set_reply'.set_no_update[where upd="\<lambda>r. (replyNext_update Map.empty r)"]
-                    set_reply'.set_no_update[where upd="\<lambda>r. (replyPrev_update Map.empty r)"]
-                    hoare_vcg_imp_lift set_reply'.get_ko_at' haskell_assert_inv
-              simp: disj_imp)
-       apply (rule_tac Q'="\<lambda>_. obj_at' (\<lambda>r. replyTCB r = Some tptr) rptr" in hoare_post_imp,
-              clarsimp)
-       apply wp
-      apply (rule_tac Q'="\<lambda>_. obj_at' (\<lambda>r. replyTCB r = Some tptr) rptr" in hoare_post_imp,
-             clarsimp)
-      apply (wpsimp wp: gts_wp')+
-  apply (clarsimp simp: obj_at'_def pred_tcb_at'_def)
-  done
-
-crunch cleanReply, updateReply
-  for valid_idle'[wp]: valid_idle'
-  and ct_not_inQ[wp]: ct_not_inQ
-  and sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  and valid_inQ_queues[wp]: valid_inQ_queues
-  and sch_act_not[wp]: "sch_act_not t"
-  and aligned'[wp]: pspace_aligned'
-  and distinct'[wp]: pspace_distinct'
-  and bounded'[wp]: pspace_bounded'
-  and no_0_obj'[wp]: "no_0_obj'"
-  and cap_to': "ex_nonz_cap_to' t"
-  and valid_mdb'[wp]: "valid_mdb'"
-
-crunch replyUnlink
-  for list_refs_of_replies'[wp]: "\<lambda>s. P (list_refs_of_replies' s)"
-  and valid_queues[wp]: valid_queues
-  and ct_not_inQ[wp]: ct_not_inQ
-  and ex_nonz_cap_to'[wp]: "(\<lambda>s. ex_nonz_cap_to' t s)"
-  and valid_irq_handlers'[wp]: valid_irq_handlers'
-  and valid_irq_states'[wp]: valid_irq_states'
-  and irqs_masked'[wp]: irqs_masked'
-  and ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  and ksArchState[wp]: "\<lambda>s. P (ksArchState s)"
-  and gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
-  and sch_act_not[wp]: "sch_act_not t"
-  and aligned'[wp]: pspace_aligned'
-  and distinct'[wp]: pspace_distinct'
-  and bounded'[wp]: pspace_bounded'
-  and no_0_obj'[wp]: "no_0_obj'"
-  and valid_mdb'[wp]: "valid_mdb'"
-  (wp: crunch_wps updateReply_list_refs_of_replies'_inv simp: crunch_simps)
-
-lemma replyUnlink_reply_projs[wp]:
-  "\<lbrace>\<lambda>s. P (replyNexts_of s) (replyPrevs_of s)
-          ((replyTCBs_of s)(rptr := None)) (replySCs_of s)\<rbrace>
-   replyUnlink rptr tptr
-   \<lbrace>\<lambda>_ s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)\<rbrace>"
-  unfolding replyUnlink_def
-  apply (wpsimp wp: gts_wp')
-  apply (erule rsubst4[where P=P])
-     apply (clarsimp simp: ext)+
-  done
-
-lemma setReply_valid_pde_mappings'[wp]:
-  "setReply p r \<lbrace>valid_pde_mappings'\<rbrace>"
-  unfolding valid_pde_mappings'_def setReply_def
-  apply (wpsimp wp: hoare_vcg_all_lift)
-  done
-
-lemma updateReply_valid_objs':
-  "\<lbrace>valid_objs' and (\<lambda>s. \<forall>r. valid_reply' r s \<longrightarrow> valid_reply' (upd r) s)\<rbrace>
-   updateReply rptr upd
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  unfolding updateReply_def
-  apply wpsimp
-  apply (frule(1) reply_ko_at_valid_objs_valid_reply')
-  apply clarsimp
-  done
-
-
-lemma replyUnlink_idle'[wp]:
-  "\<lbrace>valid_idle' and (\<lambda>s. tptr \<noteq> ksIdleThread s)\<rbrace>
-   replyUnlink rptr tptr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  unfolding replyUnlink_def replyUnlink_assertion_def updateReply_def
-  apply (wpsimp wp: hoare_vcg_imp_lift'
-              simp: pred_tcb_at'_def)
-  done
-
-lemma replyUnlink_valid_objs'[wp]:
-  "replyUnlink rptr tptr \<lbrace>valid_objs'\<rbrace>"
-  unfolding replyUnlink_def
-  apply (wpsimp wp: updateReply_valid_objs'[where upd="replyTCB_update (\<lambda>_. tptrOpt)" for tptrOpt]
-                    gts_wp'
-              simp: valid_tcb_state'_def)
-  apply (clarsimp simp: valid_reply'_def)
-  done
-
-lemma setReply_valid_replies':
-  "\<lbrace>\<lambda>s. valid_replies' s
-        \<and> (replyNext_of reply \<noteq> None \<or> replyPrev reply \<noteq> None \<longrightarrow>
-             (\<exists>tptr. replyTCB reply = Some tptr
-                     \<and> st_tcb_at'
-                       ((=) (Structures_H.thread_state.BlockedOnReply (Some rptr)))
-                       tptr s))\<rbrace>
-   setReply rptr reply
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  unfolding valid_replies'_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_ex_lift)
-  apply auto
-  done
-
-lemma updateReply_valid_replies':
-  "\<lbrace>\<lambda>s. valid_replies' s
-        \<and> (\<forall>reply. ko_at' reply rptr s \<longrightarrow>
-            (replyNext_of (f reply) \<noteq> None \<or> replyPrev (f reply) \<noteq> None \<longrightarrow>
-              (\<exists>tptr. replyTCB (f reply) = Some tptr
-                      \<and> st_tcb_at'
-                        ((=) (Structures_H.thread_state.BlockedOnReply (Some rptr)))
-                        tptr s)))\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  unfolding updateReply_def
-  by (wpsimp wp: setReply_valid_replies')
-
-lemma updateReply_valid_replies'_not_linked:
-  "\<lbrace>\<lambda>s. valid_replies' s
-        \<and> (\<forall>reply. ko_at' reply rptr s \<longrightarrow>
-                     replyNext_of (f reply) = None \<and> replyPrev (f reply) = None)\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  apply (wpsimp wp: updateReply_valid_replies')
-  by auto
-
-lemma updateReply_valid_replies'_bound:
-  "\<lbrace>\<lambda>s. valid_replies' s
-        \<and> (\<forall>reply. ko_at' reply rptr s \<longrightarrow>
-                     (\<exists>tptr. replyTCB (f reply) = Some tptr
-                             \<and> st_tcb_at' ((=) (BlockedOnReply (Some rptr))) tptr s))\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  by (wpsimp wp: updateReply_valid_replies')
-
-lemma updateReply_valid_replies'_except:
-  "\<lbrace>valid_replies'\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>_. valid_replies'_except {rptr}\<rbrace>"
-  unfolding valid_replies'_def valid_replies'_except_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_ex_lift updateReply_reply_projs)
-  apply (auto simp: opt_map_def)
-  done
-
-lemma replyUnlink_valid_replies'[wp]:
-  "\<lbrace>\<lambda>s. replyTCBs_of s rptr = Some tptr
-        \<longrightarrow> valid_replies' s \<and> \<not> is_reply_linked rptr s\<rbrace>
-   replyUnlink rptr tptr
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  unfolding replyUnlink_def
-  apply (wpsimp wp: updateReply_valid_replies'_not_linked sts'_valid_replies'
-                    hoare_vcg_all_lift hoare_vcg_imp_lift' gts_wp')
-  apply normalise_obj_at'
-  apply (clarsimp simp: valid_reply'_def pred_tcb_at'_def obj_at'_def projectKOs
-                        replyUnlink_assertion_def)
-  by (auto simp: opt_map_def split: option.splits)
-
-lemma replyUnlink_valid_pspace'[wp]:
-  "\<lbrace>\<lambda>s. valid_pspace' s \<and>
-        (replyTCBs_of s rptr = Some tptr \<longrightarrow> \<not> is_reply_linked rptr s)\<rbrace>
-   replyUnlink rptr tptr
-   \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
-  by (wpsimp simp: valid_pspace'_def)
-
-lemma replyUnlink_valid_idle'[wp]:
-  "\<lbrace>valid_idle' and (\<lambda>s. tptr \<noteq> ksIdleThread s)\<rbrace>
-   replyUnlink rptr tptr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  unfolding replyUnlink_def replyUnlink_assertion_def updateReply_def
-  by (wpsimp wp: hoare_vcg_imp_lift')
-
-lemma decompose_list_refs_of_replies':
-  "list_refs_of_replies' s
-   = (\<lambda>r. get_refs ReplyPrev (replyPrevs_of s r) \<union> get_refs ReplyNext (replyNexts_of s r))"
-  apply (fastforce simp: opt_map_def map_set_def list_refs_of_reply'_def
-                  split: option.splits)
-  done
-
-lemma cleanReply_reply_projs[wp]:
-  "\<lbrace>\<lambda>s. P ((replyNexts_of s)(rptr := None)) ((replyPrevs_of s)(rptr := None))
-          (replyTCBs_of s) ((replySCs_of s)(rptr := None))\<rbrace>
-   cleanReply rptr
-   \<lbrace>\<lambda>_ s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)\<rbrace>"
-  unfolding cleanReply_def updateReply_def
-  apply (wpsimp wp: set_reply'.set_wp)
-  apply (erule rsubst4[where P=P])
-     apply (clarsimp simp: ext opt_map_def obj_at'_def projectKO_eq
-                    split: option.splits)+
-  done
-
-lemma cleanReply_valid_objs'[wp]:
-  "cleanReply rptr \<lbrace>valid_objs'\<rbrace>"
-  unfolding cleanReply_def
-  apply (wpsimp wp: updateReply_valid_objs'
-              simp: valid_reply'_def)
-  done
-
-lemma cleanReply_valid_replies'[wp]:
-  "cleanReply rptr \<lbrace>valid_replies'\<rbrace>"
-  unfolding valid_replies'_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_ex_lift)
-  apply (auto simp: opt_map_def)
-  done
-
-crunch replyRemoveTCB
-  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and aligned'[wp]: pspace_aligned'
-  and distinct'[wp]: pspace_distinct'
-  and bounded'[wp]: pspace_bounded'
-  and ct_not_inQ[wp]: ct_not_inQ
-  and ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and cur_tcb'[wp]: "cur_tcb'"
-  and no_0_obj'[wp]: "no_0_obj'"
-  and it'[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and ct'[wp]: "\<lambda>s. P (ksCurThread s)"
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and ksMachineState[wp]: "\<lambda>s. P (ksMachineState s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and sch_act_simple[wp]: "sch_act_simple"
-  and valid_pde_mappings'[wp]: "valid_pde_mappings'"
-  and untyped_ranges_zero'[wp]: "untyped_ranges_zero'"
-  and ifunsafe'[wp]: "if_unsafe_then_cap'"
-  and global_refs'[wp]: "valid_global_refs'"
-  and valid_arch'[wp]: "valid_arch_state'"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n T p s)"
-  and vms'[wp]: "valid_machine_state'"
-  and valid_queues'[wp]: valid_queues'
-  and valid_queues[wp]: valid_queues
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and cap_to': "ex_nonz_cap_to' t"
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and valid_mdb'[wp]: valid_mdb'
-  (wp: crunch_wps hoare_vcg_if_lift valid_mdb'_lift
-   simp: pred_tcb_at'_def if_distribR if_bool_eq_conj)
-
-global_interpretation replyUnlink: typ_at_all_props' "replyUnlink replyPtr tcbPtr"
-  by typ_at_props'
-
-lemma replyRemoveTCB_valid_objs'[wp]:
-  "replyRemoveTCB tptr \<lbrace>valid_objs'\<rbrace>"
-  unfolding replyRemoveTCB_def
-  supply set_reply'.set_wp[wp del] if_split[split del]
-  apply (wpsimp wp: updateReply_valid_objs' hoare_vcg_if_lift hoare_vcg_imp_lift gts_wp'
-              simp: valid_reply'_def)
-  apply (clarsimp simp: valid_reply'_def if_bool_eq_conj if_distribR)
-  apply (case_tac "replyPrev ko = None"; clarsimp)
-   apply (drule(1) sc_ko_at_valid_objs_valid_sc',
-          clarsimp simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)+
-  done
-
-lemma updateReply_prev_None_valid_replies'[wp]:
-  "updateReply p (replyPrev_update (\<lambda>_. None)) \<lbrace>valid_replies'\<rbrace>"
-  unfolding valid_replies'_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_ex_lift)
-  by auto
-
-lemma updateReply_next_None_valid_replies'[wp]:
-  "updateReply p (replyNext_update (\<lambda>_. None)) \<lbrace>valid_replies'\<rbrace>"
-  unfolding valid_replies'_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_ex_lift)
-  by auto
-
-lemma replyRemoveTCB_valid_replies'[wp]:
-  "\<lbrace>valid_replies' and pspace_distinct' and pspace_aligned'\<rbrace>
-   replyRemoveTCB tptr
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  unfolding replyRemoveTCB_def
-  by (wpsimp wp: hoare_vcg_if_lift hoare_vcg_imp_lift gts_wp')
-
-lemma replyRemoveTCB_valid_pspace'[wp]:
-  "replyRemoveTCB tptr \<lbrace>valid_pspace'\<rbrace>"
-  unfolding valid_pspace'_def
-  by wpsimp
-
-lemma updateReply_iflive'_strong:
-  "\<lbrace>(\<lambda>s. reply_at' rptr s \<longrightarrow> if_live_then_nonz_cap' s) and
-   (\<lambda>s. \<forall>ko. ko_at' ko rptr s \<and> \<not> live_reply' ko \<and> live_reply' (f ko) \<longrightarrow> ex_nonz_cap_to' rptr s)\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  unfolding if_live_then_nonz_cap'_def
-  apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-    apply (wpsimp wp: updateReply_wp_all)
-   apply wpsimp
-  apply clarsimp
-  apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def ps_clear_def projectKO_reply)
-  apply (case_tac "x=rptr"; clarsimp)
-  done
-
-lemma updateReply_iflive':
-  "\<lbrace>if_live_then_nonz_cap' and K (\<forall>r. live_reply' (upd r) \<longrightarrow> live_reply' r)\<rbrace>
-   updateReply rptr upd
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  by (wpsimp wp: updateReply_iflive'_strong)
-
-lemma replyUnlink_iflive'[wp]:
-  "replyUnlink rptr tptr \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  unfolding replyUnlink_def
-  apply (wpsimp wp: updateReply_iflive' gts_wp' simp: live_reply'_def)
-  done
-
-lemma cleanReply_iflive'[wp]:
-  "cleanReply rptr \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  unfolding cleanReply_def
-  apply (wpsimp wp: updateReply_iflive' simp: live_reply'_def)
-  done
-
-lemma replyRemoveTCB_iflive'[wp]:
-  "replyRemoveTCB tptr \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  unfolding replyRemoveTCB_def
-  apply (wpsimp wp: hoare_vcg_all_lift updateReply_iflive' hoare_vcg_if_lift hoare_vcg_imp_lift'
-                    gts_wp'
-         split_del: if_split)
-  apply (clarsimp simp: live_reply'_def)
-  apply (intro impI conjI allI
-         ; clarsimp simp: live_reply'_def pred_tcb_at'_def)
-   apply normalise_obj_at'
-   apply (rename_tac s sc reply tcb_reply_ptr prev_ptr next_ptr tcb)
-   apply (prop_tac "live_sc' sc")
-    apply (clarsimp simp: live_sc'_def)
-   apply (prop_tac "ko_wp_at' live' (theHeadScPtr (Some next_ptr)) s")
-    apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKO_eq project_inject)
-   apply (clarsimp simp: if_live_then_nonz_cap'_def)
-  apply normalise_obj_at'
-  apply (rename_tac s sc reply tcb_reply_ptr next_ptr tcb)
-  apply (prop_tac "live_sc' sc")
-   apply (clarsimp simp: live_sc'_def)
-  apply (prop_tac "ko_wp_at' live' (theHeadScPtr (Some next_ptr)) s")
-   apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKO_eq project_inject)
-  apply (clarsimp simp: if_live_then_nonz_cap'_def)
-  done
-
-lemma cleanReply_valid_pspace'[wp]:
-  "cleanReply rptr \<lbrace>valid_pspace'\<rbrace>"
-  unfolding cleanReply_def valid_pspace'_def
-  apply (wpsimp wp: updateReply_valid_objs' simp: valid_reply'_def)
-  done
-
-lemma cleanReply_list_refs_of_replies':
-  "\<lbrace>\<lambda>s. P ((list_refs_of_replies' s)(rptr := {}))\<rbrace>
-   cleanReply rptr
-   \<lbrace>\<lambda>_ s. P (list_refs_of_replies' s)\<rbrace>"
-  unfolding cleanReply_def decompose_list_refs_of_replies'
-  apply wpsimp
-  apply (erule rsubst[where P=P])
-  apply (rule ext)
-  apply (clarsimp simp: list_refs_of_reply'_def fun_upd_def)
-  done
-
-lemma isHead_to_head:
-  "isHead x = (\<exists>scPtr. x = Some (Head scPtr))"
-  "(\<forall>scPtr. y \<noteq> Head scPtr) = (\<exists>rPtr. y = Next rPtr)"
-  apply (clarsimp simp: isHead_def split: option.split reply_next.split)
-  apply (case_tac y; clarsimp)
-  done
-
-lemma ks_reply_at'_repliesD:
-  "\<lbrakk>replies_of' s rptr = Some reply; sym_refs (list_refs_of_replies' s)\<rbrakk>
-   \<Longrightarrow> replyNexts_of s rptr = replyNext_of reply
-       \<and> (case replyNext_of reply of
-            Some next \<Rightarrow> replyPrevs_of s next = Some rptr
-          | None \<Rightarrow> \<forall>rptr'. replyPrevs_of s rptr' \<noteq> Some rptr)
-       \<and> replyPrevs_of s rptr = replyPrev reply
-       \<and> (case replyPrev reply of
-            Some prev \<Rightarrow> replyNexts_of s prev = Some rptr
-          | None \<Rightarrow> \<forall>rptr'. replyNexts_of s rptr' \<noteq> Some rptr)"
-  apply (prop_tac "replyNexts_of s rptr = replyNext_of reply
-                   \<and> replyPrevs_of s rptr = replyPrev reply ")
-   apply (clarsimp simp: opt_map_def)
-  apply (case_tac "replyNext_of reply"
-         ; case_tac "replyPrev reply"
-         ; clarsimp simp: sym_refs_replyNext_None sym_refs_replyPrev_None
-                          sym_refs_replyNext_replyPrev_sym)
-  done
-
-\<comment>\<open> Used to "hide" @{term "sym_refs o list_refs_of_replies'"} from simplification. \<close>
-definition protected_sym_refs :: "kernel_state \<Rightarrow> bool" where
-  "protected_sym_refs s \<equiv> sym_refs (list_refs_of_replies' s)"
-
-lemma replyRemoveTCB_sym_refs_list_refs_of_replies':
-  "replyRemoveTCB tptr \<lbrace>\<lambda>s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  unfolding replyRemoveTCB_def decompose_list_refs_of_replies'
-  supply if_cong[cong]
-  apply (wpsimp wp: cleanReply_list_refs_of_replies' hoare_vcg_if_lift hoare_vcg_imp_lift' gts_wp'
-                    haskell_assert_wp
-              simp: pred_tcb_at'_def
-         split_del: if_split)
-  unfolding decompose_list_refs_of_replies'[symmetric] protected_sym_refs_def[symmetric]
-  \<comment>\<open> opt_mapE will sometimes destroy the @{term "(|>)"} inside @{term replyNexts_of}
-      and @{term replyPrevs_of}, but we're using those as our local normal form. \<close>
-  apply (intro conjI impI allI)
-       \<comment>\<open> Our 6 cases correspond to various cases of @{term replyNext} and @{term replyPrev}.
-           We use @{thm ks_reply_at'_repliesD} to turn those cases into facts about
-           @{term replyNexts_of} and @{term replyPrevs_of}. \<close>
-       apply (all \<open>clarsimp simp: isHead_to_head
-                   , normalise_obj_at'\<close>)
-       apply (all \<open>drule(1) ks_reply_at'_repliesD[OF ko_at'_replies_of',
-                                                  folded protected_sym_refs_def]
-                   , clarsimp simp: projectKO_reply isHead_to_head\<close>)
-       \<comment>\<open> Now, for each case we can blow open @{term sym_refs}, which will give us enough new
-           @{term "(replyNexts_of, replyPrevs_of)"} facts that we can throw it all at metis. \<close>
-       apply (clarsimp simp: sym_refs_def split_paired_Ball in_get_refs
-              , intro conjI impI allI
-              ; metis sym_refs_replyNext_replyPrev_sym[folded protected_sym_refs_def] option.sel
-                      option.inject)+
-  done
-
-lemma replyRemoveTCB_valid_idle':
-  "replyRemoveTCB tptr \<lbrace>valid_idle'\<rbrace>"
-  unfolding replyRemoveTCB_def
-  apply (wpsimp wp: hoare_vcg_if_lift hoare_vcg_imp_lift' gts_wp' setObject_sc_idle')
-  apply (clarsimp simp: valid_reply'_def pred_tcb_at'_def)
-  apply (intro conjI impI allI
-         ; simp?
-         , normalise_obj_at'?
-         , (solves \<open>clarsimp simp: valid_idle'_def idle_tcb'_def obj_at'_def isReply_def\<close>)?)
-  done
-
-lemma replyUnlink_sch_act[wp]:
-  "replyUnlink r t \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp only: replyUnlink_def liftM_def)
-  apply (wpsimp wp: sts_sch_act' gts_wp')
-  apply (fastforce simp: replyUnlink_assertion_def st_tcb_at'_def obj_at'_def)
-  done
-
-lemma replyUnlink_weak_sch_act_wf[wp]:
-  "replyUnlink r t \<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp only: replyUnlink_def liftM_def)
-  apply (wpsimp wp: sts_sch_act' gts_wp')
-  by (fastforce simp: replyUnlink_assertion_def st_tcb_at'_def obj_at'_def
-                      weak_sch_act_wf_def)
-
-lemma replyRemoveTCB_sch_act_wf:
-  "replyRemoveTCB tptr \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding replyRemoveTCB_def
-  by (wpsimp wp: gts_wp' haskell_assert_wp hoare_vcg_if_lift hoare_vcg_imp_lift'
-           simp: pred_tcb_at'_def
-      split_del: if_split)
-
-lemma replyRemoveTCB_invs':
-  "replyRemoveTCB tptr \<lbrace>invs'\<rbrace>"
-  unfolding invs'_def valid_dom_schedule'_def
-  apply (wpsimp wp: replyRemoveTCB_sym_refs_list_refs_of_replies'
-                    valid_irq_node_lift valid_irq_handlers_lift' valid_irq_states_lift'
-                    irqs_masked_lift replyRemoveTCB_sch_act_wf
-              simp: cteCaps_of_def)
-  done
-
-lemma set_reply_obj_ref_noop:
-  "monadic_rewrite False True (reply_at rptr)
-   (return ())
-   (set_reply_obj_ref (K id) rptr x)"
-  by (clarsimp simp: set_simple_ko_def monadic_rewrite_def exec_gets
-                     update_sk_obj_ref_def gets_the_def
-                     get_simple_ko_def partial_inv_inj_Some get_object_def bind_assoc obj_at_def
-                     is_reply_def2 set_object_def exec_get put_id_return)
-
-lemma updateReply_replyPrev_same_corres:
-  assumes
-    rr: "\<And>r1 r2. reply_relation r1 r2 \<Longrightarrow>
-           reply_relation (g (\<lambda>y. new) r1) (f r2)"
-  shows
-  "corres dc (reply_at rp) (reply_at' rp and obj_at' (\<lambda>ko. replyPrev_same (f ko) ko) rp)
-     (set_reply_obj_ref g rp new)
-     (updateReply rp f)"
-  apply (simp add: update_sk_obj_ref_def updateReply_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_reply_corres])
-      apply (rule set_reply_corres)
-      apply (simp add: rr)
-     apply wpsimp+
-  by (clarsimp simp: obj_at'_def)
-
-lemma updateReply_replyPrev_corres:
-  "corres dc (reply_at rp and (\<lambda>s. rp \<notin> fst ` replies_with_sc s)) (reply_at' rp)
-     (set_reply_obj_ref (\<lambda>_. id) rp r1)
-     (updateReply rp (replyPrev_update (\<lambda>_. new)))"
-  apply (simp add: update_sk_obj_ref_def updateReply_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_reply_corres])
-      apply (rule setReply_not_queued_corres)
-      apply (simp add: reply_relation_def)
-  by wpsimp+
-
-lemma replyPrev_same_replyNext[simp]:
-  "replyPrev_same (replyNext_update (\<lambda>_. Some (Head scptr)) ko) ko"
-  by (clarsimp simp: replyPrev_same_def)
-
-lemma updateReply_replyNext_not_head_corres:
-  "\<not> isHead next_opt \<Longrightarrow>
-   corres dc (reply_at rptr) (reply_at' rptr)
-   (set_reply_obj_ref reply_sc_update rptr None)
-   (updateReply rptr (\<lambda>reply. replyNext_update (\<lambda>_. next_opt) reply))"
-    unfolding update_sk_obj_ref_def updateReply_def
-  apply clarsimp
-  apply (rule corres_guard_imp)
-  apply (rule corres_split[OF get_reply_corres set_reply_corres])
-  apply (clarsimp simp: reply_relation_def isHead_def
-                 split: option.splits reply_next.splits)
-  apply wpsimp+
-  apply (clarsimp simp: obj_at'_def replyPrev_same_def)
-  done
-
-lemma update_sc_reply_stack_update_ko_at'_corres:
-  "corres dc
-     (sc_at ptr)
-     (ko_at' sc' ptr and (\<lambda>s. heap_ls (replyPrevs_of s) reply_ptr replies))
-     (update_sched_context ptr (sc_replies_update (\<lambda>_. replies)))
-     (setSchedContext ptr (scReply_update (\<lambda>_. reply_ptr) sc'))"
-  apply (rule_tac Q="sc_at' ptr" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD sc_at_cross simp: obj_at'_def)
-  apply (rule_tac Q="sc_obj_at (objBits sc' - minSchedContextBits) ptr" in corres_cross_add_abs_guard)
-   apply (fastforce dest!: state_relationD ko_at_sc_cross)
-  apply (rule corres_guard_imp)
-    apply (rule_tac P="sc_obj_at (objBits sc' - minSchedContextBits) ptr"
-               and n1="objBits sc' - minSchedContextBits"
-                in monadic_rewrite_corres_l[OF update_sched_context_rewrite])
-    apply (rule corres_symb_exec_l)
-       apply (rule corres_guard_imp)
-         apply (rule setSchedContext_update_corres
-                       [where f'="scReply_update (\<lambda>_. reply_ptr)"
-                        and f="sc_replies_update (\<lambda>_. replies)"])
-          apply (clarsimp simp: sc_relation_def)
-         apply (clarsimp simp: objBits_def objBitsKO_def)
-        apply simp+
-      apply (wpsimp wp: get_sched_context_exs_valid simp: is_sc_obj_def obj_at_def)
-       apply (rename_tac ko; case_tac ko; simp)
-      apply simp
-     apply (wpsimp simp: obj_at_def is_sc_obj_def
-            | fastforce split: Structures_A.kernel_object.splits)+
-  done
-
-lemma bindScReply_corres:
-  "corres dc (reply_at rptr and sc_at scptr and (\<lambda>s. rptr \<notin> fst ` replies_with_sc s)
-                and pspace_aligned and pspace_distinct and valid_objs
-                and valid_replies and (\<lambda>s. sym_refs (state_refs_of s)))
-             (reply_at' rptr and sc_at' scptr)
-   (bind_sc_reply scptr rptr)
-   (bindScReply scptr rptr)"
-  unfolding bind_sc_reply_def bindScReply_def case_list_when sym_refs_asrt_def
-  apply (clarsimp simp: liftM_def)
-  apply add_sym_refs
-  apply (rule corres_stateAssert_implied[where P'=\<top>, simplified])
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF get_sc_corres, where R'="\<lambda>sc. reply_at' rptr and ko_at' sc scptr"])
-    (* This command is the lynch-pin. This does all useful state-relation lifting
-         and prepares the rest of the argument*)
-       apply (rule_tac Q'="reply_at' rptr and ko_at' sc scptr
-                and K (scReply sc = hd_opt (sc_replies x))
-                and (\<lambda>s. scReply sc \<noteq> None \<longrightarrow> reply_at' (the (scReply sc)) s)
-                and K (rptr \<notin> set (sc_replies x))
-                and (\<lambda>s. heap_ls (replyPrevs_of s) (scReply sc) (sc_replies x))"
-              and Q="reply_at rptr and sc_at scptr
-                and (\<lambda>s. rptr \<notin> fst ` replies_with_sc s)
-                and pspace_aligned and pspace_distinct and valid_objs
-                and valid_replies and (\<lambda>s. sym_refs (state_refs_of s))
-                and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext x n) scptr s)"
-              in stronger_corres_guard_imp)
-         apply (rule corres_guard_imp)
-           apply (rule corres_split[where r'=dc])
-              apply (rule_tac F="(sc_replies x \<noteq> []) = (\<exists>y. scReply sc = Some y)" in corres_gen_asm2)
-              apply (erule corres_when2)
-              apply (rule_tac F="scReply sc = Some (hd (sc_replies x))" in corres_gen_asm2)
-              apply simp
-              apply (rule_tac P'="\<lambda>s. valid_replies s \<and> sym_refs (state_refs_of s)
-                                      \<and> pspace_aligned s \<and> pspace_distinct s"
-                     in corres_stateAssert_implied)
-               apply (rule updateReply_replyNext_not_head_corres)
-               apply (simp add: isHead_def)
-              apply (erule valid_replies_sc_cross; clarsimp)
-             apply (rule corres_add_noop_lhs)
-             apply (rule monadic_rewrite_corres_l
-                          [OF monadic_rewrite_bind_head,
-                           OF set_reply_obj_ref_noop[where rptr=rptr and x=None]])
-             apply (simp add: bind_assoc)
-             apply (rule corres_split[OF updateReply_replyPrev_corres])
-               apply (rule corres_split[OF update_sc_reply_stack_update_ko_at'_corres])
-                 apply (rule updateReply_replyPrev_same_corres)
-                 apply (clarsimp simp: reply_relation_def)
-                apply (wpsimp wp: updateReply_reply_projs hoare_vcg_all_lift )+
-             apply (rule_tac Q'="\<lambda>_. reply_at' rptr and ko_at' sc scptr
-                      and (\<lambda>s. heap_ls (replyPrevs_of s) (Some y) (sc_replies x))
-                      and K (rptr \<notin> set (sc_replies x))"
-                    in hoare_strengthen_post[rotated])
-              apply clarsimp
-              apply (erule (1) heap_path_heap_upd_not_in[simplified fun_upd_def])
-             apply wpsimp
-             apply (frule Some_to_the, simp)
-            apply (wpsimp wp: updateReply_reply_projs)+
-          apply (clarsimp simp: obj_at_def)
-          apply (frule (1) valid_sched_context_objsI)
-          apply (clarsimp simp: valid_sched_context_def list_all_def obj_at_def)
-         apply clarsimp
-         apply (case_tac "sc_replies x"; simp)
-        apply assumption
-       apply (clarsimp simp: obj_at_def  is_sc_obj)
-       apply (frule state_relation_sc_replies_relation)
-       apply (subgoal_tac "scReply sc = hd_opt (sc_replies sca)")
-        apply (intro conjI)
-           apply clarsimp
-          apply clarsimp
-          apply (erule (1) reply_at_cross[rotated])
-           apply (frule (1) valid_sched_context_objsI)
-           apply (clarsimp simp: valid_sched_context_def list_all_def obj_at_def)
-          apply fastforce
-         apply (clarsimp simp: replies_with_sc_def image_def)
-         apply (drule_tac x=scptr in spec)
-         apply (clarsimp simp: sc_at_pred_n_def obj_at_def)
-        apply (erule (1) sc_replies_relation_prevs_list)
-        apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKO_sc)
-       apply (force dest!: sc_replies_relation_scReplies_of
-                     simp: obj_at'_def projectKOs opt_map_red vs_heap_simps is_sc_obj
-                           obj_at_def)
-      apply wpsimp+
-  done
-
-lemma setObject_reply_pde_mappings'[wp]:
-  "setObject ptr (val :: reply) \<lbrace>valid_pde_mappings'\<rbrace>"
-  by (wp valid_pde_mappings_lift')
-
-crunch bindScReply
-  for pspace_aligned'[wp]: pspace_aligned'
-  and pspace_distinct'[wp]: pspace_distinct'
-  and bounded'[wp]: pspace_bounded'
-  and if_unsafe_then_cap'[wp]: if_unsafe_then_cap'
-  and valid_global_refs'[wp]: valid_global_refs'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and valid_irq_node'[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  and valid_irq_handlers'[wp]: valid_irq_handlers'
-  and valid_irq_states'[wp]: valid_irq_states'
-  and valid_machine_state'[wp]: valid_machine_state'
-  and irqs_masked'[wp]: irqs_masked'
-  and valid_release_queue'[wp]: valid_release_queue'
-  and ct_not_inQ[wp]: ct_not_inQ
-  and ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and valid_pde_mappings'[wp]: valid_pde_mappings'
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and valid_dom_schedule'[wp]: valid_dom_schedule'
-  and cur_tcb'[wp]: cur_tcb'
-  and no_0_obj'[wp]: no_0_obj'
-  and valid_mdb'[wp]: valid_mdb'
-  and tcb_at'[wp]: "tcb_at' t"
-  and cte_wp_at'[wp]: "cte_wp_at' P p"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  (wp: crunch_wps hoare_vcg_all_lift valid_irq_node_lift
-   simp: crunch_simps valid_mdb'_def valid_dom_schedule'_def)
-
-crunch setThreadState
-  for sc_ko_at'[wp]: "\<lambda>s. P (ko_at' (sc :: sched_context) p s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma updateReply_obj_at':
-  "\<lbrace>\<lambda>s. reply_at' rptr s \<longrightarrow>
-          P (obj_at' (\<lambda>ko. if rptr = p then Q (f ko) else Q ko) p s)\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>rv s. P (obj_at' Q p s)\<rbrace>"
-  apply (simp only: obj_at'_real_def updateReply_def)
-  apply (wp set_reply'.ko_wp_at)
-  apply (auto simp: ko_wp_at'_def obj_at'_def projectKO_eq projectKO_reply split: if_splits)
-  done
-
-lemma no_tcb_not_in_replies_with_sc:
-  "\<lbrakk>valid_replies s; sym_refs (state_refs_of s);
-    reply_tcb_reply_at (\<lambda>tptr. tptr = None) reply_ptr s\<rbrakk>
-   \<Longrightarrow> reply_ptr \<notin> fst ` replies_with_sc s"
-  apply (intro notI)
-  unfolding valid_replies_defs
-  apply (erule conjE)
-  apply (drule (1) set_mp)
-  apply clarsimp
-  apply (rename_tac scptr tptr)
-  apply (frule_tac thread = tptr in st_tcb_reply_state_refs[rotated])
-   apply (clarsimp simp: pred_tcb_at_def obj_at_def, rule refl)
-  apply (clarsimp simp: sk_obj_at_pred_def obj_at_def)
-  done
-
-lemma updateReply_list_refs_of_replies':
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko rptr s \<longrightarrow> P ((list_refs_of_replies' s)(rptr := list_refs_of_reply' (f ko)))\<rbrace>
-   updateReply rptr f
-   \<lbrace>\<lambda>rv s. P (list_refs_of_replies' s)\<rbrace>"
-  unfolding updateReply_def by wp
-
-lemma updateReply_obj_at'_inv:
-  "\<forall>x. P (f x) = P x \<Longrightarrow>
-   updateReply rPtr f \<lbrace>\<lambda>s. Q (obj_at' (P :: reply \<Rightarrow> bool) rp s)\<rbrace>"
-  apply (wpsimp wp: updateReply_wp_all)
-  apply (subgoal_tac "obj_at' P rp s = (obj_at' P rp (s\<lparr>ksPSpace := (ksPSpace s)(rPtr \<mapsto> KOReply (f ko))\<rparr>))")
-   apply simp
-  by (force simp: obj_at'_real_def ko_wp_at'_def objBitsKO_def ps_clear_def
-                  projectKO_reply)
-
-lemma updateReply_iflive'_weak:
-  "\<lbrace>\<lambda>s. reply_at' replyPtr s \<longrightarrow> if_live_then_nonz_cap' s \<and> ex_nonz_cap_to' replyPtr s\<rbrace>
-   updateReply replyPtr f
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  by (wpsimp wp: updateReply_iflive'_strong, clarsimp simp: obj_at'_def)
-
-lemma updateReply_replyTCB_invs':
-  "\<lbrace>invs' and ex_nonz_cap_to' rptr and case_option \<top> (\<lambda>t. tcb_at' t) p and
-    (\<lambda>s. is_reply_linked rptr s
-         \<longrightarrow> (\<exists>tptr. p = Some tptr \<and> st_tcb_at' ((=) (BlockedOnReply (Some rptr))) tptr s))\<rbrace>
-   updateReply rptr (replyTCB_update (\<lambda>_. p))
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (wpsimp wp: updateReply_iflive'_weak updateReply_valid_objs'
-                    updateReply_list_refs_of_replies'_inv updateReply_valid_replies'
-           simp: invs'_def valid_pspace'_def valid_reply'_def
-          split: option.split_asm)
-   by (auto simp: obj_at'_def projectKOs opt_map_def)
-
-lemma bindScReply_valid_objs'[wp]:
-  "\<lbrace>valid_objs' and reply_at' replyPtr\<rbrace>
-   bindScReply scp replyPtr
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  unfolding bindScReply_def
-  supply set_sc_valid_objs'[wp del] set_sc'.valid_objs'[wp]
-  apply (wpsimp wp: updateReply_valid_objs')
-       apply (rule_tac Q'="\<lambda>_. valid_objs' and sc_at' scp" in hoare_strengthen_post)
-        apply wpsimp
-       apply (simp add: valid_reply'_def valid_bound_obj'_def)
-      apply (wpsimp wp: updateReply_valid_objs')
-     apply wpsimp
-      apply (rule_tac Q'="\<lambda>_. valid_objs' and reply_at' y and reply_at' replyPtr
-                         and ko_at' sc scp" in hoare_strengthen_post)
-       apply (wpsimp wp: updateReply_valid_objs')
-      apply clarsimp
-      apply (prop_tac "sc_at' scp s")
-       apply (clarsimp simp: obj_at'_def)
-      apply (clarsimp simp: valid_reply'_def valid_obj'_def objBits_simps'
-                            valid_sched_context'_def valid_sched_context_size'_def
-                     dest!: sc_ko_at_valid_objs_valid_sc')+
-     apply wpsimp+
-  apply safe
-       apply ((clarsimp simp: valid_reply'_def valid_obj'_def objBits_simps'
-                              valid_sched_context'_def valid_sched_context_size'_def
-                       dest!: sc_ko_at_valid_objs_valid_sc')+)[5]
-  done
-
-lemma bindScReply_valid_replies'[wp]:
-  "\<lbrace>\<lambda>s. valid_replies' s \<and> pspace_distinct' s \<and> pspace_aligned' s \<and> pspace_bounded' s
-        \<and> (\<exists>tptr. replyTCBs_of s replyPtr = Some tptr
-                  \<and> st_tcb_at' ((=) (BlockedOnReply (Some replyPtr)))
-                               tptr s)\<rbrace>
-   bindScReply scPtr replyPtr
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  apply (solves wp | simp (no_asm_use) add: bindScReply_def split del: if_split cong: conj_cong |
-         wp when_wp haskell_assert_wp hoare_vcg_if_lift2 hoare_vcg_all_lift
-            hoare_vcg_disj_lift hoare_vcg_imp_lift' hoare_vcg_ex_lift
-            updateReply_valid_replies'_bound updateReply_obj_at')+
-  apply (clarsimp simp: sym_refs_asrt_def)
-  apply (intro conjI impI allI; clarsimp?)
-      apply (drule valid_replies'_sc_asrtD)
-       apply (clarsimp, rule_tac x=scPtr in exI)
-       apply (erule (3) sym_refs_scReplies[THEN sym_heapD1])
-       apply (clarsimp simp: obj_at'_def projectKOs opt_map_def)
-      apply ((erule impCE)?; fastforce simp: obj_at'_def projectKOs elim!: opt_mapE)+
-  done
-
-crunch bindScReply
-  for valid_queues[wp]: valid_queues
-  and valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  (simp: crunch_simps)
-
-lemma bindScReply_sch_act_wf[wp]:
-  "bindScReply scPtr replyPtr \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding bindScReply_def
-  by (wpsimp wp: sts_sch_act' hoare_vcg_all_lift hoare_vcg_if_lift hoare_drop_imps)
-
-lemma bindsym_heap_scReplies_list_refs_of_replies':
-  "\<lbrace>\<lambda>s. sym_refs (list_refs_of_replies' s)
-      \<and> \<not> is_reply_linked replyPtr s \<and> replySCs_of s replyPtr = None
-      \<and> (\<forall>oldReplyPtr. (scReplies_of s) scPtr = Some oldReplyPtr
-                          \<longrightarrow> replySCs_of s oldReplyPtr = Some scPtr)\<rbrace>
-   bindScReply scPtr replyPtr
-   \<lbrace>\<lambda>_ s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  supply if_split [split del]
-  unfolding bindScReply_def
-  apply (wpsimp wp: updateReply_list_refs_of_replies' updateReply_obj_at'
-                    hoare_vcg_all_lift hoare_vcg_imp_lift')
-  by (auto simp: list_refs_of_replies'_def list_refs_of_reply'_def
-                 opt_map_Some_def obj_at'_def projectKO_eq
-           elim: delta_sym_refs split: if_splits)
-
-lemma bindScReply_if_live_then_nonz_cap':
-  "\<lbrace>if_live_then_nonz_cap'
-    and ex_nonz_cap_to' scPtr and ex_nonz_cap_to' replyPtr
-    and (\<lambda>s. \<forall>rp. (scReplies_of s) scPtr = Some rp
-                    \<longrightarrow> replySCs_of s rp = Some scPtr)\<rbrace>
-   bindScReply scPtr replyPtr
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  unfolding bindScReply_def
-  apply (simp (no_asm_use) split del: if_split
-         | wp hoare_vcg_all_lift hoare_vcg_imp_lift'
-              hoare_vcg_if_lift updateReply_iflive'_weak
-         | rule threadGet_wp)+
-  apply clarsimp
-  apply (erule if_live_then_nonz_capE')
-   apply (clarsimp simp: ko_wp_at'_def obj_at'_def live_reply'_def opt_map_def projectKOs)
-  done
-
-lemma bindScReply_ex_nonz_cap_to'[wp]:
-  "bindScReply scPtr replyPtr \<lbrace>ex_nonz_cap_to' ptr\<rbrace>"
-  unfolding bindScReply_def
-        apply (simp (no_asm_use) split del: if_split
-               | wp hoare_vcg_all_lift hoare_vcg_disj_lift hoare_vcg_imp_lift'
-                    hoare_vcg_if_lift set_reply'.obj_at' updateReply_obj_at'
-               | rule threadGet_wp)+
-  by clarsimp
-
-lemma bindScReply_obj_at'_scTCB[wp]:
-  "bindScReply scPtr replyPtr
-   \<lbrace>\<lambda>s. P (obj_at' (\<lambda>ko. P' (scTCB ko)) scPtr s)\<rbrace>"
-  unfolding bindScReply_def
-  apply (wpsimp wp: hoare_drop_imp set_sc'.obj_at')
-  by (auto simp: obj_at'_real_def ko_wp_at'_def)
-
-lemma setReply_valid_tcbs'[wp]:
-  "setReply rp new  \<lbrace>valid_tcbs'\<rbrace>"
-  unfolding valid_tcbs'_def
-  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' set_reply'.setObject_wp
-           simp: setReply_def)
-
-crunch updateReply
-  for valid_tcbs'[wp]: valid_tcbs'
-
-lemma updateReply_None_sym_refs_list_refs_of_replies'[wp]:
-  "\<lbrace>\<lambda>s. sym_refs (list_refs_of_replies' s) \<and>
-        replySCs_of s rptr \<noteq> None\<rbrace>
-   updateReply rptr (replyNext_update (\<lambda>_. None))
-   \<lbrace>\<lambda>_ s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  apply (wpsimp wp: updateReply_list_refs_of_replies')
-  apply (erule delta_sym_refs)
-   apply (auto simp: list_refs_of_reply'_def map_set_def
-                     opt_map_def obj_at'_def projectKOs
-              split: option.splits if_splits)
-  done
-
-lemma updateReply_replyNext_None_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> replySCs_of s rptr \<noteq> None\<rbrace>
-   updateReply rptr (replyNext_update (\<lambda>_. None))
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp only: invs'_def valid_pspace'_def)
-  apply (wpsimp wp: updateReply_valid_objs' updateReply_iflive')
-  apply (clarsimp simp: obj_at'_def projectKOs valid_reply'_def live_reply'_def
-                  dest: pspace_alignedD' pspace_distinctD')
-  done
-
-context begin interpretation Arch .
-
-lemma pspace_relation_reply_update_conc_only:
-  "\<lbrakk> pspace_relation ps ps'; ps x = Some (Structures_A.Reply reply); ps' x = Some (KOReply reply');
-     reply_relation reply new\<rbrakk>
-   \<Longrightarrow> pspace_relation ps (ps'(x \<mapsto> (KOReply new)))"
-  apply (simp add: pspace_relation_def pspace_dom_update dom_fun_upd2
-              del: dom_fun_upd)
-  apply (erule conjE)
-  apply (rule ballI, drule(1) bspec)
-  apply (clarsimp simp: split_def)
-  apply (drule bspec, simp)
-  apply (clarsimp simp: obj_relation_cuts_def2 cte_relation_def
-                        pte_relation_def pde_relation_def
-                 split: Structures_A.kernel_object.split_asm arch_kernel_obj.split_asm if_split_asm)
-  done
-
-end
-
-lemma replyPrevs_of_replyNext_update:
-  "ko_at' reply' rp s' \<Longrightarrow>
-      replyPrevs_of (s'\<lparr>ksPSpace := (ksPSpace s')(rp \<mapsto>
-                            KOReply (reply' \<lparr> replyNext := v \<rparr>))\<rparr>) = replyPrevs_of s'"
-  apply (clarsimp simp: obj_at'_def projectKOs isNext_def
-                 split: option.split_asm reply_next.split_asm)
-  by (fastforce simp: projectKO_opt_reply opt_map_def)
-
-lemma scs_of'_reply_update:
-  "reply_at' rp s' \<Longrightarrow>
-      scs_of' (s'\<lparr>ksPSpace := (ksPSpace s')(rp \<mapsto> KOReply reply)\<rparr>) = scs_of' s'"
-  apply (clarsimp simp: obj_at'_def projectKOs isNext_def
-                 split: option.split_asm reply_next.split_asm)
-  by (fastforce simp: projectKO_opt_sc opt_map_def)
-
-lemma sc_replies_relation_replyNext_update:
-  "\<lbrakk>sc_replies_relation s s'; ko_at' reply' rp s'\<rbrakk>
-     \<Longrightarrow> sc_replies_relation s (s'\<lparr>ksPSpace := (ksPSpace s')(rp \<mapsto>
-                                           KOReply (reply' \<lparr> replyNext := v \<rparr>))\<rparr>)"
-  by (clarsimp simp: scs_of'_reply_update[simplified] obj_at'_def
-                     replyPrevs_of_replyNext_update[simplified])
-
-(* sym_refs and prev/next; scReply and replySC *)
-
-lemma sym_refs_replySCs_of_None:
-  "\<lbrakk>sym_refs (state_refs_of' s'); pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s';
-   replySCs_of s' rp = None\<rbrakk>
-  \<Longrightarrow> \<forall>scp. scs_of' s' scp \<noteq> None \<longrightarrow> scReplies_of s' scp \<noteq> Some rp"
-  apply (clarsimp simp: obj_at'_def projectKOs elim!: opt_mapE)
-  apply (drule_tac tp=SCReply and y=rp and x=scp in sym_refsD[rotated])
-   apply (force simp: state_refs_of'_def dest: pspace_boundedD' pspace_alignedD' pspace_distinctD')
-  by (clarsimp simp: state_refs_of'_def refs_of_rev' opt_map_red
-              split: option.split_asm if_split_asm)
-
-(* cleanReply *)
-crunch cleanReply
- for valid_tcbs'[wp]: valid_tcbs'
-
-lemma no_fail_setReply [wp]:
-  "no_fail (reply_at' p) (setReply p reply)"
-  unfolding setReply_def
-  by (wpsimp simp: objBits_simps)
-
-lemma no_fail_updateReply [wp]:
-  "no_fail (reply_at' rp) (updateReply rp f)"
-  unfolding updateReply_def by wpsimp
-
-lemma no_fail_cleanReply [wp]:
-  "no_fail (reply_at' rp) (cleanReply rp)"
-  unfolding cleanReply_def
-  apply (rule no_fail_pre, rule no_fail_bind)
-     apply (wpsimp wp: updateReply_wp_all)+
-  apply (clarsimp simp: obj_at'_def ps_clear_upd objBits_simps' projectKOs)
-  done
-
-(* sc_with_reply/sc_with_reply' *)
-
-lemma valid_objs'_replyPrevs_of_reply_at':
-  "\<lbrakk> valid_objs' s'; replyPrevs_of s' rp = Some rp'\<rbrakk> \<Longrightarrow> reply_at' rp' s'"
-  apply (clarsimp elim!: opt_mapE)
-  apply (erule (1) valid_objsE')
-  by (clarsimp simp: valid_obj'_def valid_reply'_def valid_bound_obj'_def obj_at'_def projectKOs)
-
-lemma valid_objs'_replyNexts_of_reply_at':
-  "\<lbrakk> valid_objs' s'; replyNexts_of s' rp = Some rp'\<rbrakk> \<Longrightarrow> reply_at' rp' s'"
-  apply (clarsimp elim!: opt_mapE)
-  apply (erule (1) valid_objsE')
-  by (clarsimp simp: valid_obj'_def valid_reply'_def valid_bound_obj'_def obj_at'_def projectKOs)
-
-(** sc_with_reply and sc_replies_relations : crossing information **)
-
-(* modified version of sc_replies_relation_prevs_list in StateRelation.thy;
-   updates only the abstract sc_relies; useful for the following few lemmas *)
-lemma sc_replies_relation_prevs_list':
-  "\<lbrakk> sc_replies_relation s s';
-     kheap s scp = Some (kernel_object.SchedContext sc n)\<rbrakk>
-    \<Longrightarrow> heap_ls (replyPrevs_of s') (scReplies_of s' scp) (sc_replies sc)"
-  apply (clarsimp simp: sc_replies_relation_def sc_replies_of_scs_def scs_of_kh_def map_project_def)
-  apply (clarsimp simp: opt_map_red)
-  done
-
-lemma sc_replies_relation_sc_with_reply_cross_eq_pred:
-  "\<lbrakk> sc_replies_relation s s'; pspace_relation (kheap s) (ksPSpace s')\<rbrakk> \<Longrightarrow>
-   (\<exists>sc n. kheap s scp = Some (kernel_object.SchedContext sc n) \<and> rp \<in> set (sc_replies sc))
-    = (\<exists>xs. heap_ls (replyPrevs_of s') (scReplies_of s' scp) xs \<and> rp \<in> set xs)"
-  supply opt_mapE[elim!]
-  apply (rule iffI; clarsimp)
-   apply (rule_tac x="the (sc_replies_of2 s scp)" in exI)
-  apply (clarsimp simp: sc_replies_relation_def sc_replies_of_scs_def scs_of_kh_def map_project_def)
-  apply (drule_tac x=scp and y="sc_replies sc" in spec2)
-  apply (clarsimp simp: opt_map_def projectKO_opt_sc split: option.splits)
-  apply (case_tac "scReplies_of s' scp", simp)
-  apply (rename_tac p)
-  apply (drule pspace_relation_sc_at[where scp=scp])
-   apply (clarsimp simp: projectKOs opt_map_red opt_pred_def)
-  apply (clarsimp simp: obj_at_simps is_sc_obj opt_map_red)
-  apply (drule (1) sc_replies_relation_prevs_list', simp add: opt_map_red)
-  apply (drule (1) heap_ls_unique, simp)
-  done
-
-(* crossing equality for sc_with_reply *)
-lemma sc_replies_relation_sc_with_reply_cross_eq:
-  "\<lbrakk> sc_replies_relation s s'; pspace_relation (kheap s) (ksPSpace s') \<rbrakk>
-   \<Longrightarrow> sc_with_reply rp s = sc_with_reply' rp s'"
-  unfolding sc_with_reply_def sc_with_reply'_def
-  using sc_replies_relation_sc_with_reply_cross_eq_pred
-  by simp
-
-lemma sc_replies_relation_sc_with_reply_heap_path:
-  "\<lbrakk>sc_replies_relation s s'; sc_with_reply rp s = Some scp\<rbrakk>
-  \<Longrightarrow> heap_ls  (replyPrevs_of s') (scReplies_of s' scp) (the (sc_replies_of s scp))
-    \<and> rp \<in> set (the (sc_replies_of s scp))"
-  apply (clarsimp simp: sc_replies_relation_def dest!: sc_with_reply_SomeD)
-  apply (drule_tac x=scp and y="sc_replies sc" in spec2)
-  apply (clarsimp simp: vs_heap_simps)
-  apply (frule (1) heap_path_takeWhile_lookup_next)
-  by (metis (mono_tags) option.sel sc_replies.Some)
-
-lemma next_reply_in_sc_replies:
-  "\<lbrakk>sc_replies_relation s s'; sc_with_reply rp s = Some scp; sym_refs (list_refs_of_replies' s');
-    sym_refs (state_refs_of' s'); replyNexts_of s' rp = Some nrp;
-    pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'\<rbrakk>
-  \<Longrightarrow> \<exists>xs ys. sc_replies_of s scp = Some (xs @ nrp # rp # ys)"
-  apply (frule (1) sc_replies_relation_sc_with_reply_heap_path)
-  apply (prop_tac "replyPrevs_of s' nrp = Some rp")
-   apply (simp add: sym_refs_replyNext_replyPrev_sym[symmetric])
-  apply (drule sc_with_reply_SomeD, clarsimp)
-  apply (prop_tac "the (sc_replies_of s scp) = sc_replies sc")
-  using heap_ls_unique sc_replies_relation_prevs_list' apply blast
-  apply simp
-  apply (frule (3) heap_ls_prev_cases[OF _ _ _ reply_sym_heap_Prev_Next])
-  apply (drule (3) sym_refs_replySCs_of_None)
-   apply (rule replyNexts_Some_replySCs_None[where rp=rp], simp)
-  apply (clarsimp simp: vs_heap_simps opt_pred_def)
-  apply (drule (1) heap_ls_next_takeWhile_append[rotated -1])
-  apply (meson in_opt_map_eq)
-  by (force dest!: in_list_decompose_takeWhile)
-
-lemma prev_reply_in_sc_replies:
-  "\<lbrakk>sc_replies_relation s s'; sc_with_reply rp s = Some scp; sym_refs (list_refs_of_replies' s');
-    sym_refs (state_refs_of' s'); replyPrevs_of s' rp = Some nrp;
-    pspace_aligned' s'; pspace_distinct' s'; pspace_bounded' s'\<rbrakk>
-  \<Longrightarrow>\<exists>xs ys. sc_replies_of s scp = Some (xs @ rp # nrp # ys)"
-  apply (frule (1) sc_replies_relation_sc_with_reply_heap_path)
-  apply (prop_tac "replyNexts_of s' nrp = Some rp")
-   apply (simp add: sym_refs_replyNext_replyPrev_sym[symmetric])
-  apply (drule sc_with_reply_SomeD, clarsimp)
-  apply (prop_tac "the (sc_replies_of s scp) = sc_replies sc")
-  using heap_ls_unique sc_replies_relation_prevs_list' apply blast
-  apply simp
-  apply (frule (2) heap_ls_next_in_list)
-  apply (frule (3) sym_refs_replySCs_of_None[where rp=nrp])
-   apply (rule replyNexts_Some_replySCs_None, simp)
-  apply (drule_tac x=scp in spec)
-  apply (clarsimp simp: vs_heap_simps)
-  apply (frule (2) heap_ls_next_takeWhile_append[where p=rp])
-  apply (frule in_list_decompose_takeWhile[where x=nrp])
-  apply (frule in_list_decompose_takeWhile[where x=rp])
-  apply auto
-  done
-
-lemma sc_replies_middle_reply_sc_None:
-  "\<lbrakk>sym_refs (state_refs_of s); valid_replies s; sc_with_reply rp s = Some scp;
-    (sc_replies_of s |> hd_opt) scp \<noteq> Some rp; sc_at scp s; reply_at rp s\<rbrakk> \<Longrightarrow>
-   reply_sc_reply_at ((=) None) rp s"
-  supply subst_all[simp del]
-  apply (clarsimp simp: obj_at_def is_sc_obj_def is_reply)
-  apply (rename_tac ko n reply; case_tac ko; clarsimp)
-  apply (rename_tac sc n)
-  apply (drule sc_with_reply_SomeD1)
-  apply (clarsimp simp: vs_heap_simps opt_map_Some)
-  apply (case_tac "sc_replies sc"; simp)
-   apply (clarsimp simp: sc_replies_sc_at_def obj_at_def)
-  apply (rule ccontr)
-  apply (clarsimp simp: reply_sc_reply_at_def obj_at_def)
-  apply (case_tac "reply_sc reply"; simp)
-  apply (drule sym_refs_sc_replies_sc_at)
-   apply (fastforce simp: reply_sc_reply_at_def obj_at_def)
-  apply (rename_tac p)
-  apply clarsimp
-  apply (prop_tac "sc_replies_sc_at ((\<lambda>rs. rp \<in> set rs)) p s")
-   apply (clarsimp simp: sc_replies_sc_at_def obj_at_def)
-   apply (metis list.set_intros(1))
-  apply (drule valid_replies_sc_replies_unique)
-   apply fastforce
-  apply (prop_tac "scp=p")
-   apply blast
-  using sc_replies_sc_atE by fastforce
-
-lemma sc_with_reply_replyNext_Some:
-  " \<lbrakk>sc_replies_relation s s'; valid_objs s;
-     valid_objs' s'; pspace_relation (kheap s) (ksPSpace s');
-     valid_replies s; pspace_distinct s; pspace_aligned s;
-     sym_refs (state_refs_of' s');
-     sym_refs (list_refs_of_replies' s');
-     replyNexts_of s' rp = Some nxt_rp;
-     sc_with_reply rp s = Some scp\<rbrakk>
-    \<Longrightarrow> sc_with_reply nxt_rp s = Some scp"
-  apply (subgoal_tac "sc_with_reply' nxt_rp s' = Some scp")
-   apply (fastforce simp: sc_replies_relation_sc_with_reply_cross_eq)
-  apply (frule (1) sc_with_reply_Some_sc_at)
-  apply (frule (1) sc_with_reply_Some_reply_at)
-  apply (prop_tac "sc_with_reply' rp s' = Some scp \<and> reply_at' rp s' \<and> pspace_aligned' s' \<and> pspace_distinct' s'")
-   apply (fastforce simp: sc_replies_relation_sc_with_reply_cross_eq
-                   elim!: reply_at_cross pspace_distinct_cross pspace_aligned_cross)
-  apply (clarsimp simp: obj_at_def is_sc_obj is_reply)
-  apply (drule (1) sc_replies_relation_sc_with_reply_heap_path[rotated])
-  apply (prop_tac "the (sc_replies_of s scp) = sc_replies sc")
-   apply (clarsimp simp: sc_replies_of_scs_def scs_of_kh_def opt_map_def map_project_def)
-  apply clarsimp
-  apply (prop_tac "replyPrevs_of s' nxt_rp = Some rp")
-   apply (erule (1) sym_refs_replyNext_replyPrev_sym[THEN iffD1])
-  apply (prop_tac "\<exists>xs. heap_ls (replyPrevs_of s') (scReplies_of s' scp) xs \<and> nxt_rp \<in> set xs")
-   apply (rule_tac x="sc_replies sc" in exI)
-   apply (frule (2) heap_ls_prev_cases)
-    apply (erule reply_sym_heap_Prev_Next)
-   apply (erule disjE)
-    apply (frule pspace_relation_pspace_bounded')
-    apply (frule (3) sym_refs_scReplies, clarsimp simp: sym_heap_def)
-    apply (frule replySCs_Some_replyNexts_None[OF option.discI])
-    apply (drule (1) sym_refs_replyNext_None, clarsimp)
-   apply clarsimp
-  apply (clarsimp simp: sc_with_reply'_def the_pred_option_def the_equality split: if_split_asm)
-  apply (rule conjI)
-   apply blast
-  by (meson heap_ls_next_in_list)
-
-lemma sc_with_reply_replyPrev_None:
-  "\<lbrakk>sc_with_reply rp s = None; sc_replies_relation s s'; valid_objs' s';
-    pspace_relation (kheap s) (ksPSpace s');
-    pspace_distinct s; pspace_aligned s;
-    sym_refs (state_refs_of' s'); sym_refs (list_refs_of_replies' s');
-    replyPrevs_of s' rp = Some prv_rp\<rbrakk>
-  \<Longrightarrow> sc_with_reply prv_rp s = None"
-  apply (subgoal_tac "sc_with_reply' prv_rp s' = None")
-   apply (fastforce simp: sc_replies_relation_sc_with_reply_cross_eq)
-  apply (prop_tac "reply_at rp s")
-   apply (clarsimp simp: projectKOs elim!: opt_mapE)
-   apply (erule (1) pspace_dom_relatedE)
-   apply (erule (1) obj_relation_cutsE)
-         apply ((clarsimp simp: other_obj_relation_def is_reply obj_at_def
-                         split: Structures_A.kernel_object.split_asm if_split_asm
-                                ARM_A.arch_kernel_obj.split_asm)+)[7]
-  apply (prop_tac "sc_with_reply' rp s' = None \<and> reply_at' rp s' \<and> pspace_aligned' s' \<and> pspace_distinct' s'")
-   apply (fastforce simp: sc_replies_relation_sc_with_reply_cross_eq
-                   elim!: reply_at_cross pspace_distinct_cross pspace_aligned_cross)
-  apply clarsimp
-  apply (drule sc_with_reply'_NoneD)
-  apply (clarsimp simp: sc_with_reply'_def)
-  apply (rule the_pred_option_None)
-  apply (rule notI)
-  apply (erule FalseI)
-  apply (simp add: Ex1_def)
-  apply clarsimp
-  apply (rename_tac scp replies)
-  apply (frule (2) heap_ls_prev_cases)
-   apply (erule reply_sym_heap_Prev_Next)
-  apply (erule disjE)
-   apply (frule pspace_relation_pspace_bounded')
-   apply (frule (3) sym_refs_scReplies, clarsimp simp: sym_heap_def)
-   apply (frule replySCs_Some_replyNexts_None[OF option.discI])
-   apply (drule (1) sym_refs_replyNext_None, clarsimp)
-  by (meson heap_ls_prev_not_in)
-
-lemma sc_with_reply_replyNext_None:
-  "\<lbrakk>sc_with_reply rp s = None; sc_replies_relation s s'; valid_objs' s';
-    pspace_relation (kheap s) (ksPSpace s'); valid_replies s;
-    pspace_distinct s; pspace_aligned s;
-    sym_refs (state_refs_of' s'); sym_refs (list_refs_of_replies' s');
-    replyNexts_of s' rp = Some nxt_rp\<rbrakk>
-   \<Longrightarrow> sc_with_reply nxt_rp s = None"
-  apply (prop_tac "reply_at rp s")
-   apply (clarsimp simp: projectKOs elim!: opt_mapE)
-   apply (erule (1) pspace_dom_relatedE)
-   apply (erule (1) obj_relation_cutsE)
-         apply ((clarsimp simp: other_obj_relation_def is_reply obj_at_def
-                         split: Structures_A.kernel_object.split_asm if_split_asm
-                                ARM_A.arch_kernel_obj.split_asm)+)[7]
-  apply (prop_tac "pspace_aligned' s' \<and> pspace_distinct' s'")
-   apply (fastforce elim!: pspace_distinct_cross pspace_aligned_cross)
-  apply (rule ccontr)
-  apply (drule not_Some_eq[THEN iffD2])
-  apply (drule not_None_eq[THEN iffD1])
-  apply (drule not_ex[THEN iffD2])
-  apply (erule FalseI)
-  apply clarsimp
-  apply (rename_tac scp)
-  apply (rule_tac x=scp in exI)
-  apply (frule (1) sym_refs_replyNext_replyPrev_sym[THEN iffD1])
-  apply (frule pspace_relation_pspace_bounded')
-  apply (frule (7) prev_reply_in_sc_replies)
-  apply (drule sc_with_reply_SomeD)
-  apply (clarsimp simp: vs_heap_simps)
-  apply (rename_tac sc n)
-  apply (clarsimp simp: sc_with_reply_def' the_pred_option_def
-                 split: if_split_asm)
-  apply (simp add: conj_commute)
-  apply (rule context_conjI)
-   apply (drule valid_replies_sc_replies_unique[where r=rp])
-    apply (fastforce simp: sc_replies_sc_at_def obj_at_def)
-   apply simp
-  apply (clarsimp simp: the_equality)
-  apply (drule_tac x=x and y=scp in spec2)
-  apply (clarsimp simp: sc_replies_sc_at_def obj_at_def)
-  done
-
-(** end : sc_with_reply' **)
-
-(* sr_inv lemmas for reply_remove_tcb_corres *)
-
-lemma pspace_relation_reply_at:
-  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
-  assumes t: "ksPSpace s' p = Some (KOReply reply')"
-  shows "reply_at p s" using assms
-  apply -
-  apply (erule (1) pspace_dom_relatedE)
-  apply (erule (1) obj_relation_cutsE)
-  apply (clarsimp simp: other_obj_relation_def is_reply obj_at_def
-                 split: Structures_A.kernel_object.split_asm if_split_asm
-                        ARM_A.arch_kernel_obj.split_asm)+
-  done
-
-lemma next_is_not_head[simp]:
-  "isNext x \<Longrightarrow> \<not> isHead x"
-  by (clarsimp simp: isNext_def isHead_def split: option.splits reply_next.splits)
-
-lemma sc_replies_relation_sc_with_reply_None:
-  "\<lbrakk>sc_replies_relation s s'; reply_at rp s; replies_of' s' rp \<noteq> None;
-    sc_with_reply rp s = None; valid_replies s\<rbrakk>
-     \<Longrightarrow> sc_replies_relation s (s'\<lparr>ksPSpace := (ksPSpace s')(rp \<mapsto> KOReply r)\<rparr>)"
-  apply (clarsimp simp: sc_replies_relation_def)
-  apply (rename_tac scp replies)
-  apply (drule_tac x=scp and y=replies in spec2)
-  apply simp
-  apply (drule_tac sc=scp in valid_replies_sc_with_reply_None, simp)
-  apply (clarsimp simp: projectKOs obj_at'_def projectKO_opt_sc)
-  apply (rule conjI; rule impI)
-   apply (clarsimp simp: obj_at_def is_reply vs_heap_simps)
-  apply (erule heap_path_heap_upd_not_in)
-  by (clarsimp simp: sc_replies_sc_at_def obj_at_def vs_heap_simps)
-
-context begin interpretation Arch .
-
-lemma updateReply_sr_inv:
-  "\<lbrakk>\<forall>s s' r r'. (P and ko_at (kernel_object.Reply r) rp) s \<longrightarrow>
-                (P' and ko_at' r' rp) s' \<longrightarrow>
-                 reply_relation r r' \<longrightarrow> reply_relation r (f r');
-    \<forall>s s' reply'. pspace_relation (kheap s) (ksPSpace s') \<longrightarrow>
-                (P' and ko_at' reply' rp) s' \<longrightarrow>
-                (P and reply_at rp) s \<longrightarrow>
-                 sc_replies_relation s s' \<longrightarrow>
-                 sc_replies_relation s(s'\<lparr>ksPSpace := (ksPSpace s')(rp \<mapsto> KOReply (f reply'))\<rparr>)\<rbrakk>
-   \<Longrightarrow> sr_inv P P' (updateReply rp f)"
-  unfolding sr_inv_def updateReply_def setReply_def getReply_def
-  apply (clarsimp simp: setReply_def getReply_def getObject_def setObject_def projectKOs
-                        updateObject_default_def loadObject_default_def split_def
-                        in_monad return_def fail_def objBits_simps' in_magnitude_check
-                 split: if_split_asm option.split_asm dest!: readObject_misc_ko_at')
-  apply (rename_tac reply')
-  apply (prop_tac "ko_at' reply' rp s'")
-   apply (clarsimp simp: obj_at'_def objBits_simps' projectKOs)
-  apply (frule (1) pspace_relation_reply_at[OF state_relation_pspace_relation])
-  apply (clarsimp simp: obj_at_def is_reply)
-  apply (rename_tac reply)
-  apply (clarsimp simp: state_relation_def)
-  apply (rule conjI)
-   apply (frule (1) pspace_relation_absD)
-   apply (fastforce elim!: pspace_relation_reply_update_conc_only simp: obj_at'_def )
-  apply (clarsimp simp: caps_of_state_after_update cte_wp_at_after_update
-                        swp_def fun_upd_def obj_at_def map_to_ctes_upd_other
-              simp del: fun_upd_def)
-  done
-
-lemma updateReply_sr_inv_prev:
-  "sr_inv ((\<lambda>s. sc_with_reply rp s = None) and valid_replies)
-           (reply_at' rp) (updateReply rp (replyPrev_update (\<lambda>_. Nothing)))"
-  apply (rule updateReply_sr_inv)
-   apply (clarsimp simp: reply_relation_def)
-  by (fastforce elim!: sc_replies_relation_sc_with_reply_None
-                          [where r="replyPrev_update Map.empty reply'" for reply', simplified]
-                 simp: opt_map_red obj_at'_def projectKOs)
-
-lemma updateReply_sr_inv_next:
-  "sr_inv (P and (\<lambda>s. sc_with_reply rp s = None) and valid_replies
-           and (\<lambda>s. sym_refs (state_refs_of s)))
-           P' (updateReply rp (replyNext_update (\<lambda>_. Nothing)))"
-  unfolding updateReply_def sr_inv_def
-  apply (clarsimp simp: setReply_def getReply_def getObject_def setObject_def projectKOs
-                        updateObject_default_def loadObject_default_def split_def
-                        in_monad return_def fail_def objBits_simps' in_magnitude_check
-                 split: if_split_asm option.split_asm dest!: readObject_misc_ko_at')
-  apply (rename_tac reply')
-  apply (frule (1) pspace_relation_reply_at[OF state_relation_pspace_relation])
-  apply (clarsimp simp: obj_at_def is_reply obj_at'_def projectKOs)
-  apply (rename_tac reply)
-  apply (frule sc_with_reply_None_reply_sc_reply_at)
-     apply (clarsimp simp: obj_at_def is_reply)
-    apply simp+
-  apply (clarsimp simp: reply_sc_reply_at_def obj_at_def state_relation_def)
-  apply (rule conjI)
-   apply (frule (1) pspace_relation_absD)
-   apply clarsimp
-   apply (erule (2) pspace_relation_reply_update_conc_only)
-   apply (clarsimp simp: reply_relation_def)
-  apply (rule conjI)
-   apply (clarsimp simp: sc_replies_relation_def)
-   apply (drule_tac x=p and y=replies in spec2)
-   apply (clarsimp simp: vs_heap_simps projectKO_opt_reply projectKO_opt_sc)
-   apply (rule conjI; clarsimp)
-   apply (rename_tac sc n)
-   apply (drule_tac sc=p in valid_replies_sc_with_reply_None, simp)
-   apply (clarsimp simp: sc_replies_sc_at_def obj_at_def)
-   apply (erule (1) heap_path_heap_upd_not_in[where r=rp])
-  apply (clarsimp simp: caps_of_state_after_update cte_wp_at_after_update
-                        swp_def fun_upd_def obj_at_def map_to_ctes_upd_other
-              simp del: fun_upd_def)
-  done
-
-end
-
-lemma cleanReply_sr_inv:
-  "sr_inv (P and (\<lambda>s. sc_with_reply rp s = None) and valid_replies
-           and (\<lambda>s. sym_refs (state_refs_of s)))
-           P' (cleanReply rp)"
-  unfolding cleanReply_def
-  apply (rule sr_inv_bind[rotated])
-    apply (rule updateReply_sr_inv)
-     apply (clarsimp simp: reply_relation_def)
-    apply (fastforce elim!: sc_replies_relation_sc_with_reply_None
-                              [where r="replyPrev_update Map.empty reply'" for reply', simplified]
-                     simp: opt_map_red obj_at'_def projectKOs)
-   apply wpsimp
-  apply (clarsimp intro!: updateReply_sr_inv_next[simplified])
-  done
-
-(* replyRemoveTCB_corres specific wp rules *)
-
-lemma scReply_update_empty_sc_with_reply':
-  "\<lbrace>(\<lambda>s. sc_with_reply' rp s = Some scp) and ko_at' sc' scp
-    and (\<lambda>s. sym_refs (state_refs_of' s)) and reply_at' rp
-    and (\<lambda>s. sym_refs (list_refs_of_replies' s))
-    and K (scReply sc' = Some rp)
-    and pspace_aligned' and pspace_distinct'\<rbrace>
-   setSchedContext scp (scReply_update Map.empty sc')
-   \<lbrace>\<lambda>rv s. sc_with_reply' rp s = None\<rbrace>"
-  supply heap_path.simps[simp del]
-  apply (wpsimp wp: set_sc'.setObject_wp simp: setSchedContext_def)
-  apply (simp (no_asm) add: sc_with_reply'_def)
-  apply (simp add: the_pred_option_def split: if_split_asm)
-  apply (rule notI)
-  apply (clarsimp simp add: Ex1_def)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (clarsimp simp: projectKO_opt_reply)
-  apply (prop_tac "(replyPrevs_of s)(scp := None) = replyPrevs_of s")
-   apply (rule ext)
-   apply (clarsimp simp: opt_map_None opt_map_left_None set_reply'.not_sc)
-  apply (clarsimp simp: sc_with_reply'_def the_pred_option_def)
-  apply (split if_split_asm; simp)
-  apply (drule the1_equality)
-   apply blast
-  by simp
-
-(* another version of sc_replies_update_takeWhile_not_fst_replies_with_sc? *)
-lemma sc_replies_update_takeWhile_sc_with_reply:
-  "\<lbrace>(\<lambda>s. sc_with_reply rp s = Some scp) and valid_replies\<rbrace>
-    update_sched_context scp (sc_replies_update (takeWhile ((\<noteq>) rp)))
-   \<lbrace>\<lambda>rv s. sc_with_reply rp s = None\<rbrace>"
-   apply (wpsimp wp: set_object_wp hoare_vcg_all_lift get_object_wp
-               simp: update_sched_context_def)
-  apply (clarsimp dest!: sc_with_reply_SomeD1)
-  apply (prop_tac "\<exists>replies. sc_replies_sc_at (\<lambda>rs. rs = replies) scp s \<and> rp \<in> set replies")
-   apply (fastforce simp: sc_replies_sc_at_def obj_at_def)
-  apply (thin_tac "sc_replies_sc_at _ _ _")
-  apply (clarsimp simp: obj_at_def sc_replies_sc_at_def)
-  apply (clarsimp simp: sc_with_reply_def)
-  apply (prop_tac "\<not> rp \<in> set (takeWhile ((\<noteq>) rp) (sc_replies x))")
-   apply (metis (mono_tags, lifting) takeWhile_taken_P)
-  apply clarsimp
-  apply (clarsimp simp add: the_pred_option_def Ex1_def)
-  by (fastforce dest!: valid_replies_sc_replies_unique simp: obj_at_def sc_replies_sc_at_def)+
-
-lemma sc_replies_update_takeWhile_middle_sym_refs:
-  "\<lbrakk> hd (sc_replies sc) \<noteq> rp; rp \<in> set (sc_replies sc) \<rbrakk> \<Longrightarrow>
-   \<lbrace>\<lambda>s. P (state_refs_of s) \<and> obj_at (\<lambda>ko. \<exists>n. ko = kernel_object.SchedContext sc n) scp s\<rbrace>
-   update_sched_context scp (sc_replies_update (takeWhile ((\<noteq>) rp)))
-   \<lbrace>\<lambda>_ s. P (state_refs_of s)\<rbrace>"
-  apply (wpsimp wp: update_sched_context_state_refs_of)
-  apply (clarsimp simp: sc_replies_sc_at_def obj_at_def)
-  apply (prop_tac "takeWhile ((\<noteq>) rp) (sc_replies sc) \<noteq> []")
-   apply (prop_tac "sc_replies sc \<noteq> []")
-    apply (simp add: set_list_mem_nonempty)
-   apply (case_tac "sc_replies sc"; simp)
-  using hd_opt_append(1) takeWhile_dropWhile_id
-  by (metis (mono_tags) append.right_neutral)
-
-lemma updateReply_ko_at'_other:
-  "\<lbrace>K (p \<noteq> rp) and ko_at' ko p\<rbrace> updateReply rp f \<lbrace>\<lambda>_. ko_at' ko p\<rbrace>"
-  apply (wpsimp wp: updateReply_wp_all)
-  by (clarsimp simp: obj_at'_def projectKOs ps_clear_upd)
-
-lemma update_replyPrev_replyNexts_inv[wp]:
-  "updateReply rp (replyPrev_update prev) \<lbrace>\<lambda>s. P (replyNexts_of s)\<rbrace>"
-  unfolding updateReply_def supply fun_upd_apply[simp del]
-  apply wpsimp
-  by (metis ko_at'_replies_of' map_upd_triv opt_map_upd_Some)
-
-(* replyRemoveTCB_corres specific corres rules *)
-
-lemma setSchedContext_scReply_update_None_corres:
-  "corres dc ((\<lambda>s. (sc_replies_of s |> hd_opt) ptr = Some rp) and valid_objs and pspace_aligned and pspace_distinct)
-             \<top>
-          (update_sched_context ptr (sc_replies_update (takeWhile ((\<noteq>) rp))))
-         (do sc' \<leftarrow> getSchedContext ptr;
-             setSchedContext ptr (scReply_update Map.empty sc')
-          od)"
-  supply opt_mapE[elim!]
-  apply (rule_tac Q="sc_at' ptr" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD simp: obj_at_def is_sc_obj_def vs_heap_simps
-                    elim!: sc_at_cross valid_objs_valid_sched_context_size)
-  apply (rule corres_symb_exec_r)
-     apply (rule_tac P'="ko_at' sc' ptr" in corres_inst)
-     apply (rule_tac Q="sc_obj_at (objBits sc' - minSchedContextBits) ptr" in corres_cross_add_abs_guard)
-      apply (fastforce dest!: state_relationD ko_at_sc_cross)
-     apply (rule corres_guard_imp)
-       apply (rule_tac P="(\<lambda>s. (sc_replies_of s |> hd_opt) ptr = Some rp)
-                          and sc_obj_at (objBits sc' - minSchedContextBits) ptr"
-                  and n1="objBits sc' - minSchedContextBits"
-                            in monadic_rewrite_corres_l[OF update_sched_context_rewrite])
-       apply (rule corres_symb_exec_l)
-          apply (rule_tac P="(\<lambda>s. kheap s ptr = Some (kernel_object.SchedContext sc (objBits sc'
-                                                                                    - minSchedContextBits)))
-                              and K (rp = hd (sc_replies sc))"
-                      and P'="ko_at' sc' ptr"  in corres_inst)
-          apply (rule corres_gen_asm')
-          apply (rule corres_guard_imp)
-            apply (rule_tac sc=sc and sc'=sc' in setSchedContext_update_corres; simp?)
-             apply (clarsimp simp: sc_relation_def objBits_simps)+
-         apply (wpsimp wp: get_sched_context_exs_valid simp: is_sc_obj_def obj_at_def)
-          apply (rename_tac ko; case_tac ko; clarsimp)
-         apply simp
-        apply (wpsimp simp: obj_at_def is_sc_obj_def vs_heap_simps)
-       apply (wpsimp simp: obj_at_def is_sc_obj_def
-              | clarsimp split: Structures_A.kernel_object.splits)+
-  done
-
-lemma replyPrevNext_update_commute:
-  "replyPrev_update f (replyNext_update g reply)
-   = replyNext_update g (replyPrev_update f reply)"
-  by (cases reply; clarsimp)
-
-lemma updateReply_Prev_Next_rewrite:
-  "monadic_rewrite False True (reply_at' rp)
-    (do y <- updateReply rp (replyPrev_update f);
-         updateReply rp (replyNext_update g)
-     od)
-    (do y <- updateReply rp (replyNext_update g);
-         updateReply rp (replyPrev_update f)
-     od)"
-  apply (clarsimp simp: monadic_rewrite_def)
-  apply (rule monad_state_eqI)
-    apply (find_goal \<open>match conclusion in "_ = _" \<Rightarrow> -\<close>)
-    subgoal
-    apply (insert no_fail_updateReply, drule_tac x=rp and y="replyPrev_update f" in meta_spec2)
-    apply (insert no_fail_updateReply, drule_tac x=rp and y="replyNext_update g" in meta_spec2)
-    apply (rule; clarsimp simp: in_monad no_fail_def snd_bind split_def)
-     apply (drule (1) use_valid[OF _ updateReply.typ_at_lifts'(5)], fastforce)+
-    done
-   apply (all \<open>clarsimp simp: updateReply_def getReply_def setReply_def getObject_def2
-                              obj_at'_def projectKOs updateObject_default_def setObject_def
-                              loadObject_default_def2[simplified] ARM_H.fromPPtr_def
-                              split_def in_monad in_magnitude_check' objBits_simps'\<close>)
-   apply (fastforce simp add: fun_upd_def replyPrevNext_update_commute)+
-  done
-
-lemma reply_sc_update_sc_with_reply_None:
-  "set_reply_obj_ref reply_sc_update rp None \<lbrace>\<lambda>s. sc_with_reply rp s = None\<rbrace>"
-  apply (wpsimp wp: update_sk_obj_ref_wp)
-  apply (drule sc_with_reply_NoneD)
-  apply (simp add: sc_with_reply_def sc_replies_sc_at_def obj_at_def)
-  apply (rule the_pred_option_None)
-  by (metis Structures_A.kernel_object.simps(45) option.simps(1))
-
-lemma reply_sc_update_sc_with_reply_None_exs_valid:
-  "\<lbrakk> reply_at rp s; sc_with_reply rp s = None; valid_replies s;
-     sym_refs (state_refs_of s) \<rbrakk> \<Longrightarrow>
-   \<lbrace>(=) s\<rbrace> set_reply_obj_ref reply_sc_update rp None \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
-  apply (drule (3) sc_with_reply_None_reply_sc_reply_at)
-  apply (clarsimp simp: reply_sc_reply_at_def obj_at_def is_reply update_sk_obj_ref_def)
-  apply (simp add: exs_valid_def set_simple_ko_def get_object_def2 exec_gets bind_assoc
-                   set_object_def exec_get put_def return_def in_monad split_def bind_def
-                   get_simple_ko_def partial_inv_inj_Some)
-  apply (simp add: gets_def exec_get return_def partial_inv_def)
-  apply (simp add: get_def)
-  apply (drule sym[where s=None])
-  by (cases s; auto)
-
-(* cleanReply corres when rp is not in a reply stack *)
-lemma cleanReply_sc_with_reply_None_corres':
-  "corres dc (reply_at rp and pspace_aligned and pspace_distinct
-    and valid_replies and (\<lambda>s. sym_refs (state_refs_of s)) and (\<lambda>s. sc_with_reply rp s = None))
-    \<top>
-     (set_reply_obj_ref reply_sc_update rp None)
-     (cleanReply rp)"
-  apply (rule_tac Q="reply_at' rp" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD reply_at_cross)
-  apply (rule corres_guard_imp)
-  apply (rule corres_noop_sr2[OF reply_sc_update_sc_with_reply_None_exs_valid
-                                 cleanReply_sr_inv[where P="reply_at rp" and P'="reply_at' rp"]])
-  by wpsimp+
-
-(* cleanReply corres version 2:
-   we don't want sym_refs in the preconditions for replyRemoveTCB_corres
-   we can achieve that by unfolding cleanReply and not using cleanReply_sr_inv *)
-lemma cleanReply_sc_with_reply_None_corres:
-  "corres dc (reply_at rp and pspace_aligned and pspace_distinct
-    and valid_replies and (\<lambda>s. sc_with_reply rp s = None))
-    \<top>
-     (set_reply_obj_ref reply_sc_update rp None)
-     (cleanReply rp)"
-  apply (rule_tac Q="reply_at' rp" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD reply_at_cross)
-  apply (simp add: cleanReply_def bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule monadic_rewrite_corres_r[OF updateReply_Prev_Next_rewrite])
-    apply (rule corres_bind_return)
-    apply (rule corres_guard_imp)
-      apply (rule corres_split[OF updateReply_replyNext_not_head_corres])
-         apply (simp add: isHead_def)
-        apply (rule_tac P="reply_at rp and valid_replies and (\<lambda>s. sc_with_reply rp s = None)"
-                    and P'="reply_at' rp" in corres_noop_sr)
-          apply (rule sr_inv_imp)
-            apply (rule updateReply_sr_inv_prev[simplified])
-           apply (clarsimp simp: reply_relation_def)
-          apply simp
-         apply (wpsimp wp: reply_sc_update_sc_with_reply_None simp: isHead_def)+
-     apply simp+
-  done
-
-(* corres between update_sched_context and updateReply *)
-lemma updateReply_replyPrev_takeWhile_middle_corres:
-  assumes
-    "rp \<in> set (sc_replies sc)"
-    "hd (sc_replies sc) \<noteq> rp"
-  shows
-  "corres dc
-      (valid_objs and pspace_aligned and pspace_distinct and valid_replies
-        and  (\<lambda>s. sym_refs (state_refs_of s))
-        and (\<lambda>s. sc_with_reply rp s = Some scp)
-        and obj_at (\<lambda>ko. \<exists>n. ko = kernel_object.SchedContext sc n) scp
-        and reply_sc_reply_at ((=) None) rp)
-      (valid_objs' and (\<lambda>s'. replyNexts_of s' rp = Some nrp)
-        and (\<lambda>s. sym_refs (list_refs_of_replies' s)))
-      (update_sched_context scp (sc_replies_update (takeWhile ((\<noteq>) rp))))
-      (updateReply nrp (replyPrev_update Map.empty))"
-proof -
-  have z: "\<And>s x. reply_at' nrp s
-                 \<Longrightarrow> map_to_ctes ((ksPSpace s) (nrp \<mapsto> KOReply (replyPrev_update Map.empty x)))
-                     = map_to_ctes (ksPSpace s)"
-    by (clarsimp simp: obj_at_simps)
-  show ?thesis using assms
-    (* crossing information *)
-    apply (rule_tac Q="reply_at' rp and reply_at' nrp and sc_at' scp
-                      and pspace_distinct' and pspace_aligned'
-                      and  (\<lambda>s. sym_refs (state_refs_of' s))
-                      and (\<lambda>s'. sc_with_reply' rp s' = Some scp)" in corres_cross_add_guard)
-     apply clarsimp
-     apply (prop_tac "reply_at' rp s'")
-      apply (fastforce dest!: state_relationD intro!: reply_at_cross
-                        simp: reply_sc_reply_at_def obj_at_def is_reply)
-     apply (intro conjI, simp)
-           apply (fastforce dest!: valid_objs'_replyNexts_of_reply_at')
-          apply (fastforce dest!: state_relationD sc_at_cross elim: valid_objs_valid_sched_context_size
-                            simp: obj_at_def is_sc_obj)
-         apply (fastforce dest!: state_relationD pspace_distinct_cross)
-        apply (fastforce dest!: state_relationD pspace_aligned_cross)
-      apply (fastforce dest!: state_refs_of_cross_eq)
-     apply (fastforce dest: state_relationD simp: sc_replies_relation_sc_with_reply_cross_eq)
-    (* corres proof *)
-    apply (clarsimp simp: corres_underlying_def)
-    apply (rename_tac s s')
-    apply (rule conjI)
-     apply (clarsimp simp: update_sched_context_def updateReply_def getReply_def
-                           setReply_def getObject_def2 setObject_def in_monad ARM_H.fromPPtr_def
-                           get_object_def2 set_object_def bind_assoc loadObject_default_def2[simplified]
-                           scBits_simps split_def lookupAround2_known1 exec_gets a_type_def
-                           obj_at'_def projectKOs reply_sc_reply_at_def obj_at_def
-                           updateObject_default_def in_magnitude_check objBits_simps')
-     apply (clarsimp simp: get_def put_def bind_def)
-     apply (rename_tac reply' sc' nextr)
-     apply (prop_tac "reply_at' nrp s'")
-      apply (clarsimp simp: obj_at'_def projectKOs objBits_simps')
-     apply (prop_tac "reply_at nrp s")
-      apply (drule (1) valid_sched_context_objsI)
-      apply (clarsimp simp: valid_sched_context_def)
-      apply (frule pspace_relation_pspace_bounded'[OF state_relation_pspace_relation])
-      apply (frule_tac nrp=nrp in next_reply_in_sc_replies[where rp=rp, OF state_relation_sc_replies_relation])
-            apply (simp add: obj_at'_def projectKOs objBits_simps' opt_map_red)+
-      apply (clarsimp simp: vs_heap_simps)
-     apply (drule_tac x=nextr in z)
-     apply (clarsimp simp: state_relation_def obj_at_def is_reply obj_at'_def projectKOs)
-     apply (rule conjI)
-      (* pspace_relation *)
-      apply (simp only: pspace_relation_def simp_thms
-                        pspace_dom_update[where x="kernel_object.SchedContext _ _"
-                                            and v="kernel_object.SchedContext _ _",
-                                          simplified a_type_def, simplified])
-      apply (simp only: dom_fun_upd2 simp_thms)
-      apply (elim conjE)
-      apply (frule bspec, erule domI)
-      apply (frule_tac x=nrp in bspec, erule domI)
-      apply (rule ballI, drule (1) bspec)
-      apply (drule domD)
-      apply (prop_tac "scp \<noteq> nrp", clarsimp)
-      apply (clarsimp simp: project_inject split: if_split_asm kernel_object.split_asm)
-      apply (rule conjI; clarsimp)
-       apply (clarsimp simp: sc_relation_def)
-      apply (rename_tac bb aa ba)
-      apply (drule_tac x="(aa, ba)" in bspec, simp)
-      apply (clarsimp simp: obj_at_def is_reply)
-      apply (frule_tac ko'="kernel_object.Reply reply" and x'=nrp in obj_relation_cut_same_type)
-         apply simp+
-      apply (clarsimp simp: reply_relation_def)
-     apply (rule conjI)
-      (* sc_replies_relation *)
-      apply (clarsimp simp: projectKO_opt_sc opt_map_red)
-      apply (clarsimp simp: sc_replies_relation_def sc_replies_of_scs_def map_project_def scs_of_kh_def)
-      apply (drule_tac x=p in spec)
-      apply (intro conjI impI allI)
-      (* p =  scp *)
-       apply (clarsimp simp: opt_map_red)
-       apply (prop_tac "replyPrevs_of s' nrp = Some rp")
-        apply (simp add: sym_refs_replyNext_replyPrev_sym[symmetric])
-        apply (clarsimp simp: opt_map_red)
-       apply (prop_tac "scReply sc' \<noteq> Some rp")
-        apply (drule heap_path_head; clarsimp)
-       apply (frule (4) heap_ls_next_takeWhile_append_sym[OF _ _ _ _ reply_sym_heap_Prev_Next])
-       apply simp
-       apply (rule heap_path_heap_upd_not_in[rotated])
-        using set_takeWhileD apply (metis (full_types))
-       apply (erule heap_path_takeWhile_lookup_next)
-       apply (prop_tac "nrp \<in> set (takeWhile ((\<noteq>) rp) (sc_replies sc))")
-        apply clarsimp
-       using set_takeWhileD apply metis
-      (* p \<noteq> scp *)
-      apply (rule heap_path_heap_upd_not_in)
-       apply clarsimp
-      apply (clarsimp simp: opt_map_Some)
-      apply (prop_tac "replyPrevs_of s' nrp = Some rp")
-       apply (simp add: sym_refs_replyNext_replyPrev_sym[symmetric])
-       apply (clarsimp simp: opt_map_red)
-      apply (frule (2) heap_ls_next_in_list)
-      apply (simp add: sc_with_reply_def the_pred_option_def
-                split: if_split_asm)
-      apply blast
-      apply (clarsimp simp add: ghost_relation_def)
-      apply (erule_tac x=scp in allE)+
-      apply (clarsimp simp: obj_at_def a_type_def
-                     split: Structures_A.kernel_object.splits if_split_asm)
-     apply (clarsimp simp: caps_of_state_after_update cte_wp_at_after_update
-                           swp_def fun_upd_def obj_at_simps)
-  by (erule no_failD[OF no_fail_updateReply])
-qed
-
-(* end : related corres rules *)
-
-end
diff --git a/proof/refine/ARM/Retype_R.thy b/proof/refine/ARM/Retype_R.thy
index f19da22b7c..523fb20092 100644
--- a/proof/refine/ARM/Retype_R.thy
+++ b/proof/refine/ARM/Retype_R.thy
@@ -12,19 +12,17 @@ theory Retype_R
 imports VSpace_R
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 definition
   APIType_map2 :: "kernel_object + ARM_H.object_type \<Rightarrow> Structures_A.apiobject_type"
 where
  "APIType_map2 ty \<equiv> case ty of
-      Inr (APIObjectType Untyped) \<Rightarrow> Structures_A.Untyped
-    | Inr (APIObjectType TCBObject) \<Rightarrow> Structures_A.TCBObject
-    | Inr (APIObjectType EndpointObject) \<Rightarrow> Structures_A.EndpointObject
-    | Inr (APIObjectType NotificationObject) \<Rightarrow> Structures_A.NotificationObject
-    | Inr (APIObjectType CapTableObject) \<Rightarrow> Structures_A.CapTableObject
-    | Inr (APIObjectType ReplyObject) \<Rightarrow> Structures_A.ReplyObject
-    | Inr (APIObjectType SchedContextObject) \<Rightarrow> Structures_A.SchedContextObject
+      Inr (APIObjectType ArchTypes_H.Untyped) \<Rightarrow> Structures_A.Untyped
+    | Inr (APIObjectType ArchTypes_H.TCBObject) \<Rightarrow> Structures_A.TCBObject
+    | Inr (APIObjectType ArchTypes_H.EndpointObject) \<Rightarrow> Structures_A.EndpointObject
+    | Inr (APIObjectType ArchTypes_H.NotificationObject) \<Rightarrow> Structures_A.NotificationObject
+    | Inr (APIObjectType ArchTypes_H.CapTableObject) \<Rightarrow> Structures_A.CapTableObject
     | Inr PageTableObject \<Rightarrow> ArchObject PageTableObj
     | Inr PageDirectoryObject \<Rightarrow> ArchObject PageDirectoryObj
     | Inr LargePageObject \<Rightarrow> ArchObject LargePageObj
@@ -56,17 +54,20 @@ lemma createObjects_ret:
                         shiftl_t2n power_add)
   done
 
+lemma objBitsKO_bounded2[simp]:
+  "objBitsKO ko < word_bits"
+  by (simp add: objBits_simps' word_bits_def pageBits_def archObjSize_def pdeBits_def pteBits_def
+           split: Structures_H.kernel_object.split arch_kernel_object.split)
+
 definition
   APIType_capBits :: "ARM_H.object_type \<Rightarrow> nat \<Rightarrow> nat"
 where
   "APIType_capBits ty us \<equiv> case ty of
-      APIObjectType Untyped \<Rightarrow> us
-    | APIObjectType TCBObject \<Rightarrow> objBits (makeObject :: tcb)
-    | APIObjectType EndpointObject \<Rightarrow> objBits (makeObject :: endpoint)
-    | APIObjectType NotificationObject \<Rightarrow> objBits (makeObject :: notification)
-    | APIObjectType ReplyObject \<Rightarrow> objBits (makeObject :: reply)
-    | APIObjectType CapTableObject \<Rightarrow> objBits (makeObject :: cte) + us
-    | APIObjectType SchedContextObject \<Rightarrow> us
+      APIObjectType ArchTypes_H.Untyped \<Rightarrow> us
+    | APIObjectType ArchTypes_H.TCBObject \<Rightarrow> objBits (makeObject :: tcb)
+    | APIObjectType ArchTypes_H.EndpointObject \<Rightarrow> objBits (makeObject :: endpoint)
+    | APIObjectType ArchTypes_H.NotificationObject \<Rightarrow> objBits (makeObject :: Structures_H.notification)
+    | APIObjectType ArchTypes_H.CapTableObject \<Rightarrow> objBits (makeObject :: cte) + us
     | SmallPageObject \<Rightarrow> pageBitsForSize ARMSmallPage
     | LargePageObject \<Rightarrow> pageBitsForSize ARMLargePage
     | SectionObject \<Rightarrow> pageBitsForSize ARMSection
@@ -75,20 +76,15 @@ where
     | PageDirectoryObject \<Rightarrow> 14"
 
 definition
-  makeObjectKO :: "bool \<Rightarrow> nat \<Rightarrow> domain \<Rightarrow> (kernel_object + ARM_H.object_type) \<rightharpoonup> kernel_object"
+  makeObjectKO :: "bool \<Rightarrow> (kernel_object + ARM_H.object_type) \<rightharpoonup> kernel_object"
 where
-  "makeObjectKO dev us d ty \<equiv> case ty of
+  "makeObjectKO dev ty \<equiv> case ty of
       Inl KOUserData \<Rightarrow> Some KOUserData
     | Inl (KOArch (KOASIDPool _)) \<Rightarrow> Some (KOArch (KOASIDPool makeObject))
-    | Inr (APIObjectType ArchTypes_H.TCBObject) \<Rightarrow> Some (KOTCB (tcbDomain_update (\<lambda>_. d) makeObject))
+    | Inr (APIObjectType ArchTypes_H.TCBObject) \<Rightarrow> Some (KOTCB 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)
-    | Inr (APIObjectType ArchTypes_H.ReplyObject) \<Rightarrow> Some (KOReply makeObject)
-    | Inr (APIObjectType ArchTypes_H.SchedContextObject) \<Rightarrow>
-            Some (KOSchedContext ((makeObject :: sched_context)
-                                     \<lparr>scRefills := replicate (refillAbsoluteMax' us) emptyRefill,
-                                      scSize := us - minSchedContextBits\<rparr>))
     | Inr PageTableObject \<Rightarrow> Some (KOArch (KOPTE makeObject))
     | Inr PageDirectoryObject \<Rightarrow> Some (KOArch (KOPDE makeObject))
     | Inr SmallPageObject \<Rightarrow> Some (if dev then KOUserDataDevice else KOUserData)
@@ -112,12 +108,6 @@ lemma valid_obj_makeObject_tcb [simp]:
   unfolding valid_obj'_def valid_tcb'_def  valid_tcb_state'_def
   by (clarsimp simp: makeObject_tcb makeObject_cte tcb_cte_cases_def minBound_word)
 
-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
-  by (clarsimp simp: makeObject_tcb makeObject_cte
-                     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
@@ -128,29 +118,6 @@ lemma valid_obj_makeObject_notification [simp]:
   unfolding valid_obj'_def valid_ntfn'_def
   by (clarsimp simp: makeObject_notification)
 
-lemma valid_obj_makeObject_reply [simp]:
-  "valid_obj' (KOReply makeObject) s"
-  unfolding valid_obj'_def valid_reply'_def
-  by (clarsimp simp: makeObject_reply)
-
-lemma valid_sc_size'_makeObject_sc':
-  "sc_size_bounds us \<Longrightarrow>
-     valid_sched_context_size'
-       ((makeObject :: sched_context)\<lparr>scRefills := replicate (refillAbsoluteMax' us) emptyRefill,
-                                      scSize := us - minSchedContextBits\<rparr>)"
-  by (clarsimp simp: makeObject_sc valid_sched_context_size'_def scBits_simps
-                     objBits_def objBitsKO_def)
-
-lemma valid_obj_makeObject_sched_context [simp]:
-  "sc_size_bounds us \<Longrightarrow>
-     valid_obj' (KOSchedContext ((makeObject :: sched_context)
-                                    \<lparr>scRefills := replicate (refillAbsoluteMax' us) emptyRefill,
-                                     scSize := us - minSchedContextBits\<rparr>)) s"
-  unfolding valid_obj'_def valid_sched_context'_def
-  using sc_size_bounds_def
-  by (clarsimp simp: valid_sc_size'_makeObject_sc')
-     (clarsimp simp: makeObject_sc)
-
 lemma valid_obj_makeObject_user_data [simp]:
   "valid_obj' (KOUserData) s"
   unfolding valid_obj'_def by simp
@@ -175,7 +142,6 @@ lemma valid_obj_makeObject_asid_pool[simp]:
 lemmas valid_obj_makeObject_rules =
   valid_obj_makeObject_user_data valid_obj_makeObject_tcb
   valid_obj_makeObject_endpoint valid_obj_makeObject_notification
-  valid_obj_makeObject_reply valid_obj_makeObject_sched_context
   valid_obj_makeObject_cte valid_obj_makeObject_pte valid_obj_makeObject_pde
   valid_obj_makeObject_asid_pool valid_obj_makeObject_user_data_device
 
@@ -330,14 +296,14 @@ lemma cte_at_next_slot'':
 
 
 lemma state_relation_null_filterE:
-  "\<lbrakk> (s, s') \<in> state_relation; t = kheap_update f s;
+  "\<lbrakk> (s, s') \<in> state_relation; t = kheap_update f (ekheap_update ef s);
      \<exists>f' g' h'.
      t' = s'\<lparr>ksPSpace := f' (ksPSpace s'), gsUserPages := g' (gsUserPages s'),
              gsCNodes := h' (gsCNodes s')\<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');
-     sc_replies_relation t t';
+     ekheap_relation (ekheap t) (ksPSpace t'); ready_queues_relation t t';
      ghost_relation (kheap t) (gsUserPages t') (gsCNodes t'); valid_list s;
      pspace_aligned' s'; pspace_distinct' s'; valid_objs s; valid_mdb s;
      pspace_aligned' t'; pspace_distinct' t';
@@ -355,11 +321,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 s"  and
+     apply (cut_tac s="kheap_update f (ekheap_update ef s)"  and
                     s'="s'\<lparr>ksPSpace := f' (ksPSpace s'),
                            gsUserPages := g' (gsUserPages s'),
                            gsCNodes := h' (gsCNodes s')\<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)
@@ -430,7 +397,7 @@ lemma foldr_update_ko_wp_at':
   assumes 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)"
-      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)" "objBitsKO obj < word_bits"
+      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)"
    shows
   "ko_wp_at' P p (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)
          = (if p \<in> set addrs then P obj
@@ -453,7 +420,7 @@ lemma foldr_update_obj_at':
   assumes 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)"
-      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)" "objBitsKO obj < word_bits"
+      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)"
    shows
   "obj_at' P p (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)
          = (if p \<in> set addrs then (\<exists>obj'. projectKO_opt obj = Some obj' \<and> P obj')
@@ -463,12 +430,12 @@ lemma foldr_update_obj_at':
   done
 
 lemma makeObjectKO_eq:
-  assumes x: "makeObjectKO dev us d tp = Some v"
+  assumes x: "makeObjectKO dev 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 = (tcbDomain_update (\<lambda>_. d) makeObject))"
+       (tp = Inr (APIObjectType ArchTypes_H.TCBObject) \<and> tcb = makeObject)"
   using x
   by (simp add: makeObjectKO_def eq_commute
          split: apiobject_type.split_asm sum.split_asm kernel_object.split_asm
@@ -523,11 +490,11 @@ lemma ps_clearD:
   done
 
 lemma cte_wp_at_retype':
-  assumes ko: "makeObjectKO dev us d tp = Some obj"
+  assumes ko: "makeObjectKO dev 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)"
-      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)""objBitsKO obj < word_bits"
+      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)"
       and pn: "\<forall>x \<in> set addrs. ksPSpace s x = None"
    shows
   "cte_wp_at' P p (ksPSpace_update (\<lambda>x xa. if xa \<in> set addrs then Some obj else ksPSpace s xa) s)
@@ -544,14 +511,13 @@ lemma cte_wp_at_retype':
      apply (simp only: cte_wp_at_obj_cases_mask foldr_update_obj_at'[OF pv pv' al])
      apply (simp    add: projectKOs the_ctes_makeObject
                          makeObjectKO_eq [OF ko]
-                         makeObject_cte
+                         makeObject_cte dom_def
               split del: if_split
                    cong: if_cong)
      apply (insert al ko)
-     apply simp
-     apply (safe; simp)
-              apply ((fastforce simp: makeObjectKO_def makeObject_cte makeObject_tcb tcb_cte_cases_def
-                              split: if_split_asm)+)[10]
+     apply (simp, safe, simp_all)
+      apply fastforce
+     apply fastforce
     apply (clarsimp elim!: obj_atE' simp: projectKOs objBits_simps)
     apply (drule ps_clearD[where y=p and n=tcbBlockSizeBits])
        apply simp
@@ -563,11 +529,11 @@ lemma cte_wp_at_retype':
   done
 
 lemma ctes_of_retype:
-  assumes ko: "makeObjectKO dev us d tp = Some obj"
+  assumes ko: "makeObjectKO dev 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)"
-      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)" "objBitsKO obj < word_bits"
+      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)"
       and pn: "\<forall>x \<in> set addrs. ksPSpace s x = None"
    shows
   "map_to_ctes (\<lambda> xa. if xa \<in> set addrs then Some obj else ksPSpace s xa)
@@ -592,11 +558,11 @@ lemma None_ctes_of_cte_at:
   by (fastforce simp add: cte_wp_at_ctes_of)
 
 lemma null_filter_ctes_retype:
-  assumes ko: "makeObjectKO dev us d tp = Some obj"
+  assumes ko: "makeObjectKO dev 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)"
-      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)" "objBitsKO obj < word_bits"
+      and al: "\<forall>x \<in> set addrs. is_aligned x (objBitsKO obj)"
       and pn: "\<forall>x \<in> set addrs. ksPSpace s x = None"
   shows
   "null_filter' (map_to_ctes (foldr (\<lambda>addr. data_map_insert addr obj) addrs (ksPSpace s)))
@@ -623,12 +589,11 @@ 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 (tcbDomain_update (\<lambda>_. d) makeObject)
-                                        else KOCTE cte"
+          erule_tac v="if x \<in> set addrs then KOTCB makeObject else KOCTE cte"
                 in tcb_space_clear)
        apply (simp add: is_aligned_mask word_bw_assocs)
       apply assumption
-     apply fastforce
+     apply simp
     apply simp
    apply (simp add: pn)
   apply (clarsimp simp: makeObjectKO_def)
@@ -743,14 +708,7 @@ lemma APIType_map2_Untyped[simp]:
   "(APIType_map2 tp = Structures_A.Untyped)
         = (tp = Inr (APIObjectType ArchTypes_H.Untyped))"
  by (simp add: APIType_map2_def
-        split: sum.split object_type.split kernel_object.split arch_kernel_object.splits
-                apiobject_type.split)
-
-lemma APIType_map2_SchedContext[simp]:
-  "(APIType_map2 tp = Structures_A.SchedContextObject)
-        = (tp = Inr (APIObjectType SchedContextObject))"
- by (simp add: APIType_map2_def
-        split: sum.split object_type.split kernel_object.split arch_kernel_object.splits
+         split: sum.split object_type.split kernel_object.split arch_kernel_object.splits
                 apiobject_type.split)
 
 lemma obj_relation_retype_leD:
@@ -759,14 +717,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 d) ko;
-       ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped);
-       ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us \<rbrakk>
+  "\<lbrakk> obj_relation_retype (default_object (APIType_map2 ty) dev us) ko;
+       ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped) \<rbrakk>
       \<Longrightarrow> objBitsKO ko \<le> obj_bits_api (APIType_map2 ty) us"
-  by (clarsimp simp: obj_relation_retype_def objBits_def obj_bits_dev_irr)
+  by (simp add: obj_relation_retype_def objBits_def obj_bits_dev_irr)
 
 lemma makeObjectKO_Untyped:
-  "makeObjectKO dev us d ty = Some v \<Longrightarrow> ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped)"
+  "makeObjectKO dev ty = Some v \<Longrightarrow> ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped)"
   by (clarsimp simp: makeObjectKO_def)
 
 lemma obj_relation_cuts_trivial:
@@ -789,23 +746,22 @@ lemma obj_relation_cuts_trivial:
 
 lemma obj_relation_retype_addrs_eq:
   assumes not_unt:"ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped)"
-  assumes tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
   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 d) ko"
+  assumes  orr: "obj_relation_retype (default_object (APIType_map2 ty) dev us) 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 d) x)
+            fst ` obj_relation_cuts (default_object (APIType_map2 ty) dev us) x)
       = set (new_cap_addrs m ptr ko)"
   apply (rule set_eqI, rule iffI)
    apply (clarsimp simp: retype_addrs_def)
    apply (rename_tac p a b)
    apply (drule obj_relation_retype_cutsD[OF _ orr])
-   apply (cut_tac obj_relation_retype_default_leD[OF orr not_unt tysc])
+   apply (cut_tac obj_relation_retype_default_leD[OF orr not_unt])
    apply (clarsimp simp: new_cap_addrs_def image_def
                   dest!: less_two_pow_divD)
    apply (rule_tac x="p * 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) + unat y"
                  in rev_bexI)
-    apply (simp add: amp obj_bits_api_default_object not_unt tysc obj_bits_dev_irr)
+    apply (simp add: amp obj_bits_api_default_object not_unt obj_bits_dev_irr)
     apply (rule less_le_trans[OF nat_add_left_cancel_less[THEN iffD2]])
     apply (erule unat_mono)
       apply (subst unat_power_lower)
@@ -821,7 +777,7 @@ lemma obj_relation_retype_addrs_eq:
   apply (clarsimp simp: new_cap_addrs_def retype_addrs_def
                  dest!: less_two_pow_divD)
   apply (rename_tac p)
-  apply (cut_tac obj_relation_retype_default_leD[OF orr not_unt tysc])
+  apply (cut_tac obj_relation_retype_default_leD[OF orr not_unt])
   apply (cut_tac obj_relation_retype_leD[OF orr])
   apply (case_tac "n = 0")
    apply (simp add:amp)
@@ -850,20 +806,18 @@ lemma obj_relation_retype_addrs_eq:
    apply (rule power_strict_increasing)
    apply (rule le_less_trans[OF diff_le_self])
   apply (clarsimp simp: range_cover_def obj_bits_api_default_object obj_bits_dev_irr
-                        not_unt word_bits_def tysc)+
-  done
+                        not_unt word_bits_def)+
+done
 
 lemma objBits_le_obj_bits_api:
-  "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us \<Longrightarrow>
-   makeObjectKO dev us d ty = Some ko \<Longrightarrow>
+  "makeObjectKO dev ty = Some ko \<Longrightarrow>
    objBitsKO ko \<le> obj_bits_api (APIType_map2 ty) us"
   apply (case_tac ty)
-    by (auto simp: default_arch_object_def pageBits_def archObjSize_def pteBits_def pdeBits_def
-                   makeObjectKO_def objBits_simps' APIType_map2_def obj_bits_api_def slot_bits_def
-                   scBits_simps
-            split: Structures_H.kernel_object.splits arch_kernel_object.splits object_type.splits
-                   Structures_H.kernel_object.splits arch_kernel_object.splits apiobject_type.splits
-                   if_split_asm)
+    apply (auto simp: default_arch_object_def pageBits_def archObjSize_def pteBits_def pdeBits_def
+                      makeObjectKO_def objBits_simps' APIType_map2_def obj_bits_api_def slot_bits_def
+               split: Structures_H.kernel_object.splits arch_kernel_object.splits object_type.splits
+                      Structures_H.kernel_object.splits arch_kernel_object.splits apiobject_type.splits)
+  done
 
 lemma obj_relation_retype_other_obj:
   "\<lbrakk> is_other_obj_relation_type (a_type ko); other_obj_relation ko ko' \<rbrakk>
@@ -878,68 +832,18 @@ lemma obj_relation_retype_other_obj:
                          arch_kernel_obj.split_asm arch_kernel_object.split)
   done
 
-lemma retype_kheap_dom_same:
-  assumes pn: "pspace_no_overlap_range_cover ptr sz s"
-  and    vs: "valid_pspace s" "valid_mdb s"
-  and cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
-  shows
-  "kheap s x = Some v \<Longrightarrow>
-     (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)) x = Some v"
-proof -
-  have dom_not_ra:
-    "\<forall>x \<in> dom (kheap s). x \<notin> set (retype_addrs ptr (APIType_map2 ty) n us)"
-    apply clarsimp
-    apply (erule(1) pspace_no_overlapC[OF pn _ _ cover vs(1)])
-    done
-  assume H: "kheap s x = Some v"
-  thus ?thesis
-    apply -
-    apply (frule bspec [OF dom_not_ra, OF domI])
-    apply (simp add: foldr_upd_app_if)
-    done
-qed
-
-lemma retype_ksPSpace_dom_same:
-  fixes x v
-  assumes vs': "pspace_aligned' s'" "pspace_distinct' s'"
-  and   pn': "pspace_no_overlap' ptr sz s'"
-  and    ko: "makeObjectKO dev us d ty = Some ko"
-  and  tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
-  and cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
-  and num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
-  shows
-  "ksPSpace s' x = Some v \<Longrightarrow>
-    foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s') x
-      = Some v"
-proof -
-  have cover':"range_cover ptr sz (objBitsKO ko) m"
-    by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF tysc ko] num_r])
-  assume "ksPSpace s' x = Some v"
-  thus ?thesis
-    apply (clarsimp simp:foldr_upd_app_if[folded data_map_insert_def])
-    apply (drule domI[where m = "ksPSpace s'"])
-    apply (drule(1) IntI)
-    apply (erule_tac A = "A \<inter> B" for A B in in_emptyE[rotated])
-    apply (rule disjoint_subset[OF new_cap_addrs_subset[OF cover']])
-    apply (clarsimp simp:ptr_add_def field_simps)
-    apply (rule pspace_no_overlap_disjoint'[OF vs'(1) pn'])
-    done
-qed
-
 lemma retype_pspace_relation:
   assumes  sr: "pspace_relation (kheap s) (ksPSpace s')"
       and  vs: "valid_pspace s" "valid_mdb 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 us d ty = Some ko"
-      and tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
+      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 d) ko"
+      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
-  "pspace_relation (foldr (\<lambda>p ps. ps(p \<mapsto> default_object (APIType_map2 ty) dev us d))
+  "pspace_relation (foldr (\<lambda>p ps. ps(p \<mapsto> default_object (APIType_map2 ty) dev us))
                               (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'")
@@ -958,7 +862,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 d"]
+  note pdom = pspace_dom_upd [OF dom_Int_ra, where ko="default_object (APIType_map2 ty) dev us"]
 
   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]
@@ -973,12 +877,26 @@ proof
   thus "pspace_dom ?ps = dom ?ps'"
     apply (simp add: pdom pdom')
     apply (rule arg_cong[where f="\<lambda>T. S \<union> T" for S])
-    apply (rule obj_relation_retype_addrs_eq[OF not_unt tysc num_r orr cover])
+    apply (rule obj_relation_retype_addrs_eq[OF not_unt num_r orr cover])
     done
 
-  note dom_same = retype_kheap_dom_same[OF pn vs cover]
-
-  note dom_same' = retype_ksPSpace_dom_same[OF vs' pn' ko tysc cover num_r]
+  have dom_same:
+    "\<And>x v. kheap s x = Some v \<Longrightarrow> ?ps x = Some v"
+    apply (frule bspec [OF dom_not_ra, OF domI])
+    apply (simp add: foldr_upd_app_if)
+    done
+  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])
+  have dom_same':
+    "\<And>x v. ksPSpace s' x = Some v \<Longrightarrow> ?ps' x = Some v"
+    apply (clarsimp simp:foldr_upd_app_if[folded data_map_insert_def])
+    apply (drule domI[where m = "ksPSpace s'"])
+    apply (drule(1) IntI)
+    apply (erule_tac A = "A \<inter> B" for A B in in_emptyE[rotated])
+    apply (rule disjoint_subset[OF new_cap_addrs_subset[OF cover']])
+    apply (clarsimp simp:ptr_add_def field_simps)
+    apply (rule pspace_no_overlap_disjoint'[OF vs'(1) pn'])
+  done
 
   show "\<forall>x \<in> dom ?ps. \<forall>(y, P) \<in> obj_relation_cuts (the (?ps x)) x.
                    P (the (?ps x)) (the (?ps' y))"
@@ -989,7 +907,7 @@ proof
      apply (rule conjI)
       apply (drule obj_relation_retype_cutsD [OF _ orr], clarsimp)
      apply (rule impI, erule notE)
-     apply (simp add: obj_relation_retype_addrs_eq[OF not_unt tysc num_r orr cover,symmetric])
+     apply (simp add: obj_relation_retype_addrs_eq[OF not_unt num_r orr cover,symmetric])
      apply (erule rev_bexI)
      apply (simp add: image_def)
      apply (erule rev_bexI, simp)
@@ -1016,6 +934,79 @@ 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 ARM_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 add: 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 ARM_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} = {}"
@@ -1080,14 +1071,11 @@ qed
 
 lemma retype_aligned_distinct':
   assumes vs': "pspace_aligned' s'" "pspace_distinct' s'"
-      and bd : "pspace_bounded' s'"
       and pn': "pspace_no_overlap' ptr sz s'"
       and cover: "range_cover ptr sz (objBitsKO ko) n "
   shows
   "pspace_distinct' (s' \<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr ko)
                                              (new_cap_addrs n ptr ko) (ksPSpace s')\<rparr>)"
-  "pspace_bounded' (s' \<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr ko)
-                                             (new_cap_addrs n ptr ko) (ksPSpace s')\<rparr>)"
   "pspace_aligned' (s' \<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr ko)
                                              (new_cap_addrs n ptr ko) (ksPSpace s')\<rparr>)"
   (is "pspace_aligned' (s'\<lparr>ksPSpace := ?ps\<rparr>)")
@@ -1106,6 +1094,9 @@ proof -
     apply (drule bspec, erule domI, simp)
     done
 
+  have okov: "objBitsKO ko < word_bits"
+    by (simp add: objBits_def)
+
   have new_range_disjoint:
     "\<And>x. x \<in> set (new_cap_addrs n ptr ko) \<Longrightarrow>
          ({x .. x + 2 ^ (objBitsKO ko) - 1} - {x}) \<inter> set (new_cap_addrs n ptr ko) = {}"
@@ -1142,15 +1133,6 @@ proof -
     apply (rule disjoint_subset[OF Diff_subset])
     apply (erule pspace_no_overlapD' [OF _ pn'])
     done
-
-  show bd': "pspace_bounded' ?s'" using bd
-    apply (subst foldr_upd_app_if[folded data_map_insert_def])
-    apply (clarsimp simp: pspace_bounded'_def split: if_split_asm)
-    using cover
-     apply (simp add: range_cover_def word_bits_def)
-    apply (drule bspec, erule domI, simp)
-    done
-
 qed
 
 definition
@@ -1181,7 +1163,7 @@ end
 global_interpretation update_gs: PSpace_update_eq "update_gs ty us ptrs"
   by (simp add: PSpace_update_eq_def)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma ksReadyQueues_update_gs[simp]:
   "ksReadyQueues (update_gs tp us addrs s) = ksReadyQueues s"
@@ -1207,173 +1189,188 @@ lemma update_gs_simps[simp]:
                                else ups x)"
   by (simp_all add: update_gs_def)
 
-lemma retype_obj_at'_not:
-  assumes ad: "pspace_aligned' s" "pspace_distinct' s"
-  and     pn: "pspace_no_overlap' ptr sz s"
-  and  cover: "range_cover ptr sz (objBitsKO val + gbits) n"
-  shows "\<And>P x. x \<in> set (new_cap_addrs (2 ^ gbits * n) ptr val) \<Longrightarrow> \<not> obj_at' P x s"
+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 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
+    "ksPSpace s' x = Some v \<Longrightarrow>
+     foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s') x
+      = Some v"
 proof -
-  note cover' = range_cover_rel[where sbit' = "objBitsKO val",OF cover _ refl,simplified]
-  show "\<And>P x. x \<in> set (new_cap_addrs (2 ^ gbits * n) ptr val) \<Longrightarrow> \<not> obj_at' P x s"
-    apply (clarsimp simp: obj_at'_def)
-    apply (drule subsetD [OF new_cap_addrs_subset [OF cover' ]])
-    apply (insert pspace_no_overlap_disjoint' [OF ad(1) pn])
-    apply (drule domI[where m = "ksPSpace s"])
-    apply (drule(1) orthD2)
-    apply (clarsimp simp:ptr_add_def p_assoc_help)
+  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])
+  assume "ksPSpace s' x = Some v"
+  thus ?thesis
+    apply (clarsimp simp:foldr_upd_app_if[folded data_map_insert_def])
+    apply (drule domI[where m = "ksPSpace s'"])
+    apply (drule(1) IntI)
+    apply (erule_tac A = "A \<inter> B" for A B in in_emptyE[rotated])
+    apply (rule disjoint_subset[OF new_cap_addrs_subset[OF cover']])
+    apply (clarsimp simp:ptr_add_def field_simps)
+    apply (rule pspace_no_overlap_disjoint'[OF vs'(1) pn'])
     done
 qed
 
-lemma retype_ko_wp_at'_not:
-  assumes ad: "pspace_aligned' s" "pspace_distinct' s"
-  and     pn: "pspace_no_overlap' ptr sz s"
-  and  cover: "range_cover ptr sz (objBitsKO val + gbits) n"
-  shows "\<And>P x. x \<in> set (new_cap_addrs (2 ^ gbits * n) ptr val) \<Longrightarrow> \<not> ko_wp_at' P x s"
+lemma retype_ksPSpace_None:
+  assumes ad: "pspace_aligned' s" "pspace_distinct' s" "pspace_bounded' s"
+  assumes pn: "pspace_no_overlap' ptr sz s"
+  assumes cover: "range_cover ptr sz (objBitsKO val + gbits) n"
+  shows "\<And>x. x \<in> set (new_cap_addrs (2 ^ gbits * n) ptr val) \<Longrightarrow> ksPSpace s x = None"
 proof -
   note cover' = range_cover_rel[where sbit' = "objBitsKO val",OF cover _ refl,simplified]
-  show "\<And>P x. x \<in> set (new_cap_addrs (2 ^ gbits * n) ptr val) \<Longrightarrow> \<not> ko_wp_at' P x s"
-    apply (clarsimp simp: ko_wp_at'_def)
-    apply (drule subsetD [OF new_cap_addrs_subset [OF cover' ]])
+  show "\<And>x. x \<in> set (new_cap_addrs (2 ^ gbits * n) ptr val) \<Longrightarrow> ksPSpace s x = None"
+    apply (drule subsetD[OF new_cap_addrs_subset [OF cover' ]])
     apply (insert pspace_no_overlap_disjoint' [OF ad(1) pn])
-    apply (drule domI[where m = "ksPSpace s"])
-    apply (drule(1) orthD2)
-    apply (clarsimp simp:ptr_add_def p_assoc_help)
+    apply (fastforce simp: ptr_add_def p_assoc_help)
     done
 qed
 
-lemma retype_replyPrevs_of:
-  assumes  pr: "pspace_relation (kheap s) (ksPSpace s')"
-      and  vs: "valid_pspace s" "valid_mdb 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 us d ty = Some ko"
-      and tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
-      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 d) ko"
-      and num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
+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 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
-  "replyPrevs_of
-     (s'\<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s')\<rparr>)
-    = replyPrevs_of s'" (is "replyPrevs_of ?ps' = replyPrevs_of s'")
+    "tcbSchedPrevs_of
+       (s'\<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s')\<rparr>)
+     = tcbSchedPrevs_of s'"
 proof -
-  note dom_same' = retype_ksPSpace_dom_same[OF vs' pn' ko tysc cover num_r]
+  note dom_same' = retype_ksPSpace_dom_same[OF vs' pn' ko cover num_r]
   show ?thesis
     apply (rule ext)
-    using pr
     apply (clarsimp simp: opt_map_def split: option.splits)
     apply (intro impI conjI allI; (drule dom_same'; simp)?)
-    apply (clarsimp simp:foldr_upd_app_if[folded data_map_insert_def] projectKO_opt_reply
+    apply (clarsimp simp: foldr_upd_app_if[folded data_map_insert_def]
                    split: if_split_asm kernel_object.split_asm)
     using ko
     by (cases ty;
-        simp add: makeObjectKO_def makeObject_reply
+        simp add: makeObjectKO_def makeObject_tcb projectKOs
            split: kernel_object.split_asm arch_kernel_object.split_asm object_type.split_asm
-                 apiobject_type.split_asm if_split_asm)
-        fastforce
+                  apiobject_type.split_asm if_split_asm)
+       fastforce+
 qed
 
-lemma retype_sc_replies_relation:
-  assumes  sr: "sc_replies_relation s s'"
-      and  pr: "pspace_relation (kheap s) (ksPSpace s')"
-      and  vs: "valid_pspace s" "valid_mdb 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 us d ty = Some ko"
-      and tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
-      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 d) ko"
-      and num_r: "m = 2 ^ (obj_bits_api (APIType_map2 ty) us - objBitsKO ko) * n"
+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 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
-  "sc_replies_relation
-     (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>)"
+    "tcbSchedNexts_of
+       (s'\<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s')\<rparr>)
+     = tcbSchedNexts_of s'"
 proof -
-  have not_unt: "ty \<noteq> Inr (APIObjectType ArchTypes_H.Untyped)"
-    by (rule makeObjectKO_Untyped[OF ko])
-
-  note not_unt = makeObjectKO_Untyped [OF ko]
-
-  note dom_same = retype_kheap_dom_same[OF pn vs cover]
-
-  note dom_same' = retype_ksPSpace_dom_same[OF vs' pn' ko tysc cover num_r]
+  note dom_same' = retype_ksPSpace_dom_same[OF vs' pn' ko cover num_r]
+  show ?thesis
+    apply (rule ext)
+    apply (clarsimp simp: opt_map_def split: option.splits)
+    apply (intro impI conjI allI; (drule dom_same'; simp)?)
+    apply (clarsimp simp: foldr_upd_app_if[folded data_map_insert_def]
+                   split: if_split_asm kernel_object.split_asm)
+    using ko
+    by (cases ty;
+        simp add: makeObjectKO_def makeObject_tcb projectKOs
+           split: kernel_object.split_asm arch_kernel_object.split_asm object_type.split_asm
+                  apiobject_type.split_asm if_split_asm)
+       fastforce+
+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 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
+    "\<forall>d p.
+      inQ d p |< tcbs_of'
+       (s'\<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr ko) (new_cap_addrs m ptr ko) (ksPSpace s')\<rparr>)
+      = inQ d p |< tcbs_of' s'"
+proof -
+  note dom_same' = retype_ksPSpace_dom_same[OF vs' pn' ko cover num_r]
   show ?thesis
-    using sr pr
-    unfolding sc_replies_relation_def
-    apply (clarsimp simp: sc_replies_of_scs_def map_project_def scs_of_kh_def
-                   split: Structures_A.kernel_object.split_asm
-                   elim!: opt_mapE)
-    apply (rename_tac sc n'; drule_tac x=p and y="sc_replies sc" in spec2)
-    apply (clarsimp simp: foldr_upd_app_if[folded data_map_insert_def] split: if_split_asm)
-     apply (case_tac "p \<in> set (new_cap_addrs m ptr ko)")
-      apply (case_tac "APIType_map2 ty"; simp add: default_object_def not_unt)
+    apply (intro allI)
+    apply (rule ext)
+    apply (clarsimp simp: inQ_def opt_pred_def opt_map_def split: option.splits)
+    apply (intro impI conjI allI; (drule dom_same'; simp)?)
+    apply (clarsimp simp: foldr_upd_app_if[folded data_map_insert_def]
+                   split: if_split_asm kernel_object.split_asm)
     using ko
-      apply (clarsimp simp: makeObjectKO_def makeObject_sc default_sched_context_def
-                            opt_map_def projectKO_opt_sc)
-     apply (erule notE)
-     apply (clarsimp simp: pspace_relation_def)
-     apply (simp add: obj_relation_retype_addrs_eq[OF not_unt tysc num_r orr cover,symmetric])
-    apply (clarsimp simp: scs_of_kh_def opt_map_Some sc_replies_of_scs_def map_project_Some)
-    apply (fold foldr_upd_app_if[folded data_map_insert_def])
-    apply (simp only: retype_replyPrevs_of[OF pr vs vs' pn pn' ko tysc cover orr num_r, simplified])
-    apply (clarsimp simp: pspace_relation_def)
-    apply (drule_tac x=p in bspec, fastforce)
-    apply (prop_tac "p \<in> dom (ksPSpace s')")
-     apply (clarsimp simp: pspace_dom_def split: if_split_asm, fastforce)
-    apply (clarsimp split: if_split_asm kernel_object.splits)
-    apply (frule dom_same')
-    apply (clarsimp simp: opt_map_def)
-    done
+    by (cases ty;
+        fastforce simp  add: makeObjectKO_def makeObject_tcb projectKOs
+           split: kernel_object.split_asm arch_kernel_object.split_asm object_type.split_asm
+                  apiobject_type.split_asm if_split_asm
+        | fastforce)+
 qed
 
+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 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))
+                                             (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
+  unfolding ready_queues_relation_def Let_def
+  by (clarsimp simp: retype_tcbSchedNexts_of[OF vs' pn' ko cover num_r, simplified]
+                     retype_tcbSchedPrevs_of[OF vs' pn' ko cover num_r, simplified]
+                     retype_inQ[OF vs' pn' ko cover num_r, simplified])
+
 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_list s"
+      and  et:   "valid_etcbs s" "valid_list s"
       and vs':   "pspace_aligned' s'" "pspace_distinct' s'"
-      and bd':   "pspace_bounded' s'"
       and  pn:   "pspace_no_overlap_range_cover ptr sz s"
       and pn':   "pspace_no_overlap' ptr sz s'"
-      and tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
       and cover: "range_cover ptr sz (obj_bits_api (APIType_map2 ty) us) n"
-      and  ko:   "makeObjectKO dev us d ty = Some ko"
+      and  ko:   "makeObjectKO dev 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 d) ko"
+      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
-  "(s \<lparr>kheap :=
-              foldr (\<lambda>p. data_map_insert p (default_object (APIType_map2 ty) dev us d))
+  "(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))
                (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 "(s\<lparr>kheap := ?ps\<rparr>, update_gs _ _ _ (s'\<lparr>ksPSpace := ?ps'\<rparr>))
-       \<in> state_relation"
-   is "(?t, ?t') \<in> state_relation")
-  proof (rule state_relation_null_filterE[OF sr refl _ _ _ _ _ _ _ vs'],
-         simp_all add: trans_state_update[symmetric] del: trans_state_update) (* FIXME: don't simp here *)
+  (is "(ekheap_update (\<lambda>_. ?eps) 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)
 
   have cover':"range_cover ptr sz (objBitsKO ko) m"
-    by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF tysc ko] num_r])
+    by (rule range_cover_rel[OF cover objBits_le_obj_bits_api[OF ko] num_r])
   have al':"is_aligned ptr (objBitsKO ko)"
     using cover'
     by (simp add:range_cover_def)
-  have bd:"objBitsKO ko < word_bits"
-    using cover'
-    by (simp add:range_cover_def word_bits_def)
   have sz:"sz < word_bits"
     using cover'
     by (simp add:range_cover_def word_bits_def)
+  let ?t = "s\<lparr>kheap := ?ps\<rparr>"
   let ?tp = "APIType_map2 ty"
   let ?al = "retype_addrs ptr ?tp n us"
+  let ?t' = "update_gs ?tp us (set ?al) (s'\<lparr>ksPSpace := ?ps'\<rparr>)"
 
-  note pad' = retype_aligned_distinct' [OF vs' bd' pn' cover']
+  note pad' = retype_aligned_distinct' [OF vs' pn' cover']
   thus pa': "pspace_aligned' (s'\<lparr>ksPSpace := ?ps'\<rparr>)"
    and pd': "pspace_distinct' (s'\<lparr>ksPSpace := ?ps'\<rparr>)"
     by simp_all
@@ -1396,13 +1393,12 @@ lemma retype_state_relation:
   note nc_al' = nc_al[unfolded objBits_def]
   show "null_filter' (map_to_ctes ?ps') = null_filter' (ctes_of s')"
     apply (rule null_filter_ctes_retype [OF ko vs' pa'' pd''])
-      apply (simp add: nc_al)
-     apply (simp add: bd)
+     apply (simp add: nc_al)
     apply clarsimp
     apply (drule subsetD [OF new_cap_addrs_subset [OF cover']])
     apply (insert pspace_no_overlap_disjoint'[OF vs'(1) pn'])
     apply (drule orthD1)
-     apply (simp add:ptr_add_def field_simps)
+      apply (simp add:ptr_add_def field_simps)
     apply clarsimp
     done
 
@@ -1422,9 +1418,15 @@ lemma retype_state_relation:
     using sr by (simp add: state_relation_def)
 
   thus "pspace_relation ?ps ?ps'"
-    by (rule retype_pspace_relation [OF _ vs vs' pn pn' ko tysc cover orr num_r,
+    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)])
 
@@ -1492,30 +1494,6 @@ lemma retype_state_relation:
     from gr show ?thesis
       by (simp add: ghost_relation_of_heap,
           simp add: CapTableObject update_gs_def ext)
-  next
-    case ReplyObject
-    from pn2
-    have [simp]: "ups_of_heap ?ps = ups_of_heap (kheap s)"
-      by - (rule ext, induct (?al),
-            simp_all add: ups_of_heap_def default_object_def data_map_insert_def ReplyObject)
-    from pn2
-    have [simp]: "cns_of_heap ?ps = cns_of_heap (kheap s)"
-      by - (rule ext, induct (?al),
-            simp_all add: cns_of_heap_def default_object_def data_map_insert_def ReplyObject)
-    from gr show ?thesis
-      by (simp add: ghost_relation_of_heap, simp add: ReplyObject update_gs_def)
-  next
-    case SchedContextObject
-    from pn2
-    have [simp]: "ups_of_heap ?ps = ups_of_heap (kheap s)"
-      by - (rule ext, induct (?al),
-            simp_all add: ups_of_heap_def default_object_def data_map_insert_def SchedContextObject)
-    from pn2
-    have [simp]: "cns_of_heap ?ps = cns_of_heap (kheap s)"
-      by - (rule ext, induct (?al),
-            simp_all add: cns_of_heap_def default_object_def data_map_insert_def SchedContextObject)
-    from gr show ?thesis
-      by (simp add: ghost_relation_of_heap, simp add: SchedContextObject update_gs_def)
   next
     case (ArchObject ao)
     from pn2
@@ -1544,16 +1522,14 @@ lemma retype_state_relation:
     apply (clarsimp simp: update_gs_def
                    split: Structures_A.apiobject_type.splits)
     apply (intro conjI impI)
-           apply (subst ex_comm, rule_tac x=id in exI,
-                  subst ex_comm, rule_tac x=id in exI, fastforce)+
-       apply (subst ex_comm, rule_tac x=id in exI)
-       apply (subst ex_comm)
-       apply (rule_tac x="\<lambda>cns x. if x\<in>set ?al then Some us else cns x" in exI,
-              simp)
-       apply (rule_tac x="\<lambda>x. foldr (\<lambda>addr. data_map_insert addr ko)
-                                    (new_cap_addrs m ptr ko) x" in exI, simp)
-      apply (subst ex_comm, rule_tac x=id in exI,
-             subst ex_comm, rule_tac x=id in exI, fastforce)+
+         apply (subst ex_comm, rule_tac x=id in exI,
+                subst ex_comm, rule_tac x=id in exI, fastforce)+
+     apply (subst ex_comm, rule_tac x=id in exI)
+     apply (subst ex_comm)
+     apply (rule_tac x="\<lambda>cns x. if x\<in>set ?al then Some us else cns x" in exI,
+            simp)
+     apply (rule_tac x="\<lambda>x. foldr (\<lambda>addr. data_map_insert addr ko)
+                                  (new_cap_addrs m ptr ko) x" in exI, simp)
     apply clarsimp
     apply (rule_tac x="\<lambda>x. foldr (\<lambda>addr. data_map_insert addr ko)
                                  (new_cap_addrs m ptr ko) x" in exI)
@@ -1571,15 +1547,6 @@ lemma retype_state_relation:
       apply (rule_tac x=id in exI, simp)+
     done
 
-  have scr: "sc_replies_relation s s'"
-    using sr by (simp add: state_relation_def)
-
-  thus
-    "sc_replies_relation_2 (sc_replies_of_kh ?ps) (?ps' |> sc_of' |> scReply)
-                                                     (?ps' |> reply_of' |> replyPrev)"
-    using retype_sc_replies_relation [OF _ pspr vs vs' pn pn' ko tysc cover orr num_r]
-    by clarsimp
-
   have rdyqrel: "ready_queues_relation s s'"
     using sr by (simp add: state_relation_def)
 
@@ -1592,33 +1559,242 @@ lemma retype_state_relation:
 qed
 
 lemma new_cap_addrs_fold':
-  "1 \<le> n \<Longrightarrow> map (\<lambda>n. ptr + (n << objBitsKO ko)) [0.e.n - 1] = new_cap_addrs (unat n) ptr ko"
-  by (clarsimp simp: new_cap_addrs_def ptr_add_def upto_enum_red' shiftl_t2n power_add field_simps)
-
-lemma objBitsKO_gt_0: "0 < (objBitsKO ko)"
-  apply (case_tac ko; simp add: objBits_simps' pageBits_def bit_simps')
+  "1 \<le> n \<Longrightarrow>
+   map (\<lambda>n. ptr + (n << objBitsKO ko)) [0.e.n - 1] =
+   new_cap_addrs (unat n) ptr ko"
+ by (clarsimp simp:new_cap_addrs_def ptr_add_def upto_enum_red'
+           shiftl_t2n power_add field_simps)
+
+lemma objBitsKO_gt_0: "0 < objBitsKO ko"
+  apply (case_tac ko)
+        apply (simp_all add: objBits_simps' pageBits_def)
   apply (rename_tac arch_kernel_object)
-  by (case_tac arch_kernel_object; simp add: archObjSize_def pageBits_def pteBits_def pdeBits_def)
+  apply (case_tac arch_kernel_object)
+    apply (simp_all add:archObjSize_def pageBits_def pteBits_def pdeBits_def)
+  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))"
-  by (auto simp: exec_gets fun_eq_iff intro: bind_apply_cong
-           dest!: in_inv_by_hoareD[OF getObject_tcb_inv])
+ = gets proj >>= (\<lambda>y. getObject addr >>= (\<lambda>x. G x y))"
+by (auto simp: exec_gets fun_eq_iff intro: bind_apply_cong dest!: in_inv_by_hoareD[OF getObject_inv_tcb])
 
 lemma setObject_tcb_gets_ksCurDomain:
   "setObject addr (tcb::tcb) >>= (\<lambda>_. gets ksCurDomain >>= G)
-   = gets ksCurDomain >>= (\<lambda>x. setObject addr tcb >>= (\<lambda>_. G x))"
-  apply (clarsimp simp: exec_gets fun_eq_iff)
-  apply (rule bind_apply_cong)
-   apply simp
-  apply (drule_tac P1="\<lambda>cdom. cdom = ksCurDomain x" in use_valid[OF _ setObject_cd_inv])
-   apply (simp_all add: exec_gets)
-  done
+ = gets ksCurDomain >>= (\<lambda>x. setObject addr tcb >>= (\<lambda>_. G x))"
+apply (clarsimp simp: exec_gets fun_eq_iff)
+apply (rule bind_apply_cong)
+ apply simp
+apply (drule_tac P1="\<lambda>cdom. cdom = ksCurDomain x" in use_valid[OF _ setObject_cd_inv])
+apply (simp_all add: exec_gets)
+done
 
 lemma curDomain_mapM_x_futz:
   "curDomain >>= (\<lambda>cdom. mapM_x (threadSet (F cdom)) addrs)
-   = mapM_x (\<lambda>addr. curDomain >>= (\<lambda>cdom. threadSet (F cdom) addr)) addrs"
+ = mapM_x (\<lambda>addr. curDomain >>= (\<lambda>cdom. threadSet (F cdom) addr)) addrs"
 proof(induct addrs)
   case Nil thus ?case
     by (simp add: curDomain_def mapM_x_def sequence_x_def bind_def gets_def get_def return_def)
@@ -1643,42 +1819,55 @@ 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              ko: "makeObjectKO dev us d ty = Some ko"
-  and            tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
+  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             orr: "obj_bits_api (APIType_map2 ty) us \<le> sz \<Longrightarrow>
-                        obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko"
+                        obj_relation_retype
+                          (default_object (APIType_map2 ty) dev us) 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_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)"
+  (\<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)"
   (is "corres ?r ?P ?P' ?C ?A")
 proof -
   note data_map_insert_def[simp del]
-  have not_zero':"(of_nat n::machine_word) \<noteq> 0"
+  have not_zero':"((of_nat n)::word32) \<noteq> 0"
     by (rule range_cover_not_zero[OF not_zero cover])
-  have shiftr_not_zero:" (of_nat n::machine_word) << gbits \<noteq> 0"
+  have shiftr_not_zero:" ((of_nat n)::word32) << gbits \<noteq> 0"
     apply (rule range_cover_not_zero_shift[OF not_zero cover])
     apply (simp add:obj_bits_api)
     done
-  have unat_of_nat_shift:"unat ((of_nat n::machine_word) << gbits) = n * 2^ gbits"
+  have unat_of_nat_shift:"unat (((of_nat n)::word32) << gbits) =
+                          (n * 2^ gbits)"
     apply (rule range_cover.unat_of_nat_n_shift[OF cover])
     using obj_bits_api
     apply simp
     done
   have unat_of_nat_shift':
-    "unat ((of_nat n::machine_word) * 2^(gbits + objBitsKO ko)) = n * 2^(gbits + objBitsKO ko)"
+    "unat (((of_nat n)::word32) * 2^(gbits + objBitsKO ko)) =
+     n * 2^(gbits + objBitsKO ko)"
     apply (subst mult.commute)
     apply (simp add:shiftl_t2n[symmetric])
     apply (rule range_cover.unat_of_nat_n_shift[OF cover])
@@ -1686,29 +1875,32 @@ proof -
     apply simp
     done
   have unat_of_nat_n':
-    "unat (((of_nat n)::machine_word) * 2 ^ (gbits + objBitsKO ko)) \<noteq> 0"
+    "unat (((of_nat n)::word32) * 2 ^ (gbits + objBitsKO ko)) \<noteq> 0"
     by (simp add:unat_of_nat_shift' not_zero)
   have bound:"obj_bits_api (APIType_map2 ty) us \<le> sz"
     using cover
     by (simp add:range_cover_def)
   have n_estimate: "n < 2 ^ (word_bits - (objBitsKO ko + gbits))"
     apply (rule le_less_trans)
-     apply (rule range_cover.range_cover_n_le(2)[OF cover])
+    apply (rule range_cover.range_cover_n_le(2)[OF cover])
     apply (rule power_strict_increasing)
-     apply (simp add:obj_bits_api ko)
-     apply (rule diff_less_mono)
+    apply (simp add:obj_bits_api ko)
+    apply (rule diff_less_mono)
     using cover obj_bits_api
-      apply (simp_all add:range_cover_def ko word_bits_def)
+    apply (simp_all add:range_cover_def ko word_bits_def)
     done
 
   have set_retype_addrs_fold:
-    "image (\<lambda>n. ptr + 2 ^ obj_bits_api (APIType_map2 ty) us * n) {x. x \<le> of_nat n - 1} =
+    "image (\<lambda>n. ptr + 2 ^ obj_bits_api (APIType_map2 ty) us * n)
+           {x. x \<le> of_nat n - 1} =
      set (retype_addrs ptr (APIType_map2 ty) n us)"
-    apply (clarsimp simp: retype_addrs_def image_def Bex_def ptr_add_def Collect_eq)
+    apply (clarsimp simp: retype_addrs_def image_def Bex_def ptr_add_def
+                          Collect_eq)
     apply (rule iffI)
      apply (clarsimp simp: field_simps word_le_nat_alt)
      apply (rule_tac x="unat x" in exI)
-     apply (simp add: unat_sub_if_size range_cover.unat_of_nat_n[OF cover] not_le not_zero
+     apply (simp add: unat_sub_if_size range_cover.unat_of_nat_n[OF cover]
+                      not_le not_zero
                split: if_split_asm)
     apply (clarsimp simp: field_simps word_le_nat_alt)
     apply (rule_tac x="of_nat x" in exI)
@@ -1735,7 +1927,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_region_def createObjects'_def
+  apply (simp add: when_def retype_region2_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
@@ -1743,91 +1935,80 @@ 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)
-   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'
+   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'
                            range_cover.unat_of_nat_n[OF cover])
-          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 _ _ _ _ _ _ _ _ _ tysc cover _ _ orr],
-                      simp_all add: ko not_zero obj_bits_api
-                                    bound[simplified obj_bits_api ko])[1]
-                apply (erule pspace_relation_pspace_bounded')
-               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_32)
-            apply (rule of_nat_less_pow_32[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
+       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
+                         simp del: word_of_nat_eq_0_iff)
+         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_32)
+         apply (rule of_nat_less_pow_32[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
 qed
 
 lemma createObjects_corres':
@@ -1835,13 +2016,13 @@ lemma createObjects_corres':
    \<Longrightarrow> corres dc P P' f (createObjects' a b ko d)"
   apply (clarsimp simp:corres_underlying_def createObjects_def return_def)
   apply (rule conjI)
-   apply (clarsimp simp:bind_def split_def)
-   apply (drule(1) bspec)
-   apply (clarsimp simp:image_def)
-   apply (drule(1) bspec)
-   apply clarsimp
-   apply (erule bexI[rotated])
-   apply simp
+  apply (clarsimp simp:bind_def split_def)
+    apply (drule(1) bspec)
+    apply (clarsimp simp:image_def)
+    apply (drule(1) bspec)
+    apply clarsimp
+    apply (erule bexI[rotated])
+    apply simp
   apply (clarsimp simp:bind_def split_def image_def)
   apply (drule(1) bspec|clarsimp)+
   done
@@ -1851,7 +2032,6 @@ lemmas retype_aligned_distinct'' = retype_aligned_distinct'
 
 lemma retype_ko_wp_at':
   assumes vs: "pspace_aligned' s" "pspace_distinct' s"
-     and  bd:  "pspace_bounded' s"
      and  pn: "pspace_no_overlap' ptr sz s"
    and cover: "range_cover ptr sz (objBitsKO obj) n"
   shows
@@ -1861,16 +2041,14 @@ lemma retype_ko_wp_at':
                          else ko_wp_at' P p s)"
   apply (subst foldr_upd_app_if[folded data_map_insert_def])
   apply (rule foldr_update_ko_wp_at' [OF vs])
-    apply (simp add: retype_aligned_distinct'' [OF vs bd pn cover])+
-   apply (rule new_cap_addrs_aligned)
-  using cover
-   apply (simp add:range_cover_def cover)
+    apply (simp add: retype_aligned_distinct'' [OF vs pn cover])+
+  apply (rule new_cap_addrs_aligned)
   using cover
-  apply (simp add:range_cover_def word_bits_def)
+  apply (simp add:range_cover_def cover)
   done
 
 lemma retype_obj_at':
-  assumes vs: "pspace_aligned' s" "pspace_distinct' s" "pspace_bounded' s"
+  assumes vs: "pspace_aligned' s" "pspace_distinct' s"
      and  pn: "pspace_no_overlap' ptr sz s"
      and cover: "range_cover ptr sz (objBitsKO obj) n"
   shows
@@ -1879,10 +2057,11 @@ lemma retype_obj_at':
      = (if p \<in> set (new_cap_addrs n ptr obj) then (\<exists>ko. projectKO_opt obj = Some ko \<and> P ko)
                          else obj_at' P p s)"
   unfolding obj_at'_real_def
-  by (rule retype_ko_wp_at'[OF vs pn cover])
+  apply (rule retype_ko_wp_at'[OF vs pn cover])
+done
 
 lemma retype_obj_at_disj':
-  assumes vs: "pspace_aligned' s" "pspace_distinct' s" "pspace_bounded' s"
+  assumes vs: "pspace_aligned' s" "pspace_distinct' s"
      and  pn: "pspace_no_overlap' ptr sz s"
      and cover: "range_cover ptr sz (objBitsKO obj) n"
   shows
@@ -1899,14 +2078,14 @@ lemma retype_obj_at_disj':
     apply (simp add:ptr_add_def p_assoc_help domI)+
   done
 
-declare word_unat_power[symmetric,simp] (* FIXME: remove *)
+declare word_unat_power[symmetric,simp]
 
 lemma createObjects_ko_at_strg:
   fixes ptr :: word32
   assumes    cover: "range_cover ptr sz ((objBitsKO ko) + gbits) n"
   assumes    not_0: "n\<noteq> 0"
   assumes       pi: "projectKO_opt ko  = Some val"
-  shows "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>
+  shows "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
              createObjects ptr n ko gbits
          \<lbrace>\<lambda>r s. \<forall>x \<in> set r. \<forall>offs < 2 ^ gbits. ko_at' val (x + (offs << objBitsKO ko)) s\<rbrace>"
 proof -
@@ -1920,96 +2099,101 @@ proof -
   have in_new:"\<And>idx offs. \<lbrakk>idx \<le> of_nat n - 1;offs<2 ^ gbits\<rbrakk>
     \<Longrightarrow> ptr + (idx << objBitsKO ko + gbits) + (offs << objBitsKO ko)
         \<in> set (new_cap_addrs (n * 2 ^ gbits) ptr ko)"
-    apply (insert range_cover_not_zero[OF not_0 cover] not_0)
-    apply (clarsimp simp:new_cap_addrs_def image_def)
-    apply (rule_tac x ="unat (2 ^ gbits * idx + offs)" in bexI)
-     apply (subst add.commute)
-     apply (simp add:shiftl_shiftl[symmetric])
-     apply (simp add:shiftl_t2n distrib_left[symmetric])
-    apply simp
-    apply (rule unat_less_helper)
-    apply (rule less_le_trans)
-     apply (erule word_plus_strict_mono_right)
-     apply (subst distrib_left[where c = "1 :: 32 word",symmetric,simplified])
-     apply (subst mult.commute[where a = "2^gbits"])+
-     apply (insert cover)
-     apply (rule word_mult_le_iff[THEN iffD2])
-        apply (simp add:p2_gt_0)
-        apply (clarsimp simp:range_cover_def word_bits_def)
-       apply (drule range_cover_rel[where sbit' = "objBitsKO ko "])
-         apply simp
-        apply simp
-       apply (rule less_le_trans)
-        apply (rule range_cover.range_cover_le_n_less)
+      apply (insert range_cover_not_zero[OF not_0 cover] not_0)
+      apply (clarsimp simp:new_cap_addrs_def image_def)
+      apply (rule_tac x ="unat (2 ^ gbits * idx + offs)" in bexI)
+        apply (subst add.commute)
+        apply (simp add:shiftl_shiftl[symmetric])
+        apply (simp add:shiftl_t2n distrib_left[symmetric])
+      apply simp
+      apply (rule unat_less_helper)
+      apply (rule less_le_trans)
+       apply (erule word_plus_strict_mono_right)
+       apply (subst distrib_left[where c = "1 :: 32 word",symmetric,simplified])
+       apply (subst mult.commute[where a = "2^gbits"])+
+       apply (insert cover)
+       apply (rule word_mult_le_iff[THEN iffD2])
+         apply (simp add:p2_gt_0)
+         apply (clarsimp simp:range_cover_def word_bits_def)
+         apply (drule range_cover_rel[where sbit' = "objBitsKO ko "])
+           apply simp
+          apply simp
+         apply (rule less_le_trans)
+          apply (rule range_cover.range_cover_le_n_less)
+           apply simp
+          apply (subst unat_power_lower)
+           using cover
+           apply (clarsimp simp:range_cover_def)
+          apply (simp add:field_simps)
+          apply (rule unat_le_helper)
+          apply (erule order_trans[OF _ word_sub_1_le])
+          apply (simp add:range_cover_not_zero[OF not_0 cover])
+         apply (simp add:word_bits_def)
+        apply (drule range_cover_rel[where sbit' = "objBitsKO ko "])
+          apply simp
          apply simp
+        apply (erule less_le_trans[OF range_cover.range_cover_le_n_less(1)])
         apply (subst unat_power_lower)
          using cover
          apply (clarsimp simp:range_cover_def)
         apply (simp add:field_simps)
-        apply (rule unat_le_helper)
-        apply (erule order_trans[OF _ word_sub_1_le])
-        apply (simp add:range_cover_not_zero[OF not_0 cover])
+        apply (rule unat_le_helper[OF inc_le])
+        apply (simp add:word_leq_minus_one_le)
        apply (simp add:word_bits_def)
-      apply (drule range_cover_rel[where sbit' = "objBitsKO ko "])
-        apply simp
-       apply simp
-      apply (erule less_le_trans[OF range_cover.range_cover_le_n_less(1)])
-       apply (subst unat_power_lower)
-        using cover
-        apply (clarsimp simp:range_cover_def)
-       apply (simp add:field_simps)
-       apply (rule unat_le_helper[OF inc_le])
-       apply (simp add:word_leq_minus_one_le)
-      apply (simp add:word_bits_def)
-     apply (rule no_plus_overflow_neg)
-     apply (rule less_le_trans[where y = "of_nat n"])
-      apply unat_arith
-     using range_cover.range_cover_n_less[OF cover]
+      apply (rule no_plus_overflow_neg)
+      apply (rule less_le_trans[where y = "of_nat n"])
+       apply unat_arith
+      using range_cover.range_cover_n_less[OF cover]
      apply (simp add:word_bits_def)
     apply (subst distrib_left[where c = "1 :: 32 word",symmetric,simplified])
-    apply (subst mult.commute)
-    apply simp
-    apply (rule word_mult_le_iff[THEN iffD2])
+   apply (subst mult.commute)
+   apply simp
+   apply (rule word_mult_le_iff[THEN iffD2])
        apply (simp add:p2_gt_0)
-       apply (simp add:range_cover_def word_bits_def)
-      apply (drule range_cover_rel[where sbit' = "objBitsKO ko "])
-        apply simp
-       apply simp
-      apply (rule less_le_trans)
-       apply (rule range_cover.range_cover_le_n_less)
-        apply simp
-       apply (subst unat_power_lower)
-        using cover
-        apply (clarsimp simp:range_cover_def)
-       apply (simp add:field_simps)
-       apply (rule unat_le_helper)
-       apply unat_arith
-      apply (simp add:word_bits_def)
+      apply (simp add:range_cover_def word_bits_def)
      apply (drule range_cover_rel[where sbit' = "objBitsKO ko "])
        apply simp
       apply simp
      apply (rule less_le_trans)
-      apply (erule range_cover.range_cover_le_n_less)
-      apply (simp add:range_cover.unat_of_nat_n[OF cover])
-      apply (simp add: unat_le_helper)
-     apply (simp add:word_bits_def)
+     apply (rule range_cover.range_cover_le_n_less)
+       apply simp
+     apply (subst unat_power_lower)
+       using cover
+       apply (clarsimp simp:range_cover_def)
+      apply (simp add:field_simps)
+     apply (rule unat_le_helper)
     apply unat_arith
-    done
+   apply (simp add:word_bits_def)
+   apply (drule range_cover_rel[where sbit' = "objBitsKO ko "])
+       apply simp
+      apply simp
+     apply (rule less_le_trans)
+      apply (erule range_cover.range_cover_le_n_less)
+     apply (simp add:range_cover.unat_of_nat_n[OF cover])
+    apply (simp add: unat_le_helper)
+   apply (simp add:word_bits_def)
+  apply unat_arith
+  done
   show ?thesis
-    apply (simp add: split_def createObjects_def lookupAround2_pspace_no
-                     alignError_def unless_def createObjects'_def)
-    apply (wp|simp add:data_map_insert_def[symmetric]
-                   cong: if_cong del: fun_upd_apply data_map_insert_def)+
-       apply (wpc|wp|clarsimp simp del:fun_upd_apply)+
-    apply (subst new_cap_addrs_fold'[OF shiftr_not_zero])+
-    apply (subst data_map_insert_def[symmetric])+
-    apply (subst retype_obj_at_disj'; simp add:valid_pspace'_def unat_of_nat_shiftl)+
-     apply (rule range_cover_rel[OF cover]; simp)
-    apply (subst retype_obj_at_disj'; simp add:valid_pspace'_def unat_of_nat_shiftl)
-     apply (rule range_cover_rel[OF cover]; simp)
-    using range_cover.unat_of_nat_n_shift[OF cover,where gbits = gbits,simplified] pi
-    apply (simp add: in_new)
-    done
+  apply (simp add: split_def createObjects_def lookupAround2_pspace_no
+                   alignError_def unless_def createObjects'_def)
+  apply (rule hoare_pre)
+   apply (wp|simp add:data_map_insert_def[symmetric]
+     cong: if_cong del: fun_upd_apply data_map_insert_def)+
+   apply (wpc|wp|clarsimp simp del:fun_upd_apply)+
+   apply (subst new_cap_addrs_fold'[OF shiftr_not_zero])+
+   apply (subst data_map_insert_def[symmetric])+
+   apply (subst retype_obj_at_disj')
+     apply (simp add:valid_pspace'_def unat_of_nat_shiftl)+
+     apply (rule range_cover_rel[OF cover])
+     apply simp+
+   apply (subst retype_obj_at_disj')
+     apply (simp add:valid_pspace'_def unat_of_nat_shiftl)+
+     apply (rule range_cover_rel[OF cover])
+     apply simp+
+  using range_cover.unat_of_nat_n_shift[OF cover,where gbits = gbits,simplified] pi
+  apply (simp add: in_new)
+  done
 qed
 
 lemma createObjects_ko_at:
@@ -2039,6 +2223,9 @@ lemma createObjects_obj_at:
   apply (clarsimp elim!: obj_at'_weakenE)
   done
 
+(* until we figure out what we really need of page
+   mappings it's just alignment, which, fortunately,
+   is trivial *)
 lemma createObjects_aligned:
   assumes al: "is_aligned ptr (objBitsKO ko + gbits)"
   and bound :"n < 2 ^ word_bits" "n\<noteq>0"
@@ -2049,7 +2236,7 @@ lemma createObjects_aligned:
    apply (rule createObjects_ret[OF bound])
   apply (clarsimp dest!: less_two_pow_divD)
   apply (rule is_aligned_ptr_add_helper[OF al])
-     apply (simp_all add:bound')
+  apply (simp_all add:bound')
   done
 
 lemma createObjects_aligned2:
@@ -2096,27 +2283,6 @@ lemma objBits_if_dev:
     "objBitsKO (if dev then KOUserDataDevice else KOUserData) = pageBits"
   by (simp add: objBitsKO_def)
 
-lemma createObjects_sc_at'_n:
-  fixes ptr :: word32 and val :: sched_context
-  assumes  cover:"range_cover ptr sz ((objBitsKO ko) + gbits) n"
-  and      not_0:"n \<noteq> 0"
-  and       pi: "\<exists>(val::sched_context). projectKO_opt ko = Some val"
-  shows
-  "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> valid_pspace' s\<rbrace>
-   createObjects ptr n ko gbits
-   \<lbrace>\<lambda>r s. \<forall>x \<in> set r. \<forall>offs < 2 ^ gbits.
-                         sc_at'_n (objBitsKO ko) (x + (offs << objBitsKO ko)) s\<rbrace>"
-  apply (rule exE[OF pi])
-  apply (prop_tac "objBitsKO ko = objBits x")
-   apply (clarsimp simp: projectKOs objBits_def)
-  apply (erule_tac val1 = x in
-            hoare_post_imp [OF _ createObjects_ko_at [OF cover not_0 ],rotated])
-  apply (intro allI ballI impI)
-  apply (drule(1) bspec)
-  apply (drule spec, drule(1) mp)
-  apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKOs objBits_def)
-  done
-
 lemma cwo_ret:
   assumes  cover:"range_cover ptr sz v n"
   assumes not_0:"n\<noteq> 0"
@@ -2167,7 +2333,6 @@ show ?thesis
       projectKO_opts_defs split: kernel_object.splits)
   done
 qed
-
 lemmas capFreeIndex_update_valid_untyped' =
   capFreeIndex_update_valid_cap'[unfolded valid_cap'_def,simplified,THEN conjunct2,THEN conjunct1]
 
@@ -2177,14 +2342,14 @@ lemma createNewCaps_valid_cap:
   assumes not_0: "n \<noteq> 0"
   assumes ct: "ty = APIObjectType ArchTypes_H.CapTableObject \<Longrightarrow> 0 < us"
               "ty = APIObjectType apiobject_type.Untyped \<Longrightarrow> minUntypedSizeBits \<le> us \<and> us \<le> maxUntypedSizeBits"
-              "ty = APIObjectType ArchTypes_H.SchedContextObject \<Longrightarrow> sc_size_bounds us"
   assumes ptr: " ptr \<noteq> 0"
   shows "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> valid_pspace' s\<rbrace>
            createNewCaps ty ptr n us dev
          \<lbrace>\<lambda>r s. (\<forall>cap \<in> set r. s \<turnstile>' cap)\<rbrace>"
 proof -
-  note [simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
-  note [split del] = if_split
+  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
+  note if_split_def[split del] = if_splits
 
   show ?thesis
   proof(cases "Types_H.toAPIType ty")
@@ -2198,7 +2363,7 @@ proof -
                      split: ARM_H.object_type.splits)
 
        \<comment> \<open>SmallPageObject\<close>
-       apply wp
+       apply (wp mapM_x_wp' hoare_vcg_op_lift)
         apply (simp add: valid_cap'_def capAligned_def n_less_word_bits
                          ball_conj_distrib)
         apply (wp createObjects_aligned2 createObjects_nonzero[OF not_0 ,simplified]
@@ -2206,7 +2371,7 @@ proof -
          | simp add: objBits_if_dev pageBits_def ptr range_cover_n_wb)+
        apply (simp add:pageBits_def ptr word_bits_def)
       \<comment> \<open>LargePageObject\<close>
-      apply wp
+      apply (wp mapM_x_wp' hoare_vcg_op_lift)
        apply (simp add: valid_cap'_def capAligned_def n_less_word_bits
                         ball_conj_distrib)
        apply (wp createObjects_aligned2 createObjects_nonzero[OF not_0 ,simplified]
@@ -2215,7 +2380,7 @@ proof -
       apply (simp add:pageBits_def ptr word_bits_def)
 
      \<comment> \<open>SectionObject\<close>
-     apply wp
+     apply (wp mapM_x_wp' hoare_vcg_op_lift)
       apply (simp add: valid_cap'_def capAligned_def n_less_word_bits
                        ball_conj_distrib)
       apply (wp createObjects_aligned2 createObjects_nonzero[OF not_0 ,simplified]
@@ -2224,7 +2389,7 @@ proof -
      apply (simp add:pageBits_def ptr word_bits_def)
 
     \<comment> \<open>SuperSectionObject\<close>
-    apply wp
+    apply (wp mapM_x_wp' hoare_vcg_op_lift)
      apply (simp add: valid_cap'_def capAligned_def n_less_word_bits
                       ball_conj_distrib)
      apply (wp createObjects_aligned2 createObjects_nonzero[OF not_0 ,simplified]
@@ -2233,7 +2398,7 @@ proof -
     apply (simp add:pageBits_def ptr word_bits_def)
 
    \<comment> \<open>PageTableObject\<close>
-    apply wp
+    apply (wp mapM_x_wp' hoare_vcg_op_lift)
      apply (simp add: valid_cap'_def capAligned_def n_less_word_bits)
      apply (simp only: imp_conv_disj page_table_at'_def
                        typ_at_to_obj_at_arches)
@@ -2253,8 +2418,7 @@ proof -
                           pdeBits_def pteBits_def)
     apply clarsimp
   \<comment> \<open>PageDirectoryObject\<close>
-   apply (wp hoare_vcg_const_Ball_lift)
-   apply (wp mapM_x_wp' )
+   apply (wp mapM_x_wp' hoare_vcg_op_lift)
    apply (simp add: valid_cap'_def capAligned_def n_less_word_bits)
    apply (simp only: imp_conv_disj page_directory_at'_def
                      typ_at_to_obj_at_arches)
@@ -2311,17 +2475,16 @@ proof -
         apply (simp_all add: ARM_H.toAPIType_def
                              fromIntegral_def toInteger_nat fromInteger_nat APIType_capBits_def curDomain_def
                       split: ARM_H.object_type.splits)
-        apply wp
-         apply (rule hoare_post_imp)
-          prefer 2
-          apply (rule createObjects_obj_at [where 'a = "tcb" and sz=sz,OF _ not_0])
-        using cover
-           apply (clarsimp simp: ARM_H.toAPIType_def APIType_capBits_def objBits_simps
-                          split: ARM_H.object_type.splits)
-          apply (simp add: projectKOs)
-         apply (clarsimp simp: valid_cap'_def objBits_simps)
-         apply (fastforce intro: capAligned_tcbI)
-        apply wp
+        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: ARM_H.toAPIType_def APIType_capBits_def objBits_simps
+                         split: ARM_H.object_type.splits)
+         apply (simp add: projectKOs)
+        apply (clarsimp simp: valid_cap'_def objBits_simps)
+        apply (fastforce intro: capAligned_tcbI)
         done
     next
       case EndpointObject with Some cover ct show ?thesis
@@ -2394,56 +2557,15 @@ proof -
          apply (clarsimp simp add: shiftl_t2n)
         apply simp
         done
-    next
-      case ReplyObject with Some cover ct show ?thesis
-        including no_pre
-        apply (clarsimp simp: Arch_createNewCaps_def createNewCaps_def)
-        apply (simp_all add: ARM_H.toAPIType_def
-                             fromIntegral_def toInteger_nat fromInteger_nat APIType_capBits_def
-                      split: ARM_H.object_type.splits)
-        apply wp
-        apply (rule hoare_post_imp)
-         prefer 2
-         apply (rule createObjects_obj_at [where 'a=reply, OF _ not_0])
-        using cover
-          apply (clarsimp simp: ARM_H.toAPIType_def objBits_simps
-                         split: ARM_H.object_type.splits)
-         apply (simp add: projectKOs)
-        apply (simp add: valid_cap'_def)
-        apply (clarsimp simp: valid_cap'_def objBits_simps)
-        apply (fastforce intro: capAligned_replyI)
-        done
-    next
-      case SchedContextObject with Some cover ct show ?thesis
-        including no_pre
-        apply (clarsimp simp: Arch_createNewCaps_def createNewCaps_def)
-        apply (simp_all add: ARM_H.toAPIType_def
-                             fromIntegral_def toInteger_nat fromInteger_nat APIType_capBits_def
-                      split: ARM_H.object_type.splits)
-        apply wp
-        apply (rule hoare_post_imp)
-         prefer 2
-         apply (rule createObjects_sc_at'_n [OF _ not_0])
-        using cover ct(3)
-          apply (clarsimp simp: ARM_H.toAPIType_def objBits_simps APIType_capBits_def scBits_simps
-                         split: ARM_H.object_type.splits
-                         dest!: ct(3))
-         apply (simp add: projectKOs)
-        apply (clarsimp, drule bspec, simp)
-        apply (prop_tac "sc_at'_n us cap s")
-         apply (clarsimp simp: objBitsKO_def scBits_simps)
-        apply (clarsimp simp: valid_cap'_def capAligned_sched_contextI sc_size_bounds_def)
-        done
     qed
   qed
 qed
 
 lemma other_objs_default_relation:
   "\<lbrakk> case ty of Structures_A.EndpointObject \<Rightarrow> ko = injectKO (makeObject :: endpoint)
-             | Structures_A.NotificationObject \<Rightarrow> ko = injectKO (makeObject :: notification)
-             | Structures_A.TCBObject \<Rightarrow> ko = injectKO (tcbDomain_update (\<lambda>_. d) makeObject)
-                          | _ \<Rightarrow> False \<rbrakk> \<Longrightarrow>
-    obj_relation_retype (default_object ty dev n d) ko"
+             | Structures_A.NotificationObject \<Rightarrow> ko = injectKO (makeObject :: Structures_H.notification)
+             | _ \<Rightarrow> False \<rbrakk> \<Longrightarrow>
+    obj_relation_retype (default_object ty dev n) ko"
   apply (rule obj_relation_retype_other_obj)
    apply (clarsimp simp: default_object_def
                          is_other_obj_relation_type_def
@@ -2455,7 +2577,7 @@ lemma other_objs_default_relation:
                         default_ep_def makeObject_endpoint default_notification_def
                         makeObject_notification default_ntfn_def
                         fault_rel_optionation_def
-                        initContext_def default_priority_def
+                        initContext_def
                         arch_tcb_context_get_def atcbContextGet_def
                         default_arch_tcb_def newArchTCB_def
                         arch_tcb_relation_def
@@ -2471,7 +2593,7 @@ lemma tcb_relation_retype:
 
 lemma captable_relation_retype:
   "n < word_bits \<Longrightarrow>
-   obj_relation_retype (default_object Structures_A.CapTableObject dev n d) (KOCTE makeObject)"
+   obj_relation_retype (default_object Structures_A.CapTableObject dev n) (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)
@@ -2488,26 +2610,8 @@ lemma captable_relation_retype:
   apply (simp add: less_mask_eq)
   done
 
-lemma reply_relation_retype:
-  "obj_relation_retype (default_object Structures_A.ReplyObject dev n d)
-                                 (KOReply makeObject)"
-  by (simp add: default_object_def reply_relation_def default_reply_def
-                makeObject_reply obj_relation_retype_def
-                objBits_simps word_bits_def replySizeBits_def)
-
-lemma sc_relation_retype:
-  "\<lbrakk>sc_size_bounds n\<rbrakk> \<Longrightarrow>
-   obj_relation_retype (default_object Structures_A.SchedContextObject dev n d)
-                       (KOSchedContext ((makeObject :: sched_context)
-                                           \<lparr>scRefills := replicate (refillAbsoluteMax' n) emptyRefill,
-                                            scSize := n - minSchedContextBits\<rparr>))"
-  by (clarsimp simp: default_object_def sc_relation_def default_sched_context_def
-                     makeObject_sc obj_relation_retype_def valid_sched_context_size_def
-                     objBits_simps word_bits_def scBits_simps refills_map_def refill_map_def
-                     emptyRefill_def)
-
 lemma pagetable_relation_retype:
-  "obj_relation_retype (default_object (ArchObject PageTableObj) dev n d)
+  "obj_relation_retype (default_object (ArchObject PageTableObj) dev n)
                        (KOArch (KOPTE makeObject))"
   apply (simp add: default_object_def default_arch_object_def
                    makeObject_pte obj_relation_retype_def
@@ -2521,7 +2625,7 @@ lemma pagetable_relation_retype:
   done
 
 lemma pagedirectory_relation_retype:
-  "obj_relation_retype (default_object (ArchObject PageDirectoryObj) dev n d)
+  "obj_relation_retype (default_object (ArchObject PageDirectoryObj) dev n)
                        (KOArch (KOPDE makeObject))"
   apply (simp add: default_object_def default_arch_object_def
                    makeObject_pde obj_relation_retype_def
@@ -2542,32 +2646,31 @@ lemma corres_retype:
   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 us d ty = Some ko"
-  and            tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
+  and              ko: "makeObjectKO dev 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 d) ko"
+                        obj_relation_retype (default_object (APIType_map2 ty) dev us) 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_list 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
-       \<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)"
+       \<and> (\<exists>val. ko = injectKO val))
+  (retype_region2 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)
     apply (rule corres_rel_imp)
-    apply (rule corres_retype'[where g=id and ty=ty and sz = sz,OF not_zero aligned _ _ ko
+    apply (rule corres_retype'[where g=id and ty=ty and sz = sz,OF not_zero aligned _ _ _ ko
            ,simplified update_gs_id[OF tp] modify_id_return,simplified])
-           using assms
-           apply (simp_all add: objBits_def no_gs_types_def)
-   by auto
+        using assms
+        apply (simp_all add: objBits_def no_gs_types_def)
+  apply auto
+  done
 
 lemma init_arch_objects_APIType_map2:
-  "init_arch_objects (APIType_map2 (Inr ty)) ptr bits sz refs =
+  "init_arch_objects (APIType_map2 (Inr ty)) dev ptr bits sz refs =
      (case ty of APIObjectType _ \<Rightarrow> return ()
-   | _ \<Rightarrow> init_arch_objects (APIType_map2 (Inr ty)) ptr bits sz refs)"
+   | _ \<Rightarrow> init_arch_objects (APIType_map2 (Inr ty)) dev ptr bits sz refs)"
   apply (clarsimp split: ARM_H.object_type.split)
   apply (simp add: init_arch_objects_def APIType_map2_def
             split: apiobject_type.split)
@@ -2584,7 +2687,7 @@ lemma pde_relation_aligned_eq:
   done
 
 lemma copyGlobalMappings_corres:
-  "corres dc (valid_arch_state and pspace_aligned and page_directory_at pd)
+  "corres dc (valid_arch_state and valid_etcbs and pspace_aligned and page_directory_at pd)
              (valid_arch_state' and page_directory_at' pd)
           (copy_global_mappings pd)
           (copyGlobalMappings pd)"
@@ -2599,7 +2702,8 @@ lemma copyGlobalMappings_corres:
       apply (simp add: liftM_def[symmetric])
       apply (rule_tac S="(=)" and r'=dc
                   and Q="\<lambda>xs s. \<forall>x \<in> set xs. pde_at (global_pd + (x << 2)) s
-                                             \<and> pde_at (pd + (x << 2)) s \<and> pspace_aligned s"
+                                             \<and> pde_at (pd + (x << 2)) s \<and> pspace_aligned s \<and>
+                                             valid_etcbs s"
                   and Q'="\<lambda>xs s. \<forall>x \<in> set xs. pde_at' (global_pd + (x << 2)) s
                                              \<and> pde_at' (pd + (x << 2)) s"
                          in corres_mapM_list_all2, (simp add: pdeBits_def)+)
@@ -2610,7 +2714,7 @@ lemma copyGlobalMappings_corres:
              apply (drule(1) pde_relation_aligned_eq)
              apply fastforce
             apply (wp hoare_vcg_const_Ball_lift | simp)+
-      apply (simp add: kernel_base_def pptrBase_def list_all2_refl pageBits_def)
+      apply (simp add: kernel_base_def ARM.pptrBase_def pptrBase_def list_all2_refl pageBits_def)
      apply wp+
    apply (clarsimp simp: valid_arch_state_def)
    apply (auto elim: page_directory_pde_atI is_aligned_weaken[OF pd_aligned])[1]
@@ -2658,7 +2762,8 @@ lemma nullPointer_0_simp[simp]:
 
 lemma descendants_of_retype':
   assumes P: "\<And>p. P p \<Longrightarrow> m p = None"
-  shows "descendants_of' p (\<lambda>p. if P p then Some makeObject else m p) = descendants_of' p m"
+  shows "descendants_of' p (\<lambda>p. if P p then Some makeObject else m p) =
+         descendants_of' p m"
   apply (rule set_eqI)
   apply (simp add: descendants_of'_def)
   apply (rule iffI)
@@ -2693,7 +2798,7 @@ locale retype_mdb = vmdb +
   assumes 0: "\<not>P 0"
   defines "n \<equiv> \<lambda>p. if P p then Some makeObject else m p"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 
 lemma no_0_n: "no_0 n"
   using no_0 by (simp add: no_0_def n_def 0)
@@ -2918,12 +3023,21 @@ lemma dist_z_n: "distinct_zombies n"
   apply (clarsimp simp: isCap_simps)
   done
 
+lemma reply_masters_rvk_fb_m: "reply_masters_rvk_fb m"
+  using valid by auto
+
+lemma reply_masters_rvk_fb_n: "reply_masters_rvk_fb n"
+  using reply_masters_rvk_fb_m
+  by (simp add: n_def reply_masters_rvk_fb_def
+                ball_ran_eq makeObject_cte isCap_simps)
+
 lemma valid_n:
   "valid_mdb_ctes n"
   by (simp add: valid_mdb_ctes_def dlist_n no_0_n mdb_chain_0_n
                 valid_badges_n caps_contained_n untyped_mdb_n
                 untyped_inc_n mdb_chunked_n valid_nullcaps_n ut_rev_n
-                class_links_n irq_control_n dist_z_n)
+                class_links_n irq_control_n dist_z_n
+                reply_masters_rvk_fb_n)
 
 end
 
@@ -2959,20 +3073,18 @@ proof -
       using not_0 n_less
       apply simp
       done
-    have bd[simp]: "objBitsKO val < word_bits"
-      using assms by (clarsimp simp: range_cover_def word_bits_def)
     have "ptr' + 2 ^ objBitsKO val - 1 \<le> ptr + of_nat n * 2 ^ objBitsKO val - 1"
       using cover
       apply (subst decomp)
       apply (simp add:add.assoc[symmetric])
       apply (simp add:p_assoc_help)
       apply (rule order_trans[OF word_plus_mono_left word_plus_mono_right])
-       using mem_p not_0
+         using mem_p not_0
          apply (clarsimp simp:new_cap_addrs_def shiftl_t2n)
          apply (rule word_plus_mono_right)
           apply (subst mult.commute)
           apply (rule word_mult_le_mono1[OF word_of_nat_le])
-          using n_less not_0
+            using n_less not_0
             apply (simp add:unat_of_nat_minus_1)
            apply (rule p2_gt_0[THEN iffD2])
            apply (simp add:word_bits_def range_cover_def)
@@ -2980,17 +3092,17 @@ proof -
           apply (clarsimp simp: unat_of_nat_minus_1[OF n_less(1) not_0])
           apply (rule nat_less_power_trans2
             [OF range_cover.range_cover_le_n_less(2),OF cover, folded word_bits_def])
-          apply (simp add:unat_of_nat_m1 less_imp_le)
-         apply (simp add:range_cover_def word_bits_def)
-        apply (rule machine_word_plus_mono_right_split[where sz = sz])
+           apply (simp add:unat_of_nat_m1 less_imp_le)
+          apply (simp add:range_cover_def word_bits_def)
+         apply (rule machine_word_plus_mono_right_split[where sz = sz])
           using range_cover.range_cover_compare[OF cover,where p = "unat (of_nat n - (1::machine_word))"]
-        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^objBitsKO val - 1"])
-     apply (subst p_assoc_help[symmetric])
-     apply (rule is_aligned_no_overflow)
-     apply (clarsimp simp:range_cover_def word_bits_def)
+          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^objBitsKO val - 1"])
+        apply (subst p_assoc_help[symmetric])
+        apply (rule is_aligned_no_overflow)
+        apply (clarsimp simp:range_cover_def word_bits_def)
         apply (erule aligned_add_aligned[OF _  is_aligned_mult_triv2]; simp)
        apply simp
       by (meson assms(1) is_aligned_add is_aligned_mult_triv2 is_aligned_no_overflow' range_cover_def)
@@ -3001,7 +3113,7 @@ proof -
     apply (frule(1) obj_range'_subset)
     apply (simp add: obj_range'_def)
     apply (cases "n = 0"; clarsimp simp:new_cap_addrs_def)
-   done
+    done
 qed
 
 lemma caps_no_overlapD'':
@@ -3009,75 +3121,72 @@ lemma caps_no_overlapD'':
    \<Longrightarrow> untypedRange c \<inter> {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1} \<noteq> {} \<longrightarrow>
        {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1} \<subseteq> untypedRange c"
   apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps caps_no_overlap''_def
-              simp del: atLeastAtMost_simps)
+        simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+        Int_atLeastAtMost atLeastatMost_empty_iff)
   apply (drule_tac x = cte in bspec)
     apply fastforce
   apply (erule(1) impE)
   apply blast
 done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma valid_untyped'_helper:
   assumes valid : "valid_cap' c s"
   and  cte_at : "cte_wp_at' (\<lambda>cap. cteCap cap = c) q s"
   and  cover  : "range_cover ptr sz (objBitsKO val) n"
   and  range  : "caps_no_overlap'' ptr sz s"
   and  pres   : "isUntypedCap c \<longrightarrow> usableUntypedRange c \<inter>  {ptr..ptr + of_nat n * 2 ^ objBitsKO val - 1} = {}"
-  shows "\<lbrakk>pspace_aligned' s; pspace_distinct' s;  pspace_bounded' s; pspace_no_overlap' ptr sz s\<rbrakk>
-          \<Longrightarrow> valid_cap' c (s\<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr val)
-                                                      (new_cap_addrs n ptr val) (ksPSpace s)\<rparr>)"
-proof -
-  note blah[simp del] = atLeastAtMost_simps
-  note cover' = range_cover_rel[where sbit' = "objBitsKO val",OF cover _ refl,simplified]
-  assume pn : "pspace_aligned' s" "pspace_distinct' s" "pspace_bounded' s"
-  and no_overlap: "pspace_no_overlap' ptr sz s"
+  shows "\<lbrakk>pspace_aligned' s; pspace_distinct' s; pspace_no_overlap' ptr sz s\<rbrakk>
+ \<Longrightarrow> valid_cap' c (s\<lparr>ksPSpace := foldr (\<lambda>addr. data_map_insert addr val) (new_cap_addrs n ptr val) (ksPSpace s)\<rparr>)"
+  proof -
+  note blah[simp del] = atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+        Int_atLeastAtMost atLeastatMost_empty_iff
+  assume pn : "pspace_aligned' s" "pspace_distinct' s"
+  and   no_overlap: "pspace_no_overlap' ptr sz s"
   show ?thesis
-    using pn pres no_overlap valid cover cte_wp_at_ctes_of[THEN iffD1,OF cte_at]
-      caps_no_overlapD''[OF cte_at range]
-    apply (clarsimp simp:valid_cap'_def retype_ko_wp_at')
-    apply (case_tac "cteCap cte"; simp add: valid_cap'_def cte_wp_at_obj_cases'
-                                  valid_pspace'_def retype_obj_at_disj' retype_ko_wp_at'
-                           split: zombie_type.split_asm)
-      apply (rename_tac arch_capability)
-      apply (case_tac arch_capability;
-             simp add: retype_obj_at_disj' typ_at_to_obj_at_arches
-                       page_table_at'_def page_directory_at'_def split del: if_split)
-      apply (fastforce simp: typ_at_to_obj_at_arches retype_obj_at_disj')
-     unfolding valid_untyped'_def
-     apply (intro allI)
-     apply (rule ccontr)
-     apply clarify
-     using cover[unfolded range_cover_def]
-     apply (clarsimp simp:isCap_simps retype_ko_wp_at' split:if_split_asm)
-      apply (thin_tac "\<forall>x. Q x" for Q)
-      apply (frule aligned_untypedRange_non_empty)
-       apply (simp add:isCap_simps)
-      apply (elim disjE)
-       apply (frule(1) obj_range'_subset)
-       apply (erule impE)
-        apply (drule(1) psubset_subset_trans)
-        apply (drule Int_absorb1[OF psubset_imp_subset])
-        apply (drule aligned_untypedRange_non_empty)
-         apply (simp add:isCap_simps)
-        apply (simp add:Int_ac)
-       apply (drule(1) subset_trans)
-       apply blast
-      apply (frule(1) obj_range'_subset_strong)
-      apply (drule(1) non_disjoing_subset)
-      apply blast
-     apply (thin_tac "\<forall>x. Q x" for Q)
-     apply (frule aligned_untypedRange_non_empty)
-      apply (simp add:isCap_simps)
-     apply (frule(1) obj_range'_subset)
-     apply (drule(1) subset_trans)
-     apply (erule impE)
-      apply clarsimp
-      apply blast
-     apply blast
+  using pn pres no_overlap valid cover cte_wp_at_ctes_of[THEN iffD1,OF cte_at]
+        caps_no_overlapD''[OF cte_at range]
+  apply (clarsimp simp:valid_cap'_def retype_ko_wp_at')
+  apply (case_tac "cteCap cte"; simp add: valid_cap'_def cte_wp_at_obj_cases'
+                                valid_pspace'_def retype_obj_at_disj'
+                         split: zombie_type.split_asm)
+   apply (rename_tac arch_capability)
+   apply (case_tac arch_capability;
+          simp add: retype_obj_at_disj' typ_at_to_obj_at_arches
+                    page_table_at'_def page_directory_at'_def split del: if_splits)
+    apply (fastforce simp: typ_at_to_obj_at_arches retype_obj_at_disj')
+                           unfolding valid_untyped'_def
+  apply (intro allI)
+  apply (rule ccontr)
+  apply clarify
+  using cover[unfolded range_cover_def]
+  apply (clarsimp simp:isCap_simps retype_ko_wp_at' split:if_split_asm)
+   apply (thin_tac "\<forall>x. Q x" for Q)
+   apply (frule aligned_untypedRange_non_empty)
+    apply (simp add:isCap_simps)
+   apply (elim disjE)
+    apply (frule(1) obj_range'_subset)
+    apply (erule impE)
+     apply (drule(1) psubset_subset_trans)
+     apply (drule Int_absorb1[OF psubset_imp_subset])
+     apply (drule aligned_untypedRange_non_empty)
+      apply (simp add:isCap_simps)
+     apply (simp add:Int_ac)
+    apply (drule(1) subset_trans)
+    apply blast
+   apply (frule(1) obj_range'_subset_strong)
+   apply (drule(1) non_disjoing_subset)
+   apply blast
+  apply (thin_tac "\<forall>x. Q x" for Q)
+  apply (frule aligned_untypedRange_non_empty)
+   apply (simp add:isCap_simps)
+  apply (frule(1) obj_range'_subset)
+  apply (drule(1) subset_trans)
+   apply (erule impE)
     apply clarsimp
-    apply (drule (3) retype_ko_wp_at'_not[where gbits=0, simplified, OF _ _ _ cover])
-    apply (erule notE, simp)
-    done
+    apply blast
+   apply blast
+  done
 qed
 
 definition caps_overlap_reserved' :: "word32 set \<Rightarrow> kernel_state \<Rightarrow> bool"
@@ -3086,17 +3195,13 @@ where
   (isUntypedCap (cteCap cte) \<longrightarrow> usableUntypedRange (cteCap cte) \<inter> S = {})"
 
 lemma createObjects_valid_pspace':
-  assumes  mko: "makeObjectKO dev us d ty = Some val"
-  and    max_d: "ty = Inr (APIObjectType TCBObject) \<longrightarrow> d \<le> maxDomain"
+  assumes  mko: "makeObjectKO dev ty = Some val"
   and    not_0: "n \<noteq> 0"
-  and     tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> sc_size_bounds us"
   and    cover: "range_cover ptr sz (objBitsKO val + gbits) n"
   shows "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
             \<and> caps_overlap_reserved' {ptr .. ptr + of_nat (n * 2^gbits * 2 ^ objBitsKO val ) - 1} s
             \<and> ptr \<noteq> 0\<rbrace>
-         createObjects' ptr n val gbits
-         \<lbrace>\<lambda>r. valid_pspace'\<rbrace>"
-  (* FIXME: clean this up *)
+  createObjects' ptr n val gbits \<lbrace>\<lambda>r. valid_pspace'\<rbrace>"
   apply (cut_tac not_0)
   apply (simp add: split_def createObjects'_def
                    lookupAround2_pspace_no
@@ -3125,9 +3230,7 @@ proof (intro conjI impI)
 
   assume pn: "pspace_no_overlap' ptr sz s"
      and vo: "valid_objs' s"
-     and vr: "valid_replies' s"
      and ad: "pspace_aligned' s" "pspace_distinct' s"
-     and bd: "pspace_bounded' s"
      and pc: "caps_no_overlap'' ptr sz s"
     and mdb: "valid_mdb' s"
     and p_0: "ptr \<noteq> 0"
@@ -3141,7 +3244,7 @@ proof (intro conjI impI)
 
   note cover' = range_cover_rel[where sbit' = "objBitsKO val",OF cover _ refl,simplified]
 
-  note ad' = retype_aligned_distinct'[OF ad bd pn cover']
+  note ad' = retype_aligned_distinct'[OF ad pn cover']
 
   note shift = range_cover.unat_of_nat_n_shift[OF cover,where gbits=gbits,simplified]
 
@@ -3157,7 +3260,7 @@ proof (intro conjI impI)
   using ad' shift
     by (simp add:field_simps)
 
-  note obj_at_disj = retype_obj_at_disj' [OF ad bd pn cover']
+  note obj_at_disj = retype_obj_at_disj' [OF ad pn cover']
 
   note obj_at_disj' = obj_at_disj [unfolded foldr_upd_app_if[folded data_map_insert_def]]
 
@@ -3172,7 +3275,7 @@ proof (intro conjI impI)
 
   have valid_cap: "\<And>cap q. \<lbrakk> s \<turnstile>' cap; cte_wp_at' (\<lambda>cte. cteCap cte = cap) q s \<rbrakk>
                       \<Longrightarrow> ?s' \<turnstile>' cap"
-     apply (rule valid_untyped'_helper[OF _ _ _ pc _ ad bd pn ])
+     apply (rule valid_untyped'_helper[OF _ _ _ pc _ ad pn ])
           apply simp+
         apply (subst mult.commute)
         apply (rule cover')
@@ -3183,13 +3286,13 @@ proof (intro conjI impI)
      apply simp
    done
 
-  show valid_objs: "valid_objs' ?s'" using vo tysc
+  show valid_objs: "valid_objs' ?s'" using vo
     apply (clarsimp simp: valid_objs'_def
                           foldr_upd_app_if[folded data_map_insert_def]
                    elim!: ranE
                    split: if_split_asm)
      apply (insert sym[OF mko])[1]
-     apply (clarsimp simp: makeObjectKO_def max_d
+     apply (clarsimp simp: makeObjectKO_def
                     split: bool.split_asm sum.split_asm
                            ARM_H.object_type.split_asm
                            apiobject_type.split_asm
@@ -3198,73 +3301,49 @@ proof (intro conjI impI)
     apply (drule bspec, erule ranI)
     apply (subst mult.commute)
     apply (case_tac obj; simp add: valid_obj'_def)
-          apply (rename_tac endpoint)
-          apply (case_tac endpoint; simp add: valid_ep'_def obj_at_disj')
-         apply (rename_tac notification)
-         apply (case_tac notification; simp add: valid_ntfn'_def valid_bound_tcb'_def obj_at_disj')
-         apply (rename_tac ntfn xa xb)
-         apply (case_tac ntfn, simp_all, (clarsimp simp: obj_at_disj' split:option.splits)+)
-        apply (rename_tac tcb)
-        apply (case_tac tcb, clarsimp simp add: valid_tcb'_def)
-        apply (frule pspace_alignedD' [OF _ ad(1)])
-        apply (frule pspace_distinctD' [OF _ ad(2)])
-        apply (simp add: objBits_simps)
-        apply (subst mult.commute)
-        apply (intro conjI ballI)
-            apply (clarsimp elim!: ranE)
-            apply (rule valid_cap[unfolded foldr_upd_app_if[folded data_map_insert_def]])
-             apply (fastforce)
-            apply (rule_tac ptr="x + xa" in cte_wp_at_tcbI', assumption+)
-             apply fastforce
-            apply simp
-           apply (rename_tac thread_state mcp priority inQ inRQ option vptr bound tcbsc tcbyt user_context)
-           apply (case_tac thread_state, simp_all add: valid_tcb_state'_def
-                                                       valid_bound_ntfn'_def obj_at_disj'
-                                                split: option.splits)[4]
-       apply (simp add: valid_cte'_def)
-       apply (frule pspace_alignedD' [OF _ ad(1)])
-       apply (frule pspace_distinctD' [OF _ ad(2)])
-       apply (simp add: objBits_simps')
-       apply (subst mult.commute)
-       apply (erule valid_cap[unfolded foldr_upd_app_if[folded data_map_insert_def]])
-       apply (erule(2) cte_wp_at_cteI'[unfolded cte_level_bits_def])
+        apply (rename_tac endpoint)
+        apply (case_tac endpoint; simp add: valid_ep'_def obj_at_disj')
+       apply (rename_tac notification)
+       apply (case_tac notification; simp add: valid_ntfn'_def valid_bound_tcb'_def obj_at_disj')
+       apply (rename_tac ntfn xa)
+       apply (case_tac ntfn, simp_all, (clarsimp simp: obj_at_disj' split:option.splits)+)
+      apply (rename_tac tcb)
+      apply (case_tac tcb, clarsimp simp add: valid_tcb'_def)
+      apply (frule pspace_alignedD' [OF _ ad(1)])
+      apply (frule pspace_distinctD' [OF _ ad(2)])
+      apply (simp add: objBits_simps)
+      apply (subst mult.commute)
+      apply (intro conjI ballI)
+       apply (clarsimp elim!: ranE)
+       apply (rule valid_cap[unfolded foldr_upd_app_if[folded data_map_insert_def]])
+        apply (fastforce)
+       apply (rule_tac ptr="x + xa" in cte_wp_at_tcbI', assumption+)
+        apply fastforce
        apply simp
-      apply (rename_tac arch_kernel_object)
-      apply (case_tac arch_kernel_object; simp)
-        apply (rename_tac asidpool)
-        apply (case_tac asidpool, clarsimp simp: page_directory_at'_def
-                                                 typ_at_to_obj_at_arches
-                                                 obj_at_disj')
-       apply (rename_tac pte)
-       apply (case_tac pte; simp add: valid_mapping'_def)
-      apply (rename_tac pde)
-      apply (case_tac pde; simp add: valid_mapping'_def page_table_at'_def
-                                     typ_at_to_obj_at_arches obj_at_disj')
-     apply (rename_tac sc)
-     apply (case_tac sc; simp add: valid_sched_context'_def valid_bound_tcb'_def obj_at_disj'
-                            split: option.splits)
-    apply (rename_tac reply)
-    apply (case_tac reply; fastforce simp: valid_reply'_def valid_bound_tcb'_def obj_at_disj'
-                    split: option.splits)
-    done
-
-  show valid_replies': "valid_replies' ?s'" using vr
-    apply (subst mult.commute)
-    apply (clarsimp simp: valid_replies'_def pred_tcb_at'_def obj_at_disj'
-                          foldr_upd_app_if[folded data_map_insert_def]
-                   elim!: ranE
-                   split: if_split_asm)
-    apply (insert sym[OF mko])[1]
-    apply (clarsimp simp: makeObjectKO_def projectKOs opt_map_def makeObject_reply
-                   split: bool.split_asm sum.split_asm
-                          ARM_H.object_type.split_asm
-                          apiobject_type.split_asm
-                          kernel_object.split_asm
-                          arch_kernel_object.split_asm
-                          if_splits option.splits)
-    apply fastforce
+      apply (rename_tac thread_state mcp priority bool option nat cptr vptr bound tcbprev tcbnext user_context)
+      apply (case_tac thread_state, simp_all add: valid_tcb_state'_def valid_bound_tcb'_def
+                                                  valid_bound_ntfn'_def obj_at_disj' opt_tcb_at'_def
+                                           split: option.splits)[4]
+     apply (simp add: valid_cte'_def)
+     apply (frule pspace_alignedD' [OF _ ad(1)])
+     apply (frule pspace_distinctD' [OF _ ad(2)])
+     apply (simp add: objBits_simps')
+     apply (subst mult.commute)
+     apply (erule valid_cap[unfolded foldr_upd_app_if[folded data_map_insert_def]])
+     apply (erule(2) cte_wp_at_cteI'[unfolded cte_level_bits_def])
+     apply simp
+    apply (rename_tac arch_kernel_object)
+    apply (case_tac arch_kernel_object; simp)
+      apply (rename_tac asidpool)
+      apply (case_tac asidpool, clarsimp simp: page_directory_at'_def
+                                               typ_at_to_obj_at_arches
+                                               obj_at_disj')
+     apply (rename_tac pte)
+     apply (case_tac pte; simp add: valid_mapping'_def)
+    apply (rename_tac pde)
+    apply (case_tac pde; simp add: valid_mapping'_def page_table_at'_def
+                                   typ_at_to_obj_at_arches obj_at_disj')
     done
-
   have not_0: "0 \<notin> set (new_cap_addrs (2 ^ gbits * n) ptr val)"
     using p_0
     apply clarsimp
@@ -3275,13 +3354,12 @@ proof (intro conjI impI)
     apply (simp add: valid_mdb'_def foldr_upd_app_if[folded data_map_insert_def])
     apply (subst mult.commute)
     apply (subst ctes_of_retype [OF mko ad])
-         apply (rule ad'[unfolded foldr_upd_app_if[folded data_map_insert_def]])+
-       apply (simp add: objBits_def[symmetric] new_cap_addrs_aligned [OF al])
-      using cover apply (clarsimp simp: range_cover_def word_bits_def)
+        apply (rule ad'[unfolded foldr_upd_app_if[folded data_map_insert_def]])+
+      apply (simp add: objBits_def[symmetric] new_cap_addrs_aligned [OF al])
      apply (rule ballI, drule subsetD [OF new_cap_addrs_subset [OF cover']])
      apply (insert pspace_no_overlap_disjoint' [OF ad(1) pn])
      apply (drule_tac x = x in orthD1)
-      apply (simp add:ptr_add_def p_assoc_help)
+       apply (simp add:ptr_add_def p_assoc_help)
      apply fastforce
     apply (fold makeObject_cte)
     apply (rule retype_mdb.valid_n)
@@ -3325,24 +3403,19 @@ proof (intro conjI impI)
     using not_0 no_0_obj'
     by (simp add: no_0_obj'_def data_map_ext field_simps foldr_upd_app_other)
 
-  show bounded': "pspace_bounded' ?s'"
-  using ad' shift range_cover.unat_of_nat_n_shift[OF cover,where gbits=gbits,simplified]
-    by (simp add: field_simps )
 qed
 
 abbreviation
  "injectKOS \<equiv> (injectKO :: ('a :: pspace_storable) \<Rightarrow> kernel_object)"
 
 lemma createObjects_valid_pspace_untyped':
-  assumes  mko: "makeObjectKO dev us d ty = Some val"
-  and    max_d: "ty = Inr (APIObjectType TCBObject) \<longrightarrow> d \<le> maxDomain"
+  assumes  mko: "makeObjectKO dev ty = Some val"
   and    not_0: "n \<noteq> 0"
-  and     tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> sc_size_bounds us"
   and    cover: "range_cover ptr sz (objBitsKO val + gbits) n"
   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 max_d not_0 tysc cover])
+  apply (wp createObjects_valid_pspace' [OF mko not_0 cover])
   apply simp
   done
 
@@ -3351,28 +3424,34 @@ lemma getObject_valid_pde'[wp]:
   apply (rule hoare_chain)
     apply (rule hoare_vcg_conj_lift)
      apply (rule getObject_ko_at, simp)
+     apply (simp add: objBits_simps archObjSize_def pdeBits_def)
     apply (rule getObject_inv[where P=valid_objs'])
+    apply (simp add: loadObject_default_inv)
    apply simp
   apply (clarsimp simp: projectKOs valid_obj'_def dest!: obj_at_valid_objs')
   done
 
 crunch copyGlobalMappings
   for valid_objs'[wp]: "valid_objs'"
-  and pspace_aligned'[wp]: "pspace_aligned'"
-  and pspace_distinct'[wp]: "pspace_distinct'"
-  and pspace_bounded'[wp]: "pspace_bounded'"
-  and valid_mdb[wp]: "valid_mdb'"
-  and no_0_obj' [wp]: no_0_obj'
   (ignore: storePDE wp: crunch_wps)
+crunch copyGlobalMappings
+  for pspace_aligned'[wp]: "pspace_aligned'"
+  (wp: crunch_wps)
+crunch copyGlobalMappings
+  for pspace_distinct'[wp]: "pspace_distinct'"
+  (wp: crunch_wps)
+
+lemmas storePDE_valid_mdb[wp]
+    = storePDE_ctes[where P=valid_mdb_ctes, folded valid_mdb'_def]
+crunch copyGlobalMappings
+  for valid_mdb[wp]: "valid_mdb'"
+  (wp: crunch_wps)
 
-lemma copyGlobalMappings_valid_replies'[wp]:
-  "\<lbrace>valid_replies' and pspace_aligned' and pspace_distinct'\<rbrace>
-   copyGlobalMappings pd
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>" (is "\<lbrace>?Pre\<rbrace> _ \<lbrace>_\<rbrace>")
-  unfolding copyGlobalMappings_def
-  by (wpsimp wp: mapM_x_inv_wp[where I="?Pre"])
+crunch copyGlobalMappings
+  for no_0_obj'[wp]: no_0_obj'
+  (wp: crunch_wps)
 
-lemma copyGlobalMappings_valid_pspace'[wp]:
+lemma copyGlobalMappings_valid_pspace[wp]:
   "\<lbrace>valid_pspace'\<rbrace> copyGlobalMappings pd \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   by (simp add: valid_pspace'_def | wp)+
 
@@ -3387,14 +3466,11 @@ proof -
   note unat_of_nat_shift = range_cover.unat_of_nat_n_shift[OF cover,where gbits=gbits,simplified]
   have cover' :"range_cover ptr sz (objBitsKO val) (n*2^gbits)"
     by (rule range_cover_rel[OF cover],simp+)
-  have bd: "objBitsKO val < word_bits"
-    using cover
-    by (simp add: range_cover_def word_bits_def)
   have upbound:" unat ((((of_nat n)::word32) * 2 ^ gbits)) * unat ((2::word32) ^ objBitsKO val) < 2 ^ word_bits"
-    using range_cover.range_cover_le_n_less[OF cover' le_refl] cover' bd
+    using range_cover.range_cover_le_n_less[OF cover' le_refl] cover'
     apply -
-      apply (drule nat_less_power_trans)
-       apply (simp add:range_cover_def)
+    apply (drule nat_less_power_trans)
+     apply (simp add:range_cover_def)
     apply (fold word_bits_def)
     using unat_of_nat_shift not_0
     apply (simp add:field_simps shiftl_t2n)
@@ -3407,63 +3483,63 @@ proof -
     using cover
     by (simp add:range_cover_def word_bits_def)
   thus ?thesis
-  apply -
-  apply (insert not_0 cover ptr_in bd)
-  apply (frule range_cover.range_cover_le_n_less[OF _ le_refl])
-  apply (fold word_bits_def)
-  apply (simp add:shiftL_nat )
-  apply (simp add:range_cover.unat_of_nat_n_shift)
-  apply (clarsimp simp:new_cap_addrs_def shiftl_t2n)
-  apply (rename_tac pa)
-  apply (rule word_plus_mono_right)
-    apply (rule order_trans)
-    apply (subst mult.commute)
-    apply (rule word_mult_le_iff[THEN iffD2])
-       apply (clarsimp simp:p2_gt_0 range_cover_def word_bits_def)
-      apply (drule range_cover_rel[where sbit' = "0"])
-        apply (simp+)[2]
-      apply (erule less_le_trans[OF range_cover.range_cover_le_n_less(2)])
-       apply (clarsimp simp:field_simps power_add)
-       apply (rule unat_le_helper)
-       apply (rule of_nat_mono_maybe_le[THEN iffD1])
-         using range_cover.range_cover_le_n_less[OF cover' le_refl]
-       apply (simp_all only:word_bits_def[symmetric])
-      apply simp
-     apply (drule nat_less_power_trans)
-      apply (simp add:range_cover_def word_bits_def)
-     apply (rule less_le_trans[OF mult_less_mono1])
-       apply (rule unat_mono)
-       apply (rule_tac y1= "pa" in  of_nat_mono_maybe'[THEN iffD1,rotated -1])
-         apply (assumption)
-        apply (simp add:word_bits_def)
-       apply (simp add:word_bits_def)
+    apply -
+    apply (insert not_0 cover ptr_in)
+    apply (frule range_cover.range_cover_le_n_less[OF _ le_refl])
+    apply (fold word_bits_def)
+    apply (simp add:shiftL_nat )
+    apply (simp add:range_cover.unat_of_nat_n_shift)
+    apply (clarsimp simp:new_cap_addrs_def shiftl_t2n)
+    apply (rename_tac pa)
+    apply (rule word_plus_mono_right)
+     apply (rule order_trans)
+      apply (subst mult.commute)
+      apply (rule word_mult_le_iff[THEN iffD2])
+         apply (clarsimp simp:p2_gt_0 range_cover_def word_bits_def)
+        apply (drule range_cover_rel[where sbit' = "0"])
+          apply (simp+)[2]
+        apply (erule less_le_trans[OF range_cover.range_cover_le_n_less(2)])
+         apply (clarsimp simp:field_simps power_add)
+         apply (rule unat_le_helper)
+         apply (rule of_nat_mono_maybe_le[THEN iffD1])
+           using range_cover.range_cover_le_n_less[OF cover' le_refl]
+           apply (simp_all only:word_bits_def[symmetric])
+        apply simp
+       apply (drule nat_less_power_trans)
+        apply (simp add:range_cover_def word_bits_def)
+       apply (rule less_le_trans[OF mult_less_mono1])
+         apply (rule unat_mono)
+         apply (rule_tac y1= "pa" in  of_nat_mono_maybe'[THEN iffD1,rotated -1])
+           apply (assumption)
+          apply (simp add:word_bits_def)
+         apply (simp add:word_bits_def)
+        apply simp
+       using unat_of_nat_shift
+       apply (simp add:field_simps shiftl_t2n)
       apply simp
-        using unat_of_nat_shift
-      apply (simp add:field_simps shiftl_t2n)
-     apply simp
-    apply (rule word_less_sub_1)
-    apply (simp add:power_add field_simps)
-    apply (subst mult.assoc[symmetric])
-    apply (rule word_mult_less_mono1)
-      apply (rule word_of_nat_less)
-      using unat_of_nat_shift
-      apply (simp add:shiftl_t2n field_simps)
-      apply (meson less_exp of_nat_less_pow_32 word_gt_a_gt_0)
-   using upbound
-   apply (simp add:word_bits_def)
-   apply (rule machine_word_plus_mono_right_split[where sz = sz])
-    apply (rule less_le_trans[rotated -1])
-     apply (rule range_cover.range_cover_compare_bound[OF cover'])
-    apply (simp add: unat_minus_one[OF not_0'])
-    using range_cover.unat_of_nat_n_shift[OF cover le_refl]
-    apply (simp add:shiftl_t2n power_add field_simps)
-  apply (simp add:range_cover_def word_bits_def)
-  done
+     apply (rule word_less_sub_1)
+     apply (simp add:power_add field_simps)
+     apply (subst mult.assoc[symmetric])
+     apply (rule word_mult_less_mono1)
+       apply (rule word_of_nat_less)
+       using unat_of_nat_shift
+       apply (simp add:shiftl_t2n field_simps)
+      apply (meson less_exp objBitsKO_bounded2 of_nat_less_pow_32 word_gt_a_gt_0)
+     using upbound
+     apply (simp add:word_bits_def)
+    apply (rule machine_word_plus_mono_right_split[where sz = sz])
+     apply (rule less_le_trans[rotated -1])
+      apply (rule range_cover.range_cover_compare_bound[OF cover'])
+     apply (simp add: unat_minus_one[OF not_0'])
+     using range_cover.unat_of_nat_n_shift[OF cover le_refl]
+     apply (simp add:shiftl_t2n power_add field_simps)
+    apply (simp add:range_cover_def word_bits_def)
+    done
 qed
 
 lemma createObjects_orig_ko_wp_at2':
   "\<lbrace>\<lambda>s. range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> P (ko_wp_at' P' p s)
       \<and> (P' val \<longrightarrow> P True)
       \<and> pspace_no_overlap' ptr sz s\<rbrace>
@@ -3510,7 +3586,7 @@ lemma createObjects_orig_ko_wp_at2':
 lemma createObjects_orig_obj_at2':
   "\<lbrace>\<lambda>s. n \<noteq> 0
       \<and> range_cover ptr sz (objBitsKO val + gbits) n
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> P (obj_at' P' p s)
       \<and> \<not> (case_option False P' (projectKO_opt val))
       \<and> pspace_no_overlap' ptr sz s\<rbrace>
@@ -3522,7 +3598,7 @@ lemma createObjects_orig_cte_wp_at2':
   "\<lbrace>\<lambda>s. P (cte_wp_at' P' p s)
       \<and> n \<noteq> 0
       \<and> range_cover ptr sz (objBitsKO val + gbits) n
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> \<not> (case_option False P' (projectKO_opt val))
       \<and> (\<forall>(getF, setF) \<in> ran tcb_cte_cases.
               \<not> (case_option False (P' \<circ> getF) (projectKO_opt val)))
@@ -3537,13 +3613,19 @@ lemma createObjects_orig_cte_wp_at2':
              | simp add: o_def cong: option.case_cong)+
   done
 
+lemma threadSet_cte_wp_at2'T:
+  assumes "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
+  shows "\<lbrace>\<lambda>s. P (cte_wp_at' P' p s)\<rbrace> threadSet F t \<lbrace>\<lambda>rv s. P (cte_wp_at' P' p s)\<rbrace>"
+  using assms by (rule threadSet_cte_wp_at'T)
+
+lemmas threadSet_cte_wp_at2' =
+  threadSet_cte_wp_at2'T [OF all_tcbI, OF ball_tcb_cte_casesI]
+
 lemma createNewCaps_cte_wp_at2:
   "\<lbrace>\<lambda>s. P (cte_wp_at' P' p s) \<and> \<not> P' makeObject
       \<and> n \<noteq> 0
-      \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> minSchedContextBits \<le> objsz)
       \<and> range_cover ptr sz (APIType_capBits ty objsz) n
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> pspace_no_overlap' ptr sz s\<rbrace>
      createNewCaps ty ptr n objsz dev
    \<lbrace>\<lambda>rv s. P (cte_wp_at' P' p s)\<rbrace>"
@@ -3554,19 +3636,24 @@ lemma createNewCaps_cte_wp_at2:
                            split del: if_split cong: if_cong)
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type; simp split del: if_split)
-              apply (rule hoare_pre, wp, simp add:createObjects_def)
-  by (wpsimp wp: createObjects_orig_cte_wp_at2'[where sz = sz] mapM_x_wp' split_del: if_split
-           simp: createObjects_def curDomain_def objBits_simps APIType_capBits_def
-    | simp add: projectKO_opts_defs makeObject_tcb tcb_cte_cases_def Let_def
-                scBits_simps objBits_if_dev objBits_simps
-                archObjSize_def pdBits_def pdeBits_def ptBits_def pteBits_def pageBits_def
-           split del: if_split
-    | simp)+
+            apply (rule hoare_pre, wp, simp add:createObjects_def)
+           apply ((wp createObjects_orig_cte_wp_at2'[where sz = sz]
+                     mapM_x_wp' threadSet_cte_wp_at2')+
+                   | assumption
+                   | clarsimp simp: APIType_capBits_def
+                                    projectKOs projectKO_opts_defs
+                                    makeObject_tcb tcb_cte_cases_def
+                                    pageBits_def archObjSize_def ptBits_def
+                                    pdBits_def createObjects_def curDomain_def
+                                    Let_def objBits_if_dev
+                         split del: if_split
+                   | simp add: objBits_simps pteBits_def pdeBits_def)+
+  done
 
 lemma createObjects_orig_obj_at':
   "\<lbrace>\<lambda>s. n \<noteq> 0
       \<and> range_cover ptr sz (objBitsKO val + gbits) n
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> obj_at' P p s
       \<and> pspace_no_overlap' ptr sz s\<rbrace>
   createObjects' ptr n val gbits \<lbrace>\<lambda>r. obj_at' P p\<rbrace>"
@@ -3610,7 +3697,7 @@ crunch doMachineOp
 
 lemma createObjects_orig_cte_wp_at':
   "\<lbrace>\<lambda>s. range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> cte_wp_at' P p s
       \<and> pspace_no_overlap' ptr sz s\<rbrace>
   createObjects' ptr n val gbits \<lbrace>\<lambda>r s. cte_wp_at' P p s\<rbrace>"
@@ -3622,9 +3709,7 @@ lemma createObjects_orig_cte_wp_at':
 lemma createNewCaps_cte_wp_at':
   "\<lbrace>\<lambda>s. cte_wp_at' P p s
       \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0
-      \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us)
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> pspace_no_overlap' ptr sz s\<rbrace>
      createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>rv. cte_wp_at' P p\<rbrace>"
@@ -3638,8 +3723,7 @@ lemma createNewCaps_cte_wp_at':
            apply (wp createObjects_orig_cte_wp_at'[where sz = sz] mapM_x_wp'
                      threadSet_cte_wp_at'T
                   | clarsimp simp: objBits_simps APIType_capBits_def createObjects_def curDomain_def
-                                   pageBits_def ptBits_def pdBits_def archObjSize_def pteBits_def
-                                   pdeBits_def scBits_simps
+                    pageBits_def ptBits_def pdBits_def archObjSize_def pteBits_def pdeBits_def
                   | intro conjI impI
                   | force simp: tcb_cte_cases_def)+
   done
@@ -3670,20 +3754,23 @@ lemma valid_cap'_range_no_overlap:
                     page_table_at'_def page_directory_at'_def)
    apply (fastforce simp: typ_at_to_obj_at_arches retype_obj_at_disj')
   apply (rename_tac word nat1 nat2)
-  apply (clarsimp simp: valid_untyped'_def retype_ko_wp_at'
-              simp del: atLeastAtMost_simps)
+  apply (clarsimp simp:valid_untyped'_def retype_ko_wp_at'
+        simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+        Int_atLeastAtMost atLeastatMost_empty_iff)
   apply (frule aligned_untypedRange_non_empty)
    apply (simp add:isCap_simps)
   apply (intro conjI impI)
    apply (intro allI)
    apply (drule_tac x = ptr' in spec)
    apply (rule ccontr)
-   apply (clarsimp simp del: atLeastAtMost_simps)
+   apply (clarsimp simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+                             Int_atLeastAtMost atLeastatMost_empty_iff)
    apply (erule disjE)
     apply (drule(2) disjoint_subset2 [OF obj_range'_subset])
     apply (drule(1) disjoint_subset2[OF psubset_imp_subset])
     apply (simp add: Int_absorb ptr_add_def p_assoc_help
-                del: atLeastAtMost_simps)
+                del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+                     Int_atLeastAtMost atLeastatMost_empty_iff)
    apply (drule(1) obj_range'_subset)
    apply (drule_tac A'=" {word + of_nat nat2..word + 2 ^ nat1 - 1}" in disjoint_subset[rotated])
     apply clarsimp
@@ -3696,14 +3783,13 @@ lemma valid_cap'_range_no_overlap:
   apply (intro allI)
   apply (drule_tac x = ptr' in spec)
   apply (rule ccontr)
-  apply (clarsimp simp del: atLeastAtMost_simps)
+  apply (clarsimp simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+                            Int_atLeastAtMost atLeastatMost_empty_iff)
   apply (drule(2) disjoint_subset2 [OF obj_range'_subset])
   apply (drule(1) disjoint_subset2)
   apply (simp add: Int_absorb ptr_add_def p_assoc_help
-              del: atLeastAtMost_simps)
-  apply (clarsimp simp: retype_ko_wp_at')
-    apply (drule (4) retype_ko_wp_at'_not[where gbits=0, simplified])
-  apply (erule notE, simp)
+              del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+                   Int_atLeastAtMost atLeastatMost_empty_iff)
   done
 
 lemma createObjects_cte_wp_at':
@@ -3728,13 +3814,11 @@ lemma createObjects_cte_wp_at':
 lemma createNewCaps_cte_wp_at:
   assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
   and not_0 : "n \<noteq> 0"
-  and  tysc : "ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                      \<longrightarrow> sc_size_bounds us"
   shows "\<lbrace>\<lambda>s. cte_wp_at' P p s \<and> valid_pspace' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
   createNewCaps ty ptr n us dev
   \<lbrace>\<lambda>_. cte_wp_at' P p\<rbrace>"
   apply (wp createNewCaps_cte_wp_at')
-  apply (auto simp: cover not_0 tysc)
+  apply (auto simp: cover not_0)
   done
 
 lemma createObjects_ret2:
@@ -3763,7 +3847,7 @@ lemma createObjects_state_refs_of'':
   "\<lbrace>\<lambda>s. n \<noteq> 0
         \<and> range_cover ptr sz (objBitsKO val + gbits) n
         \<and> P (state_refs_of' s) \<and> refs_of' val = {}
-        \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+        \<and> pspace_aligned' s \<and> pspace_distinct' s
         \<and> pspace_no_overlap' ptr sz s\<rbrace>
      createObjects' ptr n val gbits
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
@@ -3781,16 +3865,13 @@ lemma createObjects_state_refs_of'':
      apply simp+
   done
 
-crunch copyGlobalMappings, curDomain
-for state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
-and replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
+crunch copyGlobalMappings
+  for state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps)
 
 lemma createNewCaps_state_refs_of':
   assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
   and     not_0: "n \<noteq> 0"
-  and     tysc : "ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                         \<longrightarrow> sc_size_bounds us"
   shows
   "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s
         \<and> P (state_refs_of' s)\<rbrace>
@@ -3804,20 +3885,21 @@ lemma createNewCaps_state_refs_of':
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type; simp split del: if_split)
             apply (rule hoare_pre, wp, simp)
-           apply (insert cover not_0 tysc)
-           by (wp mapM_x_wp' createObjects_state_refs_of'' threadSet_state_refs_of'
-             | simp add: not_0 pspace_no_overlap'_def objBitsKO_def APIType_capBits_def
-                         valid_pspace'_def makeObject_tcb makeObject_endpoint objBits_def
-                         makeObject_notification pageBits_def ptBits_def pdBits_def
-                         archObjSize_def createObjects_def curDomain_def scBits_simps
-                         pdeBits_def pteBits_def makeObject_sc makeObject_reply
-             | intro conjI impI )+
+           apply (insert cover not_0)
+           apply (wp mapM_x_wp' createObjects_state_refs_of'' threadSet_state_refs_of'
+                    | simp add: not_0 pspace_no_overlap'_def objBitsKO_def APIType_capBits_def
+                                valid_pspace'_def makeObject_tcb makeObject_endpoint objBits_def
+                                makeObject_notification pageBits_def ptBits_def pdBits_def
+                                archObjSize_def createObjects_def curDomain_def
+                                pdeBits_def pteBits_def
+             | intro conjI impI)+
+  done
 
 lemma createObjects_iflive':
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> \<not> live' val
         \<and> n \<noteq> 0
         \<and> range_cover ptr sz (objBitsKO val + gbits) n
-        \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+        \<and> pspace_aligned' s \<and> pspace_distinct' s
         \<and> pspace_no_overlap' ptr sz s\<rbrace>
      createObjects' ptr n val gbits
    \<lbrace>\<lambda>rv s. if_live_then_nonz_cap' s\<rbrace>"
@@ -3829,114 +3911,15 @@ lemma createObjects_iflive':
              createObjects_orig_cte_wp_at')
   apply clarsimp
   apply (intro conjI allI impI)
-    apply simp_all
+  apply simp_all
   apply (rule ccontr)
   apply clarsimp
   apply (drule(1) if_live_then_nonz_capE')
   apply (fastforce simp: ex_nonz_cap_to'_def)
   done
 
-lemma createObjects_list_refs_of_replies'':
-  "\<lbrace>\<lambda>s. n \<noteq> 0
-        \<and> range_cover ptr sz (objBitsKO val + gbits) n
-        \<and> P (list_refs_of_replies' s)
-        \<and> (case val of KOReply r \<Rightarrow> replyNext_of r = None \<and> replyPrev r = None
-                     | _ \<Rightarrow> True)
-        \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
-        \<and> pspace_no_overlap' ptr sz s\<rbrace>
-     createObjects' ptr n val gbits
-   \<lbrace>\<lambda>rv s. P (list_refs_of_replies' s)\<rbrace>" (is "\<lbrace> \<lambda>s. _ \<and> _ \<and> ?Pre s \<rbrace> _ \<lbrace>\<lambda>_. _\<rbrace>")
-proof -
-  show ?thesis
-    apply (rule hoare_grab_asm)
-    apply (rule hoare_grab_asm)
-  proof -
-    assume not_0: "\<not> n = 0"
-      and cover: "range_cover ptr sz ((objBitsKO val) + gbits) n"
-    then show
-      "\<lbrace>\<lambda>s. ?Pre s\<rbrace>
-       createObjects' ptr n val gbits
-     \<lbrace>\<lambda>rv s. P (list_refs_of_replies' s)\<rbrace>"
-    proof -
-      have shiftr_not_zero:" 1 \<le> ((of_nat n)::word32) << gbits"
-        using range_cover_not_zero_shift[OF not_0 cover,where gbits = gbits]
-        by (simp add:word_le_sub1)
-      note unat_of_nat_shiftl = range_cover.unat_of_nat_n_shift[OF cover,where gbits = gbits,simplified]
-      show ?thesis
-        apply (clarsimp simp: createObjects'_def unless_def alignError_def split_def)
-        apply (wp | clarsimp simp del: fun_upd_apply)+
-        apply (erule ssubst[where P = P,rotated])
-        apply (clarsimp simp: shiftL_nat data_map_insert_def[symmetric]
-                              new_cap_addrs_fold'[OF shiftr_not_zero]
-                    simp del: data_map_insert_def)
-        using range_cover.unat_of_nat_n_shift[OF cover, where gbits=gbits, simplified]
-        apply simp
-        apply (rule ext)
-        apply (rule set_eqI)
-        apply (rule iffI; clarsimp simp: map_set_def opt_map_def foldr_upd_app_if
-                                         projectKO_opt_reply list_refs_of_reply'_def
-                                  split: option.splits if_split_asm)
-         apply (cases val; fastforce)
-        apply (intro conjI impI)
-         apply clarsimp
-         apply (frule_tac x=x in retype_obj_at'_not[OF _ _ _ cover, where P=\<top>], simp+)
-          apply (simp add: semiring_normalization_rules(7))
-         apply (erule notE)
-         apply (clarsimp simp: obj_at'_def projectKOs)
-         apply (frule pspace_alignedD'; clarsimp)
-         apply (frule pspace_distinctD'; clarsimp)
-         apply (frule pspace_boundedD'; clarsimp)
-         apply (clarsimp split: kernel_object.splits)
-                 apply (rule_tac x=x2a in exI)
-                 apply (fastforce simp: projectKO_opts_defs)+
-        apply (intro allI impI)
-        apply (split kernel_object.split_asm; simp add: get_refs_def2)
-        apply (frule_tac x=x in retype_obj_at'_not[OF _ _ _ cover, where P=\<top>], simp+)
-         apply (simp add: semiring_normalization_rules(7))
-        apply (erule notE)
-        apply (clarsimp simp: obj_at'_def projectKOs)
-        apply (frule pspace_alignedD'; clarsimp)
-        apply (frule pspace_distinctD'; clarsimp)
-        apply (frule pspace_boundedD'; clarsimp)
-        apply (clarsimp split: kernel_object.splits)
-        apply (rule_tac x=x2a in exI)
-        apply (fastforce simp: projectKO_opts_defs)
-        done
-    qed
-  qed
-qed
-
-lemma createNewCaps_list_refs_of_replies':
-  assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
-  and     not_0: "n \<noteq> 0"
-  and     tysc : "ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                         \<longrightarrow> sc_size_bounds us"
-  shows
-  "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s
-        \<and> P (list_refs_of_replies' s)\<rbrace>
-     createNewCaps ty ptr n us dev
-   \<lbrace>\<lambda>rv s. P (list_refs_of_replies' s)\<rbrace>"
-  unfolding createNewCaps_def
-  apply (clarsimp simp: ARM_H.toAPIType_def
-             split del: if_split)
-  apply (cases ty; simp add: createNewCaps_def Arch_createNewCaps_def
-                        split del: if_split)
-        apply (rename_tac apiobject_type)
-        apply (case_tac apiobject_type; simp split del: if_split)
-            apply (rule hoare_pre, wp, simp)
-           apply (insert cover not_0 tysc)
-           apply (wpsimp wp: mapM_x_wp' createObjects_list_refs_of_replies''
-                       simp: curDomain_def)
-           by (wpsimp wp: mapM_x_wp' createObjects_list_refs_of_replies''[simplified o_def]
-             | simp add: not_0 pspace_no_overlap'_def objBitsKO_def APIType_capBits_def
-                         valid_pspace'_def makeObject_tcb makeObject_endpoint objBits_def
-                         makeObject_notification pageBits_def ptBits_def pdBits_def
-                         archObjSize_def createObjects_def curDomain_def o_def scBits_simps
-                         pdeBits_def pteBits_def makeObject_sc makeObject_reply
-             | intro conjI impI )+
-
 crunch copyGlobalMappings
- for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
   (wp: updateObject_default_inv crunch_wps)
 crunch copyGlobalMappings
   for ksReadyQueuesL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
@@ -3944,9 +3927,6 @@ crunch copyGlobalMappings
 crunch copyGlobalMappings
   for ksReadyQueuesL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (wp: updateObject_default_inv crunch_wps)
-crunch copyGlobalMappings
- for ksReleaseQueue[wp]: "\<lambda>s. P (ksReleaseQueue s)"
-  (wp: updateObject_default_inv crunch_wps)
 
 crunch copyGlobalMappings
   for valid_idle'[wp]: "valid_idle'"
@@ -3960,31 +3940,30 @@ crunch copyGlobalMappings
 lemma createNewCaps_iflive'[wp]:
   assumes cover: "range_cover ptr sz (APIType_capBits ty us) n"
   and     not_0: "n \<noteq> 0"
-  and     tysc : "ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                         \<longrightarrow> sc_size_bounds us"
   shows
   "\<lbrace>\<lambda>s. valid_pspace' s \<and> pspace_no_overlap' ptr sz s
         \<and> if_live_then_nonz_cap' s\<rbrace>
      createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>rv s. if_live_then_nonz_cap' s\<rbrace>"
   unfolding createNewCaps_def
-  apply (insert cover tysc)
-  apply (clarsimp simp: toAPIType_def)
+  apply (insert cover)
+  apply (clarsimp simp: toAPIType_def ARM_H.toAPIType_def)
   apply (cases ty, simp_all add: createNewCaps_def Arch_createNewCaps_def
                       split del: if_split)
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type, simp_all split del: if_split)[1]
-              apply (rule hoare_pre, wp, simp)
-  by (wp mapM_x_wp' createObjects_iflive' threadSet_iflive'
-    | simp add: not_0 pspace_no_overlap'_def createObjects_def
-                valid_pspace'_def makeObject_tcb makeObject_endpoint
-                makeObject_notification objBitsKO_def curDomain_def scBits_simps
-                live_ntfn'_def live_sc'_def live_reply'_def makeObject_sc
-                APIType_capBits_def objBits_def pageBits_def makeObject_reply
-                archObjSize_def ptBits_def pdBits_def pteBits_def pdeBits_def
-        split del: if_split
-    | simp split: if_split
-    | fastforce)+
+            apply (rule hoare_pre, wp, simp)
+           apply (wp mapM_x_wp' createObjects_iflive' threadSet_iflive'
+                | simp add: not_0 pspace_no_overlap'_def createObjects_def
+                                valid_pspace'_def makeObject_tcb makeObject_endpoint
+                                 makeObject_notification objBitsKO_def
+                                 APIType_capBits_def objBits_def pageBits_def
+                                 archObjSize_def ptBits_def pdBits_def
+                                 pteBits_def pdeBits_def
+                                 curDomain_def split del:if_split
+                | simp split: if_split
+                | fastforce)+
+  done
 
 lemma createObjects_pspace_only:
   "\<lbrakk> \<And>f s. P (ksPSpace_update f s) = P s \<rbrakk>
@@ -3998,10 +3977,6 @@ lemma createObjects'_qs[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> createObjects' ptr n val gbits \<lbrace>\<lambda>rv s. P (ksReadyQueues s)\<rbrace>"
   by (rule createObjects_pspace_only, simp)
 
-lemma createObjects'_rlq[wp]:
-  "\<lbrace>\<lambda>s. P (ksReleaseQueue s)\<rbrace> createObjects' ptr n val gbits \<lbrace>\<lambda>rv s. P (ksReleaseQueue s)\<rbrace>"
-  by (rule createObjects_pspace_only, simp)
-
 lemma createObjects'_qsL1[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> createObjects' ptr n val gbits \<lbrace>\<lambda>rv s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
   by (rule createObjects_pspace_only, simp)
@@ -4010,9 +3985,17 @@ lemma createObjects'_qsL2[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> createObjects' ptr n val gbits \<lbrace>\<lambda>rv s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
   by (rule createObjects_pspace_only, simp)
 
+(* FIXME move these 2 to TcbAcc_R *)
+lemma threadSet_qsL1[wp]:
+  "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
+  by (simp add: threadSet_def | wp updateObject_default_inv)+
+
+lemma threadSet_qsL2[wp]:
+  "\<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
+  by (simp add: threadSet_def | wp updateObject_default_inv)+
+
 crunch createObjects, createNewCaps
   for qs[wp]: "\<lambda>s. P (ksReadyQueues s)"
-  and rlqs[wp]: "\<lambda>s. P (ksReleaseQueue s)"
   and qsL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
   and qsL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (simp: crunch_simps wp: crunch_wps)
@@ -4067,7 +4050,7 @@ lemma copyGlobalMappings_ko_wp_at:
      apply (simp add: objBits_simps archObjSize_def)
     apply (simp add: pdeBits_def)
    apply (simp cong: if_cong split del: if_split)
-   apply (wp getObject_inv | simp split del: if_split)+
+   apply (wp getObject_inv loadObject_default_inv | simp split del: if_split)+
    apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
   apply (wp | simp)+
   done
@@ -4076,20 +4059,20 @@ lemma threadSet_ko_wp_at2':
   "\<lbrace>\<lambda>s. P (ko_wp_at' P' p s) \<and> (\<forall>tcb_x :: tcb. P' (injectKO (F tcb_x)) = P' (injectKO tcb_x))\<rbrace>
      threadSet F ptr
    \<lbrace>\<lambda>_ s. P (ko_wp_at' P' p s)\<rbrace>"
-  apply (simp add: threadSet_def split del: if_split)
-  apply (wp setObject_ko_wp_at getObject_tcb_wp | simp add: objBits_simps')+
-  apply (auto simp: ko_wp_at'_def obj_at'_def projectKOs)
-  done
+apply (simp add: threadSet_def split del: if_split)
+apply (wp setObject_ko_wp_at getObject_tcb_wp | simp add: objBits_simps')+
+apply (auto simp: ko_wp_at'_def obj_at'_def projectKOs)
+done
 
 lemma threadSet_ko_wp_at2'_futz:
   "\<lbrace>\<lambda>s. P (ko_wp_at' P' p s) \<and> obj_at' Q ptr s
-           \<and> (\<forall>tcb_x :: tcb. Q tcb_x \<longrightarrow> P' (injectKO (F tcb_x)) = P' (injectKO tcb_x))\<rbrace>
-       threadSet F ptr
-     \<lbrace>\<lambda>_ s. P (ko_wp_at' P' p s)\<rbrace>"
-  apply (simp add: threadSet_def split del: if_split)
-  apply (wp setObject_ko_wp_at getObject_tcb_wp | simp add: objBits_simps')+
-  apply (auto simp: ko_wp_at'_def obj_at'_def projectKOs)
-  done
+         \<and> (\<forall>tcb_x :: tcb. Q tcb_x \<longrightarrow> P' (injectKO (F tcb_x)) = P' (injectKO tcb_x))\<rbrace>
+     threadSet F ptr
+   \<lbrace>\<lambda>_ s. P (ko_wp_at' P' p s)\<rbrace>"
+apply (simp add: threadSet_def split del: if_split)
+apply (wp setObject_ko_wp_at getObject_tcb_wp | simp add: objBits_simps')+
+apply (auto simp: ko_wp_at'_def obj_at'_def projectKOs)
+done
 
 lemma mapM_x_threadSet_createNewCaps_futz:
   "\<lbrace>\<lambda>s. P (ko_wp_at' P' p s) \<and> (\<forall>addr\<in>set addrs. obj_at' (\<lambda>tcb. \<not>tcbQueued tcb \<and> tcbState tcb = Inactive) addr s)
@@ -4108,7 +4091,7 @@ lemma mapM_x_threadSet_createNewCaps_futz:
 lemma createObjects_makeObject_not_tcbQueued:
   assumes "range_cover ptr sz (objBitsKO tcb) n"
   assumes "n \<noteq> 0" "tcb = injectKO (makeObject::tcb)"
-  shows "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s\<rbrace>
+  shows "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
            createObjects ptr n tcb 0
          \<lbrace>\<lambda>rv s. \<forall>addr\<in>set rv. obj_at' (\<lambda>tcb. \<not> tcbQueued tcb \<and> tcbState tcb = Structures_H.thread_state.Inactive) addr s\<rbrace>"
   apply (rule hoare_strengthen_post[OF createObjects_ko_at_strg[where 'a=tcb]])
@@ -4119,31 +4102,29 @@ lemma createObjects_makeObject_not_tcbQueued:
 
 lemma createObjects_ko_wp_at2:
   "\<lbrace>\<lambda>s. range_cover ptr sz (objBitsKO ko + gbits) n \<and> n \<noteq> 0
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> P (ko_wp_at' P' p s)
       \<and> (P' ko \<longrightarrow> P True)
       \<and> pspace_no_overlap' ptr sz s\<rbrace>
     createObjects ptr n ko gbits
    \<lbrace>\<lambda>_ s. P (ko_wp_at' P' p s)\<rbrace>"
-  apply (simp add: createObjects_def)
-  apply (wp createObjects_orig_ko_wp_at2')
-  apply auto
-  done
+apply (simp add: createObjects_def)
+apply (wp createObjects_orig_ko_wp_at2')
+apply auto
+done
 
 lemma createNewCaps_ko_wp_atQ':
   "\<lbrace>(\<lambda>s. P (ko_wp_at' P' p s)
        \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0
-       \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us)
-       \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+       \<and> pspace_aligned' s \<and> pspace_distinct' s
        \<and> pspace_no_overlap' ptr sz s)
        and K (\<forall>pde_x :: pde. P' (injectKO pde_x)
                    \<longrightarrow> (\<forall>pde_y :: pde. P' (injectKO pde_y)))
        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 (\<lambda>s. \<forall>v. makeObjectKO dev us (ksCurDomain s) (Inr ty) = Some v
+       and K (\<forall>v. makeObjectKO d (Inr ty) = Some v
                  \<longrightarrow> P' v \<longrightarrow> P True)\<rbrace>
-     createNewCaps ty ptr n us dev
+     createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv s. P (ko_wp_at' P' p s)\<rbrace>"
   apply (rule hoare_name_pre_state)
   apply (clarsimp simp: createNewCaps_def ARM_H.toAPIType_def
@@ -4153,14 +4134,19 @@ lemma createNewCaps_ko_wp_atQ':
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type, simp_all split del: if_split)[1]
             apply (rule hoare_pre, wp, simp)
-  by (wpsimp wp: mapM_x_wp' createObjects_makeObject_not_tcbQueued
-                 createObjects_obj_at createObjects_ko_wp_at2[where sz=sz]
-                 copyGlobalMappings_ko_wp_at[where v="\<forall>pde :: pde. P' (injectKO pde)"]
-           split_del: if_split
-           simp: curDomain_def APIType_capBits_def objBitsKO_def objBits_def makeObjectKO_def
-                 pageBits_def pdBits_def ptBits_def scBits_simps
-                 pteBits_def pdeBits_def sc_size_bounds_def archObjSize_def
-    | split if_split_asm[where Q=dev] | fastforce)+
+           apply ((wp mapM_x_threadSet_createNewCaps_futz
+                     mapM_x_wp'
+                     createObjects_obj_at
+                     createObjects_ko_wp_at2 createObjects_makeObject_not_tcbQueued
+                     copyGlobalMappings_ko_wp_at[where v="\<forall>pde :: pde. P' (injectKO pde)"]
+                   | simp add: makeObjectKO_def objBitsKO_def archObjSize_def APIType_capBits_def
+                               objBits_def pageBits_def pdBits_def ptBits_def curDomain_def
+                               pteBits_def pdeBits_def
+                          split del: if_split
+                   | split if_split_asm[where Q=d]
+                   | intro conjI impI | fastforce)+)
+  done
+
 
 lemmas createNewCaps_ko_wp_at'
     = createNewCaps_ko_wp_atQ'[simplified, unfolded fold_K]
@@ -4175,34 +4161,29 @@ lemmas createNewCaps_obj_at2 =
 lemma createNewCaps_obj_at'':
   "\<lbrace>\<lambda>s. obj_at' (P :: ('a :: pspace_storable) \<Rightarrow> bool) p s
        \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0
-       \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+       \<and> pspace_aligned' s \<and> pspace_distinct' s
        \<and> pspace_no_overlap' ptr sz s
-       \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us)
        \<and> (koType(TYPE('a)) = koType(TYPE(pde))
                \<longrightarrow> (\<forall>x. P x)
                 \<and> (\<forall>pde :: pde. \<exists>x :: 'a. injectKO x = injectKO pde))
-       \<and> (\<forall>tcb d. \<not>tcbQueued tcb \<and> tcbState tcb = Inactive
-               \<longrightarrow> ((\<exists>obj :: 'a. injectKOS obj = KOTCB (tcb\<lparr>tcbDomain := d\<rparr>) \<and> P obj)
-                       \<longleftrightarrow> (\<exists>obj :: 'a. injectKOS obj = KOTCB tcb \<and> P obj)))\<rbrace>
+       \<and> (\<forall>tcb d. \<not>tcbQueued tcb \<and> tcbState tcb = Inactive \<longrightarrow> ((\<exists>obj :: 'a. injectKOS obj = KOTCB (tcb\<lparr>tcbDomain := d\<rparr>) \<and> P obj) \<longleftrightarrow> (\<exists>obj :: 'a. injectKOS obj = KOTCB tcb \<and> P obj)))\<rbrace>
      createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv s. obj_at' P p s\<rbrace>"
   apply (simp add: obj_at'_real_def)
   apply (wp createNewCaps_ko_wp_at')
   apply clarsimp
   apply (intro conjI impI)
-     apply simp+
-   apply (clarsimp simp: projectKOs dest!: iffD1 [OF project_koType, OF exI])
-   apply (clarsimp simp:project_inject)+
-  done
+    apply simp+
+    apply clarsimp
+  apply (clarsimp simp: projectKOs dest!: iffD1 [OF project_koType, OF exI])
+  apply (clarsimp simp:project_inject)+
+done
 
 lemma createNewCaps_obj_at':
   "\<lbrace>\<lambda>s. obj_at' (P :: ('a :: pspace_storable) \<Rightarrow> bool) p s
        \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0
-       \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+       \<and> pspace_aligned' s \<and> pspace_distinct' s
        \<and> pspace_no_overlap' ptr sz s
-       \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us)
        \<and> koType(TYPE('a)) \<noteq> koType(TYPE(pde))
        \<and> (\<forall>tcb d. \<not>tcbQueued tcb \<and> tcbState tcb = Inactive \<longrightarrow> ((\<exists>obj :: 'a. injectKOS obj = KOTCB (tcb\<lparr>tcbDomain := d\<rparr>) \<and> P obj) \<longleftrightarrow> (\<exists>obj :: 'a. injectKOS obj = KOTCB tcb \<and> P obj)))\<rbrace>
      createNewCaps ty ptr n us d
@@ -4217,8 +4198,6 @@ lemma createNewCaps_cur:
   "\<lbrakk>range_cover ptr sz (APIType_capBits ty us) n ; n \<noteq> 0\<rbrakk> \<Longrightarrow>
    \<lbrace>\<lambda>s. valid_pspace' s \<and>
         pspace_no_overlap' ptr sz s \<and>
-        (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us) \<and>
         cur_tcb' s\<rbrace>
       createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
@@ -4238,8 +4217,6 @@ lemma createNewCaps_ifunsafe':
   "\<lbrace>\<lambda>s. valid_pspace' s \<and>
         pspace_no_overlap' ptr sz s \<and>
         range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0 \<and>
-        (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us) \<and>
         if_unsafe_then_cap' s\<rbrace>
       createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv s. if_unsafe_then_cap' s\<rbrace>"
@@ -4249,8 +4226,10 @@ lemma createNewCaps_ifunsafe':
    apply (rule hoare_use_eq_irq_node' [OF createNewCaps_ksInterrupt])
    apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift
              createNewCaps_cte_wp_at2 hoare_vcg_ex_lift)
-  by (auto simp: makeObject_cte pspace_no_overlap'_def sc_size_bounds_def
-                valid_pspace'_def)
+  apply (simp add: makeObject_cte pspace_no_overlap'_def
+                   valid_pspace'_def)
+  apply auto
+  done
 
 lemma createObjects_nosch'[wp]:
   "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace>
@@ -4277,10 +4256,10 @@ lemma createObjects_idle':
   apply (rule hoare_pre)
    apply (clarsimp simp add: valid_idle'_def pred_tcb_at'_def)
    apply (rule hoare_vcg_conj_lift)
-   apply (rule hoare_as_subst [OF createObjects'_it])
-   apply (wp createObjects_orig_obj_at'
-             createObjects_orig_cte_wp_at2'
-             hoare_vcg_all_lift | simp)+
+    apply (rule hoare_as_subst [OF createObjects'_it])
+    apply (wp createObjects_orig_obj_at'
+              createObjects_orig_cte_wp_at2'
+              hoare_vcg_all_lift | simp)+
   apply (clarsimp simp: valid_idle'_def projectKOs o_def
                         pred_tcb_at'_def valid_pspace'_def
                   cong: option.case_cong)
@@ -4289,8 +4268,6 @@ lemma createObjects_idle':
 
 lemma createNewCaps_idle'[wp]:
   "\<lbrace>valid_idle' and valid_pspace' and pspace_no_overlap' ptr sz
-       and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us)
        and K (range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0)\<rbrace>
    createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
@@ -4299,27 +4276,30 @@ lemma createNewCaps_idle'[wp]:
              split del: if_split)
   apply (cases ty, simp_all add: Arch_createNewCaps_def
                       split del: if_split)
-         apply (rename_tac apiobject_type)
-         apply (case_tac apiobject_type, simp_all split del: if_split)[1]
-  by (wpsimp wp: createObjects_idle'[where sz=sz] mapM_x_wp' split_del: if_split
-           simp: curDomain_def APIType_capBits_def createObjects_def
-    | simp add: tcb_cte_cases_def projectKO_opt_tcb projectKO_opt_cte makeObject_tcb makeObject_cte
-                objBits_def objBitsKO_def ptBits_def pdBits_def pteBits_def pdeBits_def pageBits_def
-                scBits_simps archObjSize_def)+
+        apply (rename_tac apiobject_type)
+        apply (case_tac apiobject_type, simp_all split del: if_split)[1]
+            apply wpsimp
+           apply (wpsimp wp: mapM_x_wp' createObjects_idle' threadSet_idle'
+                  | simp add: projectKO_opt_tcb projectKO_opt_cte
+                              makeObject_cte makeObject_tcb archObjSize_def
+                              tcb_cte_cases_def objBitsKO_def APIType_capBits_def
+                              ptBits_def pdBits_def pageBits_def objBits_def
+                              createObjects_def pteBits_def pdeBits_def
+                  | intro conjI impI
+                  | clarsimp simp: curDomain_def)+
+  done
 
 crunch createNewCaps
   for ksArch[wp]: "\<lambda>s. P (ksArchState s)"
   (simp: crunch_simps unless_def wp: crunch_wps)
 crunch createNewCaps
- for gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
+  for gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
   (simp: crunch_simps unless_def wp: crunch_wps updateObject_default_inv)
 
 lemma createNewCaps_global_refs':
   "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0
-       \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+       \<and> pspace_aligned' s \<and> pspace_distinct' s
        \<and> pspace_no_overlap' ptr sz s \<and> valid_global_refs' s
-       \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us)
        \<and> 0 < gsMaxObjectSize s\<rbrace>
      createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
@@ -4335,7 +4315,8 @@ lemma createNewCaps_global_refs':
    apply (rule hoare_use_eq [where f=irq_node', OF createNewCaps_ksInterrupt])
    apply (rule hoare_use_eq [where f=gsMaxObjectSize], wp)
    apply (wp hoare_vcg_all_lift createNewCaps_cte_wp_at2[where sz=sz])
-  apply (clarsimp simp: cte_wp_at_ctes_of global_refs'_def sc_size_bounds_def makeObject_cte)
+  apply (clarsimp simp: cte_wp_at_ctes_of global_refs'_def
+                        makeObject_cte)
   apply (auto simp: linorder_not_less ball_ran_eq)
   done
 
@@ -4346,9 +4327,7 @@ lemma koTypeOf_eq_UserDataT:
 
 lemma createNewCaps_valid_arch_state:
   "\<lbrace>(\<lambda>s. valid_arch_state' s \<and> valid_pspace' s \<and> pspace_no_overlap' ptr sz s
-        \<and> (tp = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> us > 0)
-        \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us))
+        \<and> (tp = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> us > 0))
        and K (range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0)\<rbrace>
      createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. valid_arch_state'\<rbrace>"
@@ -4390,9 +4369,7 @@ lemma valid_irq_handlers_cte_wp_at_form':
 
 lemma createNewCaps_irq_handlers':
   "\<lbrace>valid_irq_handlers' and pspace_no_overlap' ptr sz
-       and pspace_aligned' and pspace_distinct' and pspace_bounded'
-       and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                   \<longrightarrow> sc_size_bounds us)
+       and pspace_aligned' and pspace_distinct'
        and K (range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0)\<rbrace>
      createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. valid_irq_handlers'\<rbrace>"
@@ -4400,7 +4377,7 @@ lemma createNewCaps_irq_handlers':
    apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift
              createNewCaps_cte_wp_at2)
   apply (clarsimp simp: makeObject_cte)
-  apply (auto simp: sc_size_bounds_def)
+  apply auto
   done
 
 lemma valid_pde_mappings'_def3:
@@ -4413,7 +4390,7 @@ lemma valid_pde_mappings'_def3:
 
 lemma createObjects'_pde_mappings'[wp]:
   "\<lbrace>\<lambda>s. valid_pde_mappings' s \<and> range_cover ptr sz (objBitsKO val + gbits) n  \<and> n \<noteq> 0
-            \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+            \<and> pspace_aligned' s \<and> pspace_distinct' s
             \<and> pspace_no_overlap' ptr sz s
             \<and> (\<forall>pde. projectKO_opt val = Some pde \<longrightarrow> pde = InvalidPDE)\<rbrace>
        createObjects' ptr n val gbits
@@ -4429,7 +4406,7 @@ lemma createObjects'_pde_mappings'[wp]:
 
 lemma createObjects_pde_mappings'[wp]:
   "\<lbrace>\<lambda>s. valid_pde_mappings' s \<and> range_cover ptr sz (objBitsKO ko + gbits) n  \<and> n \<noteq> 0
-            \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+            \<and> pspace_aligned' s \<and> pspace_distinct' s
             \<and> pspace_no_overlap' ptr sz s
             \<and> (\<forall>pde. projectKO_opt ko = Some pde \<longrightarrow> pde = InvalidPDE)\<rbrace>
        createObjects ptr n ko gbits
@@ -4475,10 +4452,8 @@ lemma mapM_x_copyGlobalMappings_pde_mappings':
 
 lemma createNewCaps_pde_mappings'[wp]:
   "\<lbrace>\<lambda>s. valid_pde_mappings' s \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0
-            \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                 \<longrightarrow> sc_size_bounds us)
             \<and> valid_arch_state' s
-            \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+            \<and> pspace_aligned' s \<and> pspace_distinct' s
             \<and> pspace_no_overlap' ptr sz s\<rbrace>
        createNewCaps ty ptr n us d
    \<lbrace>\<lambda>_. valid_pde_mappings'\<rbrace>"
@@ -4486,7 +4461,9 @@ lemma createNewCaps_pde_mappings'[wp]:
               split del: if_split cong: option.case_cong
                                         object_type.case_cong)
   apply (rule hoare_pre)
-   apply (wp mapM_x_copyGlobalMappings_pde_mappings' | wpc
+   apply (wp mapM_x_copyGlobalMappings_pde_mappings'
+             mapM_x_wp'[where f="\<lambda>r. doMachineOp (m r)" for m]
+         | wpc
          | simp split del: if_split)+
     apply (rule_tac P="range_cover ptr sz (APIType_capBits ty us) n \<and> n\<noteq> 0" in hoare_gen_asm)
     apply (rule hoare_strengthen_post)
@@ -4502,8 +4479,9 @@ lemma createNewCaps_pde_mappings'[wp]:
   apply (case_tac ty; simp)
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type)
-  by (auto simp: ARM_H.toAPIType_def objBits_simps ptBits_def pageBits_def pteBits_def pdeBits_def
-                 makeObject_pde valid_arch_state'_def pdBits_def page_directory_at'_def scBits_simps)
+  apply (auto simp: ARM_H.toAPIType_def objBits_simps ptBits_def pageBits_def pteBits_def pdeBits_def
+                    makeObject_pde valid_arch_state'_def pdBits_def page_directory_at'_def)
+  done
 
 lemma createObjects'_irq_states' [wp]:
   "\<lbrace>valid_irq_states'\<rbrace> createObjects' a b c d \<lbrace>\<lambda>_. valid_irq_states'\<rbrace>"
@@ -4519,6 +4497,9 @@ crunch createNewCaps
 crunch createObjects
   for ksMachine[wp]: "\<lambda>s. P (ksMachineState s)"
   (simp: crunch_simps unless_def)
+crunch createObjects
+  for cur_domain[wp]: "\<lambda>s. P (ksCurDomain s)"
+  (simp: unless_def)
 
 lemma createObjects_valid_bitmaps:
   "createObjects' ptr n val gbits \<lbrace>valid_bitmaps\<rbrace>"
@@ -4678,14 +4659,9 @@ lemma mapM_x_threadSet_valid_pspace:
 lemma createNewCaps_valid_pspace:
   assumes  not_0: "n \<noteq> 0"
   and      cover: "range_cover ptr sz (APIType_capBits ty us) n"
-  and       tysc: "ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                     \<longrightarrow> sc_size_bounds us"
-  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
   apply (clarsimp simp: ARM_H.toAPIType_def
@@ -4693,22 +4669,17 @@ lemma createNewCaps_valid_pspace:
   apply (cases ty, 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, clarsimp)
-             apply (insert cover tysc)
-             (* 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 (wpsimp wp: createObjects_valid_pspace_untyped'[of dev us _ "Inr ty", where ptr=ptr]
-                 mapM_x_wp'
-      split_del: if_split
-           simp: createObjects_def makeObjectKO_def objBits_def objBitsKO_def scBits_simps
-                 not_0 APIType_capBits_def field_simps pageBits_def
-                 archObjSize_def ptBits_def pteBits_def scBits_simps
-                 pt_bits_def word_size_bits_def  archObjSize_def ptBits_def pdBits_def
-                 pteBits_def pdeBits_def
-      | simp add: power_add)+
+            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 archObjSize_def APIType_capBits_def
+                             objBits_simps pageBits_def pdBits_def ptBits_def not_0
+                             createObjects_def curDomain_def
+                             pteBits_def pdeBits_def
+                 | intro conjI impI
+                 | simp add: power_add field_simps)+
+done
 
 lemma copyGlobalMappings_inv[wp]:
   "\<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace>
@@ -4738,11 +4709,8 @@ lemma doMachineOp_mapM_x_wp:
 
 
 lemma createNewCaps_vms:
-  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_bounded'
-    and pspace_no_overlap' ptr sz and
+  "\<lbrace>pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and
     K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n) and
-    K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us) and
     valid_machine_state'\<rbrace>
    createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>archCaps. valid_machine_state'\<rbrace>"
@@ -4762,8 +4730,9 @@ lemma createNewCaps_vms:
                split del: if_split
          | assumption)+
   apply (case_tac ty)
-  by (auto simp: APIType_capBits_def archObjSize_def objBits_simps pageBits_def ptBits_def
-                 pdBits_def ARM_H.toAPIType_def object_type.splits pteBits_def pdeBits_def scBits_simps)
+   apply (auto simp: APIType_capBits_def archObjSize_def objBits_simps pageBits_def ptBits_def
+                     pdBits_def ARM_H.toAPIType_def object_type.splits pteBits_def pdeBits_def)
+  done
 
 lemma createObjects_pspace_domain_valid':
   "\<lbrace>\<lambda>s. range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0
@@ -4801,16 +4770,17 @@ lemma createObjects_pspace_domain_valid:
   apply (simp add: objBits_def)
   done
 
-crunch copyGlobalMappings, doMachineOp
+crunch copyGlobalMappings
   for pspace_domain_valid[wp]: "pspace_domain_valid"
   (wp: crunch_wps)
 
+crunch doMachineOp
+  for pspace_domain_valid[wp]: pspace_domain_valid
+
 lemma createNewCaps_pspace_domain_valid[wp]:
   "\<lbrace>pspace_domain_valid and K ({ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}
             \<inter> kernel_data_refs = {}
-        \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)
-       and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us)\<rbrace>
+        \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)\<rbrace>
     createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>rv. pspace_domain_valid\<rbrace>"
   apply (simp add: createNewCaps_def)
@@ -4821,8 +4791,14 @@ lemma createNewCaps_pspace_domain_valid[wp]:
                      split del: if_split)+
   apply (simp add: ARM_H.toAPIType_def
             split: object_type.splits)
-  by (auto simp: objBits_simps APIType_capBits_def pageBits_def scBits_simps
-                 pteBits_def pdeBits_def archObjSize_def ptBits_def pdBits_def)
+  apply (auto simp: objBits_simps APIType_capBits_def pageBits_def
+                    pteBits_def pdeBits_def
+                    archObjSize_def ptBits_def pdBits_def)
+  done
+
+crunch createNewCaps
+  for cur_domain[wp]: "\<lambda>s. P (ksCurDomain s)"
+  (wp: crunch_wps)
 
 (* FIXME: move *)
 lemma ct_idle_or_in_cur_domain'_lift_futz:
@@ -4845,26 +4821,22 @@ proof -
   show ?thesis
     apply (simp add: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
     apply (rule hoare_pre)
-     apply (wps a b c d)
-     apply (wp hoare_weak_lift_imp e' hoare_vcg_disj_lift)
+    apply (wps a b c d)
+    apply (wp hoare_weak_lift_imp e' hoare_vcg_disj_lift)
     apply (auto simp: obj_at'_def ct_in_state'_def projectKOs st_tcb_at'_def)
     done
 qed
 
 lemma createNewCaps_ct_idle_or_in_cur_domain':
-  "\<lbrace>ct_idle_or_in_cur_domain' and pspace_aligned' and pspace_distinct' and pspace_bounded'
-    and pspace_no_overlap' ptr sz
-    and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us)
-    and ct_active' and K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n) \<rbrace>
+  "\<lbrace>ct_idle_or_in_cur_domain' and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and ct_active' and K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n) \<rbrace>
     createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>rv. ct_idle_or_in_cur_domain'\<rbrace>"
-  by (wp ct_idle_or_in_cur_domain'_lift_futz createNewCaps_obj_at'[where sz=sz] | simp)+
+apply (wp ct_idle_or_in_cur_domain'_lift_futz createNewCaps_obj_at'[where sz=sz] | simp)+
+done
 
 lemma sch_act_wf_lift_asm_futz:
   assumes tcb: "\<And>P t. \<lbrace>st_tcb_at' P t and Q \<rbrace> f \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
-  assumes tcbDomain: "\<And>P t. \<lbrace>obj_at' (\<lambda>tcb. runnable' (tcbState tcb) \<longrightarrow> P (tcbDomain tcb)) t and Q\<rbrace>
-                             f \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. runnable' (tcbState tcb) \<longrightarrow> P (tcbDomain tcb)) t\<rbrace>"
+  assumes tcbDomain: "\<And>P t. \<lbrace>obj_at' (\<lambda>tcb. runnable' (tcbState tcb) \<longrightarrow> P (tcbDomain tcb)) t and Q\<rbrace> f \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. runnable' (tcbState tcb) \<longrightarrow> P (tcbDomain tcb)) t\<rbrace>"
   assumes kCT: "\<And>P. \<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
   assumes kCD: "\<And>P. \<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksCurDomain s)\<rbrace>"
   assumes ksA: "\<And>P. \<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksSchedulerAction s)\<rbrace>"
@@ -4896,11 +4868,7 @@ lemma sch_act_wf_lift_asm_futz:
   done
 
 lemma createNewCaps_sch_act_wf:
-  "\<lbrace>(\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and pspace_aligned' and pspace_distinct'
-       and pspace_bounded' and pspace_no_overlap' ptr sz
-       and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us)
-       and K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)\<rbrace>
+  "\<lbrace>(\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)\<rbrace>
      createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   apply (wp sch_act_wf_lift_asm_futz
@@ -4936,45 +4904,39 @@ 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 us d ty = Some val \<and>
+  "\<lbrace>\<lambda>s. P (null_filter' (ctes_of s)) \<and> makeObjectKO dev 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_bounded' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
+        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
    createObjects' ptr n val gbits
    \<lbrace>\<lambda>addrs a. P (null_filter' (ctes_of a))\<rbrace>"
-  apply (clarsimp simp: createObjects'_def split_def)
-  apply (wp unless_wp| wpc
-         | clarsimp simp: alignError_def split del: if_split simp del:fun_upd_apply)+
-  apply (subst new_cap_addrs_fold')
-   apply (simp add:unat_1_0 unat_gt_0)
-   apply (rule range_cover_not_zero_shift)
+   apply (clarsimp simp: createObjects'_def split_def)
+   apply (wp unless_wp|wpc
+          | clarsimp simp:haskell_assert_def alignError_def
+            split del: if_splits simp del:fun_upd_apply)+
+   apply (subst new_cap_addrs_fold')
+     apply (simp add:unat_1_0 unat_gt_0)
+     apply (rule range_cover_not_zero_shift)
      apply fastforce+
-  apply (subst new_cap_addrs_fold')
-   apply (simp add:unat_1_0 unat_gt_0)
-   apply (rule range_cover_not_zero_shift)
-     apply simp
-    apply assumption
-   apply simp
-  apply (subst data_map_insert_def[symmetric])+
-  apply (frule (3) retype_aligned_distinct'[where ko = val])
-   apply (erule range_cover_rel)
-    apply simp+
-  apply (frule (3) retype_aligned_distinct'(2)[where ko = val])
-   apply (erule range_cover_rel)
-    apply simp+
-  apply (frule (3) retype_aligned_distinct'(3)[where ko = val])
-   apply (erule range_cover_rel)
-    apply simp+
-  apply (frule null_filter_ctes_retype[where addrs =
-                                       "new_cap_addrs (unat ((of_nat n::word32) << gbits)) ptr val"])
-        apply assumption+
-       apply (prop_tac "objBitsKO val < word_bits")
-        apply (clarsimp simp: range_cover_def word_bits_def)
-      apply (clarsimp simp: field_simps foldr_upd_app_if[folded data_map_insert_def] shiftl_t2n
-                            range_cover.unat_of_nat_shift)+
+   apply (subst new_cap_addrs_fold')
+    apply (simp add:unat_1_0 unat_gt_0)
+    apply (rule range_cover_not_zero_shift)
+      apply simp
+     apply assumption
+    apply simp
+   apply (subst data_map_insert_def[symmetric])+
+   apply (frule(2) retype_aligned_distinct'[where ko = val])
+    apply (erule range_cover_rel)
+     apply simp+
+   apply (frule(2) retype_aligned_distinct'(2)[where ko = val])
+    apply (erule range_cover_rel)
+     apply simp+
+   apply (frule null_filter_ctes_retype
+     [where addrs = "(new_cap_addrs (unat (((of_nat n)::word32) << gbits)) ptr val)"])
+          apply assumption+
+     apply (clarsimp simp:field_simps foldr_upd_app_if[folded data_map_insert_def] shiftl_t2n range_cover.unat_of_nat_shift)+
     apply (rule new_cap_addrs_aligned[THEN bspec])
-     apply (erule range_cover.aligned[OF range_cover_rel])
-      apply simp+
-    apply (clarsimp simp: range_cover_def word_bits_def)
+    apply (erule range_cover.aligned[OF range_cover_rel])
+     apply simp+
    apply (clarsimp simp:shiftl_t2n field_simps range_cover.unat_of_nat_shift)
    apply (drule subsetD[OF new_cap_addrs_subset,rotated])
     apply (erule range_cover_rel)
@@ -4987,36 +4949,36 @@ lemma createObjects_null_filter':
     apply (drule(1) pspace_alignedD')
     apply (clarsimp)
     apply (erule is_aligned_no_overflow)
-   apply (simp del: atLeastAtMost_simps
-               add: Int_ac ptr_add_def p_assoc_help)
+    apply (simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+        Int_atLeastAtMost atLeastatMost_empty_iff add:Int_ac ptr_add_def p_assoc_help)
   apply (simp add:field_simps foldr_upd_app_if[folded data_map_insert_def] shiftl_t2n)
   apply auto
   done
 
 lemma createNewCaps_null_filter':
   "\<lbrace>(\<lambda>s. P (null_filter' (ctes_of s)))
-      and pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz
-      and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us)
+      and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz
       and K (range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0) \<rbrace>
      createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>_ s. P (null_filter' (ctes_of s))\<rbrace>"
   apply (rule hoare_gen_asm)
   apply (simp add: createNewCaps_def toAPIType_def
                    Arch_createNewCaps_def
-            split del: if_split cong: option.case_cong)
+               split del: if_split cong: option.case_cong)
   apply (cases ty, 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,simp)
-             by (simp add: createObjects_def makeObjectKO_def scBits_simps
-                           APIType_capBits_def objBits_def pageBits_def
-                           archObjSize_def ptBits_def pdBits_def curDomain_def objBits_if_dev
-                    split del: if_split
-                | wp createObjects_null_filter'[where ty = "Inr ty" and sz = sz and dev=dev]
-                     copyGlobalMappings_ctes_of threadSet_ctes_of mapM_x_wp'
-                | simp add: objBits_simps pteBits_def pdeBits_def
-                | fastforce)+
+             apply (simp add: createObjects_def makeObjectKO_def
+                              APIType_capBits_def objBits_def pageBits_def
+                              archObjSize_def ptBits_def pdBits_def curDomain_def
+                              objBits_if_dev
+                       split del: if_split
+                    | wp createObjects_null_filter'[where ty = "Inr ty" and sz = sz and dev=dev]
+                         copyGlobalMappings_ctes_of threadSet_ctes_of mapM_x_wp'
+                    | simp add: objBits_simps pteBits_def pdeBits_def
+                    | fastforce)+
+  done
 
 crunch createNewCaps
   for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
@@ -5038,9 +5000,7 @@ lemma untyped_ranges_zero_inv_null_filter_cteCaps_of:
 
 lemma createNewCaps_urz:
   "\<lbrace>untyped_ranges_zero'
-      and pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz
-      and K (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                \<longrightarrow> sc_size_bounds us)
+      and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz
       and K (range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0) \<rbrace>
    createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>archCaps. untyped_ranges_zero'\<rbrace>"
@@ -5052,30 +5012,42 @@ lemma createNewCaps_urz:
   done
 
 lemma createNewCaps_invs':
-  "\<lbrace>((\<lambda>s. invs' s \<and> ct_active' s \<and> pspace_no_overlap' ptr sz s
+  "\<lbrace>(\<lambda>s. invs' s \<and> ct_active' s \<and> pspace_no_overlap' ptr sz s
         \<and> caps_no_overlap'' ptr sz s \<and> ptr \<noteq> 0
         \<and> {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1} \<inter> kernel_data_refs = {}
         \<and> caps_overlap_reserved' {ptr..ptr + of_nat n * 2^(APIType_capBits ty us) - 1} s
         \<and> (ty = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> us > 0)
         \<and> gsMaxObjectSize s > 0)
-        and K (ty = APIObjectType ArchTypes_H.SchedContextObject \<longrightarrow> sc_size_bounds us))
        and K (range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0)\<rbrace>
      createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   (is "\<lbrace>?P and K ?Q\<rbrace> ?f \<lbrace>\<lambda>rv. invs'\<rbrace>")
 proof (rule hoare_gen_asm, erule conjE)
   assume cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \<noteq> 0"
+  have cnc_ct_not_inQ:
+    "\<lbrace>ct_not_inQ and valid_pspace' and pspace_no_overlap' ptr sz\<rbrace>
+     createNewCaps ty ptr n us dev \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+    unfolding ct_not_inQ_def
+    apply (rule_tac P'="\<lambda>s. ksSchedulerAction s = ResumeCurrentThread
+                             \<longrightarrow> (obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s
+                                  \<and> valid_pspace' s \<and> pspace_no_overlap' ptr sz s)"
+                    in hoare_pre_imp, clarsimp)
+    apply (rule hoare_convert_imp [OF createNewCaps_nosch])
+    apply (rule hoare_weaken_pre)
+     apply (wps createNewCaps_ct)
+     apply (wp createNewCaps_obj_at')
+    using cover not_0
+    apply (fastforce simp: valid_pspace'_def)
+    done
   show "\<lbrace>?P\<rbrace>
      createNewCaps ty ptr n us dev
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (simp add: invs'_def valid_dom_schedule'_def
+  apply (simp add: invs'_def valid_state'_def
                    pointerInUserData_def typ_at'_def)
     apply (rule hoare_pre)
      apply (wp createNewCaps_valid_pspace [OF not_0 cover]
-               createNewCaps_state_refs_of' [OF cover not_0]
-               createNewCaps_list_refs_of_replies' [OF cover not_0]
-               createNewCaps_iflive' [OF cover not_0]
+               createNewCaps_state_refs_of' [OF cover not_0 ]
+               createNewCaps_iflive' [OF cover not_0 ]
                irqs_masked_lift
                createNewCaps_ifunsafe'
                createNewCaps_cur [OF cover not_0]
@@ -5101,7 +5073,7 @@ qed
 
 lemma createObjects_pred_tcb_at':
   "\<lbrace>pred_tcb_at' proj P t and K (range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0)
-     and pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz\<rbrace>
+     and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\<rbrace>
   createObjects ptr n val gbits \<lbrace>\<lambda>rv. pred_tcb_at' proj P t\<rbrace>"
   apply (simp add: pred_tcb_at'_def createObjects_def)
   apply (wp createObjects_orig_obj_at')
@@ -5110,7 +5082,7 @@ lemma createObjects_pred_tcb_at':
 
 lemma createObjects_ex_cte_cap_to [wp]:
   "\<lbrace>\<lambda>s. range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<and> pspace_aligned' s \<and>
-        pspace_distinct' s \<and> pspace_bounded' s \<and> ex_cte_cap_to' p s \<and> pspace_no_overlap' ptr sz s\<rbrace>
+        pspace_distinct' s \<and> ex_cte_cap_to' p s \<and> pspace_no_overlap' ptr sz s\<rbrace>
   createObjects ptr n val gbits \<lbrace>\<lambda>r. ex_cte_cap_to' p\<rbrace>"
   apply (simp add: ex_cte_cap_to'_def createObjects_def)
   apply (rule hoare_lift_Pf2 [where f="irq_node'"])
@@ -5121,14 +5093,13 @@ lemma createObjects_ex_cte_cap_to [wp]:
 
 lemma createObjects_orig_obj_at3:
   "\<lbrace>\<lambda>s. obj_at' P p s \<and> range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<and>
-        pspace_aligned' s \<and> pspace_bounded' s \<and>
+        pspace_aligned' s \<and>
         pspace_distinct' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
   createObjects ptr n val gbits \<lbrace>\<lambda>r. obj_at' P p\<rbrace>"
   by (wp createObjects_orig_obj_at'[where sz = sz] | simp add: createObjects_def)+
 
 lemma createObjects_sch:
-  "\<lbrace>(\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and pspace_aligned' and pspace_distinct'
-      and pspace_bounded' and pspace_no_overlap' ptr sz
+  "\<lbrace>(\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz
       and K (range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0)\<rbrace>
   createObjects ptr n val gbits
   \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
@@ -5161,7 +5132,7 @@ lemma createObjects_no_cte_ifunsafe':
 lemma createObjects_no_cte_valid_global:
   assumes no_cte: "\<And>c. projectKO_opt val \<noteq> Some (c::cte)"
   assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
-  shows "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  shows "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and>
         pspace_no_overlap' ptr sz s \<and>
         range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<and>
         valid_global_refs' s\<rbrace>
@@ -5189,7 +5160,7 @@ lemma createObjects'_typ_at:
   "\<lbrace>\<lambda>s. n \<noteq> 0 \<and>
         range_cover ptr sz (objBitsKO val + gbits) n \<and>
         typ_at' T p s \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+        pspace_aligned' s \<and> pspace_distinct' s \<and>
         pspace_no_overlap' ptr sz s\<rbrace>
   createObjects' ptr n val gbits \<lbrace>\<lambda>r s. typ_at' T p s\<rbrace>"
   apply (rule hoare_grab_asm)+
@@ -5229,7 +5200,7 @@ lemma createObjects'_typ_at:
   done
 
 lemma createObjects_valid_arch:
-  "\<lbrace>\<lambda>s. valid_arch_state' s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  "\<lbrace>\<lambda>s. valid_arch_state' s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and>
         pspace_no_overlap' ptr sz s \<and> range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<rbrace>
       createObjects ptr n val gbits
    \<lbrace>\<lambda>rv s. valid_arch_state' s\<rbrace>"
@@ -5246,7 +5217,7 @@ lemma createObjects_valid_arch:
   done
 
 lemma createObjects_irq_state:
-  "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and>
         pspace_no_overlap' ptr sz s \<and>
         range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<and>
         valid_irq_node' (irq_node' s) s\<rbrace>
@@ -5260,7 +5231,7 @@ lemma createObjects_no_cte_irq_handlers:
   assumes no_cte: "\<And>c. projectKO_opt val \<noteq> Some (c::cte)"
   assumes no_tcb: "\<And>t. projectKO_opt val \<noteq> Some (t::tcb)"
   shows
-  "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and>
         pspace_no_overlap' ptr sz s \<and>
         range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<and>
         valid_irq_handlers' s\<rbrace>
@@ -5274,7 +5245,7 @@ lemma createObjects_no_cte_irq_handlers:
   done
 
 lemma createObjects_cur':
-  "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  "\<lbrace>\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and>
         pspace_no_overlap' ptr sz s \<and> range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<and>
         cur_tcb' s\<rbrace>
       createObjects ptr n val gbits
@@ -5288,7 +5259,7 @@ lemma createObjects_cur':
 
 lemma createObjects_vms'[wp]:
   "\<lbrace>(\<lambda>_.  (range_cover ptr sz  (objBitsKO val + gbits) n \<and> 0 < n)) and pspace_aligned' and
-     pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz and valid_machine_state'\<rbrace>
+     pspace_distinct' and pspace_no_overlap' ptr sz and valid_machine_state'\<rbrace>
       createObjects ptr n val gbits
    \<lbrace>\<lambda>rv. valid_machine_state'\<rbrace>"
   apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def
@@ -5304,10 +5275,10 @@ lemma createObjects_ct_idle_or_in_cur_domain':
        and K (range_cover ptr sz (objBitsKO val + gSize) n \<and> n \<noteq> 0)\<rbrace>
      createObjects ptr n val gSize
    \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wp ct_idle_or_in_cur_domain'_lift_futz createObjects_obj_at_other[where sz=sz])
-    apply simp_all
-  done
+apply (rule hoare_gen_asm)
+apply (wp ct_idle_or_in_cur_domain'_lift_futz createObjects_obj_at_other[where sz=sz])
+apply simp_all
+done
 
 lemma untyped_zero_ranges_cte_def:
   "untyped_ranges_zero_inv (cteCaps_of s) rs
@@ -5318,8 +5289,12 @@ lemma untyped_zero_ranges_cte_def:
   apply (safe, metis+)
   done
 
+crunch createObjects
+  for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  (simp: unless_def)
+
 lemma createObjects_untyped_ranges_zero':
-  assumes moKO: "makeObjectKO dev us d ty = Some val"
+  assumes moKO: "makeObjectKO dev ty = Some val"
   shows
   "\<lbrace>ct_active' and valid_pspace' and pspace_no_overlap' ptr sz
        and untyped_ranges_zero'
@@ -5345,13 +5320,9 @@ lemma createObjects_untyped_ranges_zero':
   done
 
 lemma createObjects_no_cte_invs:
-  assumes moKO: "makeObjectKO dev us d ty = Some val"
+  assumes moKO: "makeObjectKO dev 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     tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> sc_size_bounds us"
-  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> invs' s \<and> ct_active' s
         \<and> pspace_no_overlap' ptr sz s \<and> ptr \<noteq> 0
@@ -5359,8 +5330,6 @@ lemma createObjects_no_cte_invs:
         \<and> caps_overlap_reserved' {ptr..ptr + of_nat (n * 2 ^ gbits * 2 ^ objBitsKO val) - 1} s
         \<and> caps_no_overlap'' ptr sz s \<and>
        refs_of' val = {} \<and> \<not> live' val
-        \<and> (case val of KOReply r \<Rightarrow> replyNext_of r = None \<and> replyPrev r = None
-                     | _ \<Rightarrow> True)
             \<and> (\<forall>pde. projectKO_opt val = Some pde \<longrightarrow> pde = InvalidPDE)\<rbrace>
   createObjects ptr n val gbits
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
@@ -5381,90 +5350,159 @@ proof -
       apply (simp)+
     done
   show ?thesis
-    apply (rule hoare_grab_asm)+
-    apply (clarsimp simp: invs'_def valid_dom_schedule'_def)
-     apply (rule hoare_pre)
-      apply (rule hoare_vcg_conj_lift)
-       apply (simp add: createObjects_def,wp createObjects_valid_pspace_untyped')
-          apply (wp assms | simp add: objBits_def)+
-      apply (wp createObjects_sch createObjects_queues)
-      apply (rule hoare_vcg_conj_lift)
-       apply (simp add: createObjects_def)
-       apply (wp createObjects_state_refs_of'')
-       apply (wpsimp wp: createObjects_list_refs_of_replies'')
-      apply (rule hoare_vcg_conj_lift)
-       apply (simp add: createObjects_def)
-       apply (wp createObjects_iflive')
-      apply (wp createObjects_no_cte_ifunsafe' irqs_masked_lift
-                createObjects_idle' createObjects_no_cte_valid_global
-                createObjects_valid_arch createObjects_irq_state
-                createObjects_no_cte_irq_handlers createObjects_cur'
-                createObjects_queues' [OF no_tcb]
-                createObjects_release_queue' [OF no_tcb]
-                createObjects_release_queue
-                assms | simp add: objBits_def )+
-      apply (rule hoare_vcg_conj_lift)
-      apply (wp createObjects_no_cte_ifunsafe' irqs_masked_lift
-                createObjects_idle' createObjects_no_cte_valid_global
-                createObjects_valid_arch createObjects_irq_state
-                createObjects_no_cte_irq_handlers createObjects_cur'
-                createObjects_queues' [OF no_tcb] assms
-                createObjects_release_queue' [OF no_tcb]
-                createObjects_release_queue
-                createObjects_pspace_domain_valid co_ct_not_inQ
-                createObjects_ct_idle_or_in_cur_domain'
-                createObjects_untyped_ranges_zero'[OF moKO]
-            | simp)+
-    apply clarsimp
-    apply ((intro conjI; assumption?); simp add: valid_pspace'_def objBits_def)
-    done
+  apply (rule hoare_grab_asm)+
+   apply (clarsimp simp: invs'_def valid_state'_def)
+   apply wp
+   apply (rule hoare_pre)
+   apply (rule hoare_vcg_conj_lift)
+   apply (simp add: createObjects_def,wp createObjects_valid_pspace_untyped')
+   apply (wp assms | simp add: objBits_def)+
+   apply (wp createObjects_sch)
+   apply (rule hoare_vcg_conj_lift)
+    apply (simp add: createObjects_def)
+    apply (wp createObjects_state_refs_of'')
+   apply (rule hoare_vcg_conj_lift)
+    apply (simp add: createObjects_def)
+    apply (wp createObjects_iflive')
+   apply (wp createObjects_no_cte_ifunsafe' irqs_masked_lift
+             createObjects_idle' createObjects_no_cte_valid_global
+             createObjects_valid_arch createObjects_irq_state
+             createObjects_no_cte_irq_handlers createObjects_cur'
+             assms | simp add: objBits_def)+
+  apply (rule hoare_vcg_conj_lift)
+   apply (simp add: createObjects_def)
+   apply (wp createObjects_idle')
+   apply (wp createObjects_no_cte_ifunsafe' irqs_masked_lift
+             createObjects_idle' createObjects_no_cte_valid_global
+             createObjects_valid_arch createObjects_irq_state
+             createObjects_no_cte_irq_handlers createObjects_cur'
+             assms
+             createObjects_pspace_domain_valid co_ct_not_inQ
+             createObjects_ct_idle_or_in_cur_domain'
+             createObjects_untyped_ranges_zero'[OF moKO]
+         | simp)+
+  apply (rule hoare_vcg_conj_lift)
+   apply (simp add: createObjects_def)
+   apply (wpsimp wp: createObjects_sched_queues)
+  apply (rule hoare_vcg_conj_lift)
+   apply (simp add: createObjects_def)
+   apply (wpsimp wp: createObjects_valid_sched_pointers)
+  apply (rule hoare_vcg_conj_lift)
+   apply (simp add: createObjects_def)
+   apply (wpsimp wp: createObjects_valid_bitmaps)
+   apply (wp createObjects_no_cte_ifunsafe' irqs_masked_lift
+             createObjects_idle' createObjects_no_cte_valid_global
+             createObjects_valid_arch createObjects_irq_state
+             createObjects_no_cte_irq_handlers createObjects_cur'
+             assms
+             createObjects_pspace_domain_valid co_ct_not_inQ
+             createObjects_ct_idle_or_in_cur_domain'
+             createObjects_untyped_ranges_zero'[OF moKO]
+         | simp)+
+  apply clarsimp
+  apply ((intro conjI; assumption?); simp add: valid_pspace'_def objBits_def)
+  apply (fastforce simp add: no_cte no_tcb split_def split: option.splits)
+  apply (auto simp: invs'_def no_tcb valid_state'_def no_cte
+             split: option.splits kernel_object.splits)
+  done
 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           ko: "makeObjectKO dev us d ty = Some ko"
-  and            tysc: "ty = Inr (APIObjectType SchedContextObject) \<longrightarrow> min_sched_context_bits \<le> us"
+  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          orr: "obj_bits_api (APIType_map2 ty) us \<le> sz \<Longrightarrow>
-                     obj_relation_retype (default_object (APIType_map2 ty) dev us d) ko"
+                     obj_relation_retype
+                       (default_object (APIType_map2 ty) dev us) 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_list 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 \<and>
-              (ty = Inr (APIObjectType TCBObject) \<longrightarrow> d = ksCurDomain s))
-         (retype_region ptr n us (APIType_map2 ty) dev)
+              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 (f (set addrs));
              return (g addrs)
           od)"
-  using corres_retype' [OF not_zero aligned obj_bits_api check ko tysc orr cover]
-  by (clarsimp simp: f)
+  using corres_retype' [OF not_zero aligned obj_bits_api check usv ko orr cover]
+  by (simp add: f)
 
 lemma gcd_corres: "corres (=) \<top> \<top> (gets cur_domain) curDomain"
   by (simp add: curDomain_def state_relation_def)
 
-lemma createObjects_tcb_at':
+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_ext_retype_region_ArchObject_PageDirectoryObj:
+  "retype_region ptr n us (APIType_map2 (Inr PageDirectoryObject)) dev =
+  (retype_region2 ptr n us (APIType_map2 (Inr PageDirectoryObject)) 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:
   "\<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 \<and> pspace_bounded' s\<rbrace>
-   createObjects ptr n (KOTCB makeObject) 0 \<lbrace>\<lambda>ptrs s. \<forall>addr\<in>set ptrs. tcb_at' addr s\<rbrace>"
+   \<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>"
   apply (rule hoare_strengthen_post[OF createObjects_ko_at_strg[where val = "(makeObject :: tcb)"]])
   apply (auto simp: obj_at'_def projectKOs project_inject objBitsKO_def objBits_def makeObject_tcb)
   done
 
-lemma init_arch_objects_APIType_map2_noop:
-  "tp \<noteq> Inr PageDirectoryObject
-   \<longrightarrow> init_arch_objects (APIType_map2 tp) ptr n m addrs
-    = return ()"
-  apply (simp add: init_arch_objects_def APIType_map2_def)
-  apply (cases tp, simp_all split: kernel_object.split arch_kernel_object.split
-    object_type.split apiobject_type.split)
-  done
-
 lemma data_page_relation_retype:
   "obj_relation_retype (ArchObj (DataPage False pgsz)) KOUserData"
   "obj_relation_retype (ArchObj (DataPage True pgsz)) KOUserDataDevice"
@@ -5474,30 +5512,43 @@ lemma data_page_relation_retype:
    apply (clarsimp simp: image_def)+
   done
 
+lemma regroup_createObjects_dmo_userPages:
+  "(do
+      addrs <- createObjects y n ko sz;
+      _ <- modify (\<lambda>ks. ks\<lparr>gsUserPages := g ks addrs\<rparr>);
+      _ <- when P (mapM_x (\<lambda>addr. doMachineOp (m addr)) addrs);
+      return (f addrs)
+    od) = (do
+      (addrs, faddrs) <- (do
+        addrs <- createObjects y n ko sz;
+        _ <- modify (\<lambda>ks. ks\<lparr>gsUserPages := g ks addrs\<rparr>);
+        return (addrs, f addrs)
+       od);
+      _ <- when P (mapM_x (\<lambda>addr. doMachineOp (m addr)) addrs);
+      return faddrs
+    od)"
+  by (simp add: bind_assoc)
+
 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_list s \<and> valid_arch_state s
+            (\<lambda>s. valid_pspace s \<and> valid_mdb s \<and> valid_etcbs 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)
-                   \<and> (APIType_map2 (Inr ty) = Structures_A.CapTableObject \<longrightarrow> 0 < us)
-                   \<and> (APIType_map2 (Inr ty) = Structures_A.SchedContextObject
-                            \<longrightarrow> sc_size_bounds us))
+                   \<and> (APIType_map2 (Inr ty) = Structures_A.CapTableObject \<longrightarrow> 0 < us))
             (\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' y sz s
                   \<and> valid_pspace' s \<and> valid_arch_state' s
                   \<and> range_cover y sz (obj_bits_api (APIType_map2 (Inr ty)) us) n \<and> n\<noteq> 0)
             (do x \<leftarrow> retype_region y n us (APIType_map2 (Inr ty)) dev :: obj_ref list det_ext_monad;
-                init_arch_objects (APIType_map2 (Inr ty)) y n us x;
+                init_arch_objects (APIType_map2 (Inr ty)) dev y n us x;
                 return x od)
             (createNewCaps ty y n us dev)"
   apply (rule_tac F="range_cover y sz
                        (obj_bits_api (APIType_map2 (Inr ty)) us) n \<and>
                      n \<noteq> 0 \<and>
                      (APIType_map2 (Inr ty) = Structures_A.CapTableObject
-                       \<longrightarrow> 0 < us)
-                     \<and> (APIType_map2 (Inr ty) = Structures_A.SchedContextObject
-                            \<longrightarrow> sc_size_bounds us)"
+                       \<longrightarrow> 0 < us)"
             in corres_req, simp)
   apply (clarsimp simp add: createNewCaps_def toAPIType_def
                  split del: if_split cong: if_cong)
@@ -5506,173 +5557,228 @@ lemma corres_retype_region_createNewCaps:
                       split del: if_split)
         apply (rename_tac apiobject_type)
         apply (case_tac apiobject_type, simp_all split del: if_split)
-              \<comment> \<open>Untyped\<close>
-              apply (simp     add: retype_region_def obj_bits_api_def
-                                   APIType_map2_def
-                        split del: if_split
-                             cong: if_cong)
-              apply (subst upto_enum_red')
-               apply (drule range_cover_not_zero[rotated])
+            \<comment> \<open>Untyped\<close>
+            apply (simp     add: retype_region_def obj_bits_api_def
+                                 APIType_map2_def
+                      split del: if_split
+                           cong: if_cong)
+            apply (subst upto_enum_red')
+             apply (drule range_cover_not_zero[rotated])
+              apply simp
+             apply unat_arith
+            apply (clarsimp simp: list_all2_same enum_word_def  range_cover.unat_of_nat_n
+                                  list_all2_map1 list_all2_map2
+                                  ptr_add_def fromIntegral_def toInteger_nat fromInteger_nat)
+            apply (subst unat_of_nat_minus_1)
+              apply (rule le_less_trans[OF range_cover.range_cover_n_le(2) power_strict_increasing])
                 apply simp
-               apply unat_arith
-              apply (clarsimp simp: list_all2_same enum_word_def  range_cover.unat_of_nat_n
-                                    list_all2_map1 list_all2_map2
-                                    ptr_add_def fromIntegral_def toInteger_nat fromInteger_nat)
-              apply (subst unat_of_nat_minus_1)
-                apply (rule le_less_trans[OF range_cover.range_cover_n_le(2) power_strict_increasing])
-                  apply simp
-                 apply (clarsimp simp: range_cover_def)
-                 apply (arith+)[4]
-             \<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)[1]
-                   apply (fastforce simp: range_cover_def)
-                  apply (simp add: other_objs_default_relation)
-                 apply (rule corres_returnTT, 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)[9] (* not PageDirectoryObject *)
+           apply (rule corres_guard_imp)
+             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 (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 | 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
-            \<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])
+                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 (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>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 = 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
+          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 = notification],
+             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]
-         \<comment> \<open>SchedContext\<close>
+             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)
+         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 = sched_context],
+            apply (rule corres_retype[where 'a = notification],
                    simp_all add: obj_bits_api_def objBits_simps' pageBits_def
-                                 APIType_map2_def makeObjectKO_def scBits_simps
-                                 sc_relation_retype)[1]
-            apply ((simp add: range_cover_def APIType_map2_def sc_size_bounds_def
-                              list_all2_same list_all2_map1 list_all2_map2 sc_const_eq)+)[4]
-        \<comment> \<open>Reply\<close>
-        apply (simp add: liftM_def[symmetric] split del: if_split)
+                                 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_rel_imp)
          apply (rule corres_guard_imp)
-           apply (rule corres_retype[where 'a = reply],
-                  simp_all add: obj_bits_api_def objBits_simps' pageBits_def
-                                APIType_map2_def makeObjectKO_def
-                                reply_relation_retype)[1]
-           apply ((simp add: range_cover_def APIType_map2_def
-                             list_all2_same list_all2_map1 list_all2_map2)+)[4]
+           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 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)
        \<comment> \<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 (rule corres_rel_imp)
-        apply (simp add: init_arch_objects_APIType_map2_noop split del: if_split)
-        apply (rule corres_guard_imp)
-          apply (rule corres_retype_update_gsI,
-                 simp_all add: APIType_map2_def makeObjectKO_def
-                     arch_default_cap_def obj_bits_api_def
-                     default_object_def default_arch_object_def pageBits_def
-                     ext objBits_simps range_cover.aligned,
-                     simp_all add: data_page_relation_retype)[1]
-         apply simp+
-       apply (simp add: APIType_map2_def arch_default_cap_def vmrights_map_def
-                vm_read_write_def list_all2_map1 list_all2_map2 list_all2_same)
-      \<comment> \<open>LargePageObject\<close>
-      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_noop split del: if_split)
+       apply (simp add: init_arch_objects_def split del: if_split)
+       apply (subst regroup_createObjects_dmo_userPages)
        apply (rule corres_guard_imp)
-         apply (rule corres_retype_update_gsI,
-                simp_all add: APIType_map2_def makeObjectKO_def
-                    arch_default_cap_def obj_bits_api_def
-                    default_object_def default_arch_object_def pageBits_def
-                    ext objBits_simps range_cover.aligned,
-                    simp_all add: data_page_relation_retype)[1]
-        apply simp+
-      apply (simp add: APIType_map2_def arch_default_cap_def vmrights_map_def
-               vm_read_write_def list_all2_map1 list_all2_map2 list_all2_same)
+         apply (rule corres_split)
+            apply (rule corres_retype_update_gsI,
+                   simp_all add: APIType_map2_def makeObjectKO_def
+                                 arch_default_cap_def obj_bits_api_def3
+                                 default_object_def default_arch_object_def pageBits_def
+                                 ext objBits_simps range_cover.aligned,
+                   simp_all add: data_page_relation_retype)[1]
+           apply (simp add: APIType_map2_def vs_apiobj_size_def
+                       flip: when_def split del: if_split cong: if_cong)
+           apply (rule corres_split)
+              apply corres
+              apply (rule corres_mapM_x', clarsimp)
+                 apply (corres corres: corres_machine_op)
+                apply wp+
+              apply (rule refl)
+             apply (rule corres_returnTT)
+             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 (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)
+      apply (rule corres_guard_imp)
+        apply (rule corres_split)
+           apply (rule corres_retype_update_gsI,
+                  simp_all add: APIType_map2_def makeObjectKO_def
+                                arch_default_cap_def obj_bits_api_def3
+                                default_object_def default_arch_object_def pageBits_def
+                                ext objBits_simps range_cover.aligned,
+                  simp_all add: data_page_relation_retype)[1]
+          apply (simp add: APIType_map2_def vs_apiobj_size_def
+                      flip: when_def split del: if_split cong: if_cong)
+          apply (rule corres_split)
+             apply corres
+             apply (rule corres_mapM_x', clarsimp)
+                apply (corres corres: corres_machine_op)
+               apply wp+
+             apply (rule refl)
+            apply (rule corres_returnTT)
+            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>SectionObject\<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 (rule corres_rel_imp)
-      apply (simp add: init_arch_objects_APIType_map2_noop split del: if_split)
-      apply (rule corres_guard_imp)
-        apply (rule corres_retype_update_gsI,
-               simp_all add: APIType_map2_def makeObjectKO_def
-                   arch_default_cap_def obj_bits_api_def
-                   default_object_def default_arch_object_def pageBits_def
-                   ext objBits_simps range_cover.aligned,
-                   simp_all add: data_page_relation_retype)[1]
-       apply simp+
-     apply (simp add: APIType_map2_def arch_default_cap_def vmrights_map_def
-              vm_read_write_def list_all2_map1 list_all2_map2 list_all2_same)
+     apply (simp add: init_arch_objects_def split del: if_split)
+     apply (subst regroup_createObjects_dmo_userPages)
+     apply (rule corres_guard_imp)
+       apply (rule corres_split)
+          apply (rule corres_retype_update_gsI,
+                 simp_all add: APIType_map2_def makeObjectKO_def
+                               arch_default_cap_def obj_bits_api_def3
+                               default_object_def default_arch_object_def pageBits_def
+                               ext objBits_simps range_cover.aligned,
+                 simp_all add: data_page_relation_retype)[1]
+         apply (simp add: APIType_map2_def vs_apiobj_size_def
+                     flip: when_def split del: if_split cong: if_cong)
+         apply (rule corres_split)
+            apply corres
+            apply (rule corres_mapM_x', clarsimp)
+               apply (corres corres: corres_machine_op)
+              apply wp+
+            apply (rule refl)
+           apply (rule corres_returnTT)
+           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>SuperSectionObject\<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 (rule corres_rel_imp)
-     apply (simp add: init_arch_objects_APIType_map2_noop split del: if_split)
-     apply (rule corres_guard_imp)
-       apply (rule corres_retype_update_gsI,
-              simp_all add: APIType_map2_def makeObjectKO_def
-                  arch_default_cap_def obj_bits_api_def
-                  default_object_def default_arch_object_def pageBits_def
-                  ext objBits_simps range_cover.aligned,
-                  simp_all add: data_page_relation_retype)[1]
-      apply simp+
-    apply (simp add: APIType_map2_def arch_default_cap_def vmrights_map_def
-             vm_read_write_def list_all2_map1 list_all2_map2 list_all2_same)
+    apply (simp add: init_arch_objects_def split del: if_split)
+    apply (subst regroup_createObjects_dmo_userPages)
+    apply (rule corres_guard_imp)
+      apply (rule corres_split)
+         apply (rule corres_retype_update_gsI,
+                simp_all add: APIType_map2_def makeObjectKO_def
+                              arch_default_cap_def obj_bits_api_def3
+                              default_object_def default_arch_object_def pageBits_def
+                              ext objBits_simps range_cover.aligned,
+                simp_all add: data_page_relation_retype)[1]
+        apply (simp add: APIType_map2_def vs_apiobj_size_def
+                    flip: when_def split del: if_split cong: if_cong)
+        apply (rule corres_split)
+           apply corres
+           apply (rule corres_mapM_x', clarsimp)
+              apply (corres corres: corres_machine_op)
+             apply wp+
+           apply (rule refl)
+          apply (rule corres_returnTT)
+          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>PageTable\<close>
-   apply (simp_all add: corres_liftM2_simp[unfolded liftM_def])
+   apply (subst retype_region2_extra_ext_trivial)
+    apply (simp add: APIType_map2_def)
+   apply (simp add: corres_liftM2_simp[unfolded liftM_def])
+   apply (simp add: init_arch_objects_def bind_assoc split del: if_split)
    apply (rule corres_guard_imp)
-     apply (simp add: init_arch_objects_APIType_map2_noop)
-     apply (rule corres_rel_imp)
-      apply (rule corres_retype[where 'a =pte],
-           simp_all add: APIType_map2_def obj_bits_api_def
-                         default_arch_object_def objBits_simps
-                         archObjSize_def ptBits_def pageBits_def
-                         pteBits_def pdeBits_def
-                         makeObjectKO_def range_cover.aligned)[1]
-      apply (rule pagetable_relation_retype)
-     apply (wp | simp)+
-     apply (clarsimp simp: list_all2_map1 list_all2_map2 list_all2_same
-
-                           APIType_map2_def arch_default_cap_def)
-    apply simp+
+     apply (rule corres_split)
+        apply (rule corres_retype[where 'a =pte],
+               simp_all add: APIType_map2_def obj_bits_api_def
+                             default_arch_object_def objBits_simps
+                             archObjSize_def ptBits_def pteBits_def
+                             makeObjectKO_def range_cover.aligned)[1]
+        apply (rule pagetable_relation_retype)
+        apply (clarsimp simp: APIType_map2_def vs_apiobj_size_def
+                              pt_bits_def ptBits_def pageBits_def pteBits_def)
+        apply (rule corres_split)
+           apply (rule corres_mapM_x', clarsimp)
+              apply (corres corres: corres_machine_op)
+             apply wp+
+           apply (rule refl)
+          apply (rule corres_returnTT)
+          apply corres
+          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>PageDirectory\<close>
+  apply (simp add: bind_assoc)
   apply (rule corres_guard_imp)
     apply (rule corres_split_eqr)
        apply (rule corres_retype[where ty = "Inr PageDirectoryObject" and 'a = pde
-                    , simplified],
+                    , simplified, folded retype_region2_ext_retype_region_ArchObject_PageDirectoryObj],
               simp_all add: APIType_map2_def obj_bits_api_def
                             default_arch_object_def objBits_simps
                             archObjSize_def pdBits_def pageBits_def
@@ -5680,87 +5786,71 @@ lemma corres_retype_region_createNewCaps:
                             makeObjectKO_def)[1]
         apply (simp add: range_cover_def)+
        apply (rule pagedirectory_relation_retype)
-      apply (simp add: init_arch_objects_def APIType_map2_def
-                       bind_assoc)
-      apply (rule corres_split_nor)
-         apply (simp add: mapM_x_mapM)
-         apply (rule corres_underlying_split[where r' = dc])
-            apply (rule_tac Q="\<lambda>xs s. (\<forall>x \<in> set xs. page_directory_at x s)
-                                   \<and> valid_arch_state s \<and> pspace_aligned s"
-                         and Q'="\<lambda>xs s. (\<forall>x \<in> set xs. page_directory_at' x s) \<and> valid_arch_state' s"
-                         in corres_mapM_list_all2[where r'=dc and S="(=)"])
-                 apply simp+
-               apply (rule corres_guard_imp, rule copyGlobalMappings_corres)
-                apply simp+
-              apply (wp hoare_vcg_const_Ball_lift | simp)+
-            apply (simp add: list_all2_same)
-           apply (rule corres_return[where P =\<top> and P'=\<top>,THEN iffD2])
-           apply simp
-          apply wp+
-        apply (simp add: liftM_def[symmetric] o_def list_all2_map1
-                         list_all2_map2 list_all2_same
-                         arch_default_cap_def mapM_x_mapM)
-        apply (simp add: dc_def[symmetric])
-        apply (rule corres_machine_op)
-        apply (rule corres_Id)
-          apply (simp add: shiftl_t2n shiftL_nat
-                           pdBits_def ptBits_def pageBits_def pt_bits_def)
-          defer
-          apply simp
-         apply (simp add: mapM_discarded[where g = "return ()",simplified,symmetric])
-         apply (rule no_fail_pre)
-          apply (wp no_fail_mapM|clarsimp)+
+      apply (rename_tac pds)
+      apply (simp add: init_arch_objects_def bind_assoc APIType_map2_def
+                       vs_apiobj_size_def pdBits_eq
+                  split del: if_split)
+         apply (rule corres_split)
+         apply (rule_tac P="valid_arch_state and valid_etcbs and pspace_aligned and
+                            (\<lambda>s. \<forall>pd \<in> set pds. typ_at (AArch APageDirectory) pd s)" and
+                         P'="valid_arch_state' and (\<lambda>s. \<forall>pd \<in> set pds. page_directory_at' pd s)"
+                         in corres_mapM_x')
+            apply (clarsimp, rule corres_guard_imp, rule copyGlobalMappings_corres; simp)
+           apply (wpsimp wp: hoare_vcg_op_lift)+
+        apply (rule corres_split, rule corres_mapM_x', rule corres_machine_op)
+              apply (clarsimp cong: corres_weak_cong)
+              apply (rule corres_underlying_trivial_dc)
+              apply wp+
+           apply (rule refl)
+          apply (rule corres_returnTT)
+          apply (simp add: list_all2_map1 list_all2_map2 list_all2_same arch_default_cap_def)
+         apply (wpsimp wp: retype_region_valid_arch retype_region_aligned)+
+     apply (rule hoare_post_imp)
+      prefer 2
       apply (rule hoare_vcg_conj_lift)
-       apply (rule hoare_post_imp)
-        prefer 2
-        apply (rule hoare_vcg_conj_lift)
-         apply (rule retype_region_obj_at)
-         apply (simp add: APIType_map2_def)
-        apply (subst APIType_map2_def, simp)
-        apply (rule retype_region_ret)
-       apply (clarsimp simp: retype_addrs_def obj_bits_api_def APIType_map2_def
-                  default_arch_object_def default_object_def)
-       apply (clarsimp simp: obj_at_def a_type_def)
-      apply (wp retype_region_valid_arch retype_region_aligned|simp)+
-     apply (clarsimp simp: objBits_simps retype_addrs_def obj_bits_api_def
-                           APIType_map2_def default_arch_object_def default_object_def)
+       apply (rule retype_region_obj_at)
+       apply (simp add: APIType_map2_def)
+      apply (simp add: APIType_map2_def)
+      apply (rule retype_region_ret)
+     apply (clarsimp simp: retype_addrs_def obj_bits_api_def APIType_map2_def
+                           default_arch_object_def default_object_def obj_at_def a_type_def)
+    apply (wpsimp wp: createObjects_valid_arch)
+     apply (rule hoare_post_imp)
+      prefer 2
      apply (rule hoare_vcg_conj_lift)
-      apply (rule hoare_post_imp)
-       prefer 2
-       apply (rule hoare_vcg_conj_lift)
-        apply (rule createObjects_ko_at[where sz = sz and 'a = pde])
-          apply (simp add: objBits_simps archObjSize_def pdBits_def
-                           pteBits_def pdeBits_def
-                           pageBits_def page_directory_at'_def)+
-        apply (simp add: projectKOs)
-       apply (rule createObjects_aligned)
-          apply (simp add: objBits_simps archObjSize_def pdBits_def
-                        pageBits_def page_directory_at'_def)+
-          apply (simp add: range_cover_def pteBits_def pdeBits_def)
-         apply (rule le_less_trans[OF range_cover.range_cover_n_le(2) power_strict_increasing])
-           apply simp
-          apply (clarsimp simp: range_cover_def word_bits_def)
-          apply arith+
-       apply (simp add: objBits_simps archObjSize_def pdBits_def
-                        pageBits_def page_directory_at'_def)+
-       apply (simp add: range_cover_def word_bits_def pteBits_def pdeBits_def)
-      apply clarsimp
-      apply (drule (1) bspec)+
-      apply (simp add: objBits_simps retype_addrs_def obj_bits_api_def pdBits_def pageBits_def
-                       ptBits_def APIType_map2_def default_arch_object_def default_object_def
-                       archObjSize_def)
-      apply (clarsimp simp: objBits_simps archObjSize_def pdBits_def
-                            pageBits_def page_directory_at'_def
-                            pteBits_def pdeBits_def)
-      apply (drule_tac x = ya in spec)
-      apply (clarsimp simp:typ_at'_def obj_at'_real_def)
-      apply (erule ko_wp_at'_weakenE)
-      apply (clarsimp simp: projectKOs)
-     apply (wp createObjects_valid_arch)
-    apply (auto simp: objBits_simps retype_addrs_def obj_bits_api_def pdBits_def pageBits_def ptBits_def
-                      APIType_map2_def default_arch_object_def default_object_def archObjSize_def
-                      pteBits_def pdeBits_def
-                      pd_bits_def fromIntegral_def toInteger_nat fromInteger_nat)
+      apply (rule createObjects_ko_at[where sz = sz and 'a = pde])
+        apply (simp add: objBits_simps archObjSize_def pdBits_def
+                         pteBits_def pdeBits_def APIType_map2_def
+                         obj_bits_api_def default_arch_object_def projectKOs
+                         pageBits_def page_directory_at'_def)+
+     apply (rule createObjects_aligned)
+        apply (simp add: objBits_simps archObjSize_def pdBits_def
+                      pageBits_def page_directory_at'_def)+
+        apply (simp add: range_cover_def pteBits_def pdeBits_def)
+       apply (rule le_less_trans[OF range_cover.range_cover_n_le(2) power_strict_increasing])
+         apply simp
+        apply (clarsimp simp: range_cover_def word_bits_def)
+        apply arith+
+     apply (simp add: objBits_simps archObjSize_def pdBits_def
+                      pageBits_def page_directory_at'_def)+
+     apply (simp add: word_bits_def pteBits_def pdeBits_def)
+    apply clarsimp
+    apply (drule (1) bspec)+
+    apply (simp add: objBits_simps retype_addrs_def obj_bits_api_def pdBits_def pageBits_def
+                     ptBits_def APIType_map2_def default_arch_object_def default_object_def
+                     archObjSize_def)
+    apply (clarsimp simp: objBits_simps archObjSize_def pdBits_def
+                          pageBits_def page_directory_at'_def
+                          pteBits_def pdeBits_def)
+    apply (rename_tac offset)
+    apply (drule_tac x = offset in spec)
+    apply (clarsimp simp:typ_at'_def obj_at'_real_def)
+    apply (erule ko_wp_at'_weakenE)
+    apply (clarsimp simp: projectKOs)
+   apply (auto simp: objBits_simps retype_addrs_def obj_bits_api_def pdBits_def pageBits_def
+                     APIType_map2_def default_arch_object_def default_object_def archObjSize_def
+                     pteBits_def pdeBits_def ptBits_def
+                     pd_bits_def fromIntegral_def toInteger_nat fromInteger_nat)
   done
 
 end
diff --git a/proof/refine/ARM/SchedContextInv_R.thy b/proof/refine/ARM/SchedContextInv_R.thy
deleted file mode 100644
index 4fb2d8cd92..0000000000
--- a/proof/refine/ARM/SchedContextInv_R.thy
+++ /dev/null
@@ -1,1616 +0,0 @@
-(*
- * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
- *
- * SPDX-License-Identifier: GPL-2.0-only
- *)
-
-theory SchedContextInv_R
-imports Invocations_R Tcb_R
-begin
-
-global_interpretation schedContextCompleteYieldTo: typ_at_all_props' "schedContextCompleteYieldTo scp"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-primrec valid_sc_inv' :: "sched_context_invocation \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "valid_sc_inv' (InvokeSchedContextConsumed scptr args) =
-     (sc_at' scptr and ex_nonz_cap_to' scptr and case_option \<top> valid_ipc_buffer_ptr' args)"
-| "valid_sc_inv' (InvokeSchedContextBind scptr cap) =
-     (ex_nonz_cap_to' scptr and valid_cap' cap and
-        (case cap of
-           ThreadCap t \<Rightarrow>
-             ex_nonz_cap_to' t and
-             bound_sc_tcb_at' ((=) None) t and
-             obj_at' (\<lambda>sc. scTCB sc = None) scptr \<^cancel>\<open> and
-             FIXME RT: can hopefully be established via assertions:
-             (\<lambda>s. st_tcb_at' (ipc_queued_thread_state) t s
-                     \<longrightarrow> sc_at_pred' (sc_released (cur_time s)) scptr s) \<close>
-         | NotificationCap n _ _ _ \<Rightarrow>
-             ex_nonz_cap_to' n and
-             obj_at' (\<lambda>ntfn. ntfnSc ntfn = None) n and
-             obj_at' (\<lambda>sc. scNtfn sc = None) scptr
-         | _ \<Rightarrow> \<bottom>))"
-| "valid_sc_inv' (InvokeSchedContextUnbindObject scptr cap) =
-     (ex_nonz_cap_to' scptr and valid_cap' cap and
-        (case cap of
-           ThreadCap t \<Rightarrow>
-             ex_nonz_cap_to' t and obj_at' (\<lambda>sc. scTCB sc = Some t) scptr and
-             (\<lambda>s. t \<noteq> ksCurThread s)
-         | NotificationCap n _ _ _ \<Rightarrow>
-             ex_nonz_cap_to' n and obj_at' (\<lambda>sc. scNtfn sc = Some n) scptr
-         | _ \<Rightarrow> \<bottom>))"
-| "valid_sc_inv' (InvokeSchedContextUnbind scptr) = (sc_at' scptr and ex_nonz_cap_to' scptr)"
-| "valid_sc_inv' (InvokeSchedContextYieldTo scptr args) =
-     (\<lambda>s. ex_nonz_cap_to' scptr s
-          \<and> case_option \<top> valid_ipc_buffer_ptr' args s
-          \<and> (\<forall>ct. ct = ksCurThread s \<longrightarrow>
-                bound_yt_tcb_at' ((=) None) ct s \<and>
-                obj_at' (\<lambda>sc. \<exists>t. scTCB sc = Some t \<and> t \<noteq> ct) scptr s))"
-
-definition
-  valid_refills_number' :: "nat \<Rightarrow> nat \<Rightarrow> bool"
-where
-  "valid_refills_number' max_refills n \<equiv> max_refills \<le> refillAbsoluteMax' n"
-
-primrec valid_sc_ctrl_inv' :: "sched_control_invocation \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "valid_sc_ctrl_inv' (InvokeSchedControlConfigureFlags scptr budget period mrefills badge flags) =
-     ((\<lambda>s. \<exists>n. sc_at'_n n scptr s \<and> valid_refills_number' mrefills n) and
-      ex_nonz_cap_to' scptr and K (MIN_REFILLS \<le> mrefills) and
-      K (budget \<le> MAX_PERIOD \<and> budget \<ge> MIN_BUDGET \<and>
-         period \<le> MAX_PERIOD \<and> budget \<ge> MIN_BUDGET \<and>
-         budget \<le> period))"
-
-primrec sc_inv_rel :: "Invocations_A.sched_context_invocation \<Rightarrow> sched_context_invocation \<Rightarrow> bool"
-  where
-  "sc_inv_rel (Invocations_A.InvokeSchedContextConsumed sc_ptr bf) sci' =
-   (sci' = InvokeSchedContextConsumed sc_ptr bf)"
-| "sc_inv_rel (Invocations_A.InvokeSchedContextBind sc_ptr cap) sci' =
-   (\<exists>cap'. cap_relation cap cap' \<and> sci' = InvokeSchedContextBind sc_ptr cap')"
-| "sc_inv_rel (Invocations_A.InvokeSchedContextUnbindObject sc_ptr cap) sci' =
-   (\<exists>cap'. cap_relation cap cap' \<and> sci' = InvokeSchedContextUnbindObject sc_ptr cap')"
-| "sc_inv_rel (Invocations_A.InvokeSchedContextUnbind sc_ptr) sci' =
-   (sci' = InvokeSchedContextUnbind sc_ptr)"
-| "sc_inv_rel (Invocations_A.InvokeSchedContextYieldTo sc_ptr bf) sci' =
-   (sci' = InvokeSchedContextYieldTo sc_ptr bf)"
-
-primrec sc_ctrl_inv_rel ::
-  "Invocations_A.sched_control_invocation \<Rightarrow> sched_control_invocation \<Rightarrow> bool" where
-  "sc_ctrl_inv_rel (Invocations_A.InvokeSchedControlConfigureFlags sc_ptr budget period refills badge flags) sci' =
-    (sci' = InvokeSchedControlConfigureFlags sc_ptr budget period refills badge flags)"
-
-lemma decodeSchedContext_Bind_wf:
-  "\<lbrace>\<lambda>s. \<exists>n. valid_cap' (SchedContextCap sc_ptr n) s
-        \<and> ex_nonz_cap_to' sc_ptr s
-        \<and> (\<forall>cap\<in>set excaps. \<forall>r\<in>zobj_refs' cap. ex_nonz_cap_to' r s)
-        \<and> (\<forall>x\<in>set excaps. valid_cap' x s)\<rbrace>
-   decodeSchedContext_Bind sc_ptr excaps
-   \<lbrace>valid_sc_inv'\<rbrace>, -"
-  apply (clarsimp simp: decodeSchedContext_Bind_def)
-  apply (wpsimp wp: gts_wp' threadGet_wp getNotification_wp
-              simp: scReleased_def scActive_def isBlocked_def refillReady_def)
-  apply (clarsimp simp: valid_cap'_def)
-  apply (drule_tac x="hd excaps" in bspec, fastforce dest: hd_in_set)+
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma decodeSchedContext_UnbindObject_wf:
-  "\<lbrace>\<lambda>s. \<exists>n. valid_cap' (SchedContextCap sc_ptr n) s
-        \<and> ex_nonz_cap_to' sc_ptr s
-        \<and> (\<forall>cap\<in>set excaps. \<forall>r\<in>zobj_refs' cap. ex_nonz_cap_to' r s)
-        \<and> (\<forall>x\<in>set excaps. valid_cap' x s)\<rbrace>
-   decodeSchedContext_UnbindObject sc_ptr excaps
-   \<lbrace>valid_sc_inv'\<rbrace>, -"
-  apply (clarsimp simp: decodeSchedContext_UnbindObject_def)
-  apply (wpsimp wp: gts_wp' threadGet_wp getNotification_wp
-              simp: scReleased_def scActive_def isBlocked_def refillReady_def)
-  apply (clarsimp simp: valid_cap'_def)
-  apply (drule_tac x="hd excaps" in bspec, fastforce dest: hd_in_set)+
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma decodeSchedContext_YieldTo_wf:
-  "\<lbrace>\<lambda>s. \<exists>n. valid_cap' (SchedContextCap sc_ptr n) s \<and> ex_nonz_cap_to' sc_ptr s
-        \<and> case_option \<top> valid_ipc_buffer_ptr' args s\<rbrace>
-   decodeSchedContext_YieldTo sc_ptr args
-   \<lbrace>valid_sc_inv'\<rbrace>, -"
-  apply (clarsimp simp: decodeSchedContext_YieldTo_def)
-  apply (wpsimp wp: gts_wp' threadGet_wp getNotification_wp getTCB_wp
-              simp: scReleased_def scActive_def isBlocked_def refillReady_def)
-  apply (clarsimp simp: valid_cap'_def)
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def projectKOs)
-  done
-
-lemma decodeSchedContextInvocation_wf:
-  "\<lbrace>\<lambda>s. \<exists>n. valid_cap' (SchedContextCap sc_ptr n) s
-        \<and> ex_nonz_cap_to' sc_ptr s
-        \<and> case_option \<top> valid_ipc_buffer_ptr' args s
-        \<and> (\<forall>cap\<in>set excaps. \<forall>r\<in>zobj_refs' cap. ex_nonz_cap_to' r s)
-        \<and> (\<forall>x\<in>set excaps. valid_cap' x s)\<rbrace>
-   decodeSchedContextInvocation label sc_ptr excaps args
-   \<lbrace>valid_sc_inv'\<rbrace>, -"
-  apply (simp add: decodeSchedContextInvocation_def)
-  apply (wpsimp wp: decodeSchedContext_Bind_wf
-                    decodeSchedContext_UnbindObject_wf
-                    decodeSchedContext_YieldTo_wf)
-  apply (fastforce dest: valid_SchedContextCap_sc_at')
-  done
-
-lemma decodeSchedControlInvocation_wf:
-  "\<lbrace>invs' and (\<lambda>s. \<forall>cap\<in>set excaps. \<forall>r\<in>zobj_refs' cap. ex_nonz_cap_to' r s)
-    and (\<lambda>s. \<forall>x\<in>set excaps. valid_cap' x s)\<rbrace>
-   decodeSchedControlInvocation label args excaps
-   \<lbrace>valid_sc_ctrl_inv'\<rbrace>, -"
-  apply (clarsimp simp: decodeSchedControlInvocation_def)
-  apply (case_tac "genInvocationType label"; simp; (solves wpsimp)?)
-  apply (wpsimp simp: decodeSchedControl_ConfigureFlags_def)
-  apply (cases excaps; simp)
-  apply (rename_tac a list, case_tac a; simp add: isSchedContextCap_def)
-  apply (clarsimp simp: valid_cap'_def  ko_wp_at'_def scBits_simps valid_refills_number'_def
-                        MAX_PERIOD_def maxPeriodUs_def usToTicks_def us_to_ticks_mono
-                        MIN_BUDGET_def kernelWCET_ticks_def timeArgSize_def minBudgetUs_def
-                        MIN_REFILLS_def minRefills_def not_less
-                  cong: conj_cong)
-  apply (insert getCurrentTime_buffer_bound)
-  apply (intro conjI impI; (fastforce intro: us_to_ticks_mono)?)
-   apply (rule_tac order_trans[OF MIN_BUDGET_helper])
-   apply (rule us_to_ticks_mono)
-    apply blast
-   apply (fastforce intro: order_trans[OF mult_le_mono1]
-                     simp: word_le_nat_alt)
-  apply (fastforce intro: order_trans[OF mult_le_mono1] us_to_ticks_mono
-                    simp: word_le_nat_alt)
-  done
-
-lemma decodeSchedcontext_Bind_corres:
-  "list_all2 cap_relation excaps excaps'
-   \<Longrightarrow> corres (ser \<oplus> sc_inv_rel)
-         (invs and valid_sched and sc_at sc_ptr and (\<lambda>s. \<forall>x\<in>set excaps. s \<turnstile> x))
-         (invs' and (\<lambda>s. \<forall>x\<in>set excaps'. valid_cap' x s))
-         (decode_sched_context_bind sc_ptr excaps)
-         (decodeSchedContext_Bind sc_ptr excaps')"
-  apply (clarsimp simp: decode_sched_context_bind_def decodeSchedContext_Bind_def)
-  apply (cases excaps; clarsimp)
-  apply (rename_tac cap list)
-  apply (cases excaps'; clarsimp)
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp corres: get_sc_corres)
-     apply (fastforce intro: sc_at'_cross_rel[unfolded cross_rel_def, rule_format])
-    apply (rule liftE_validE[THEN iffD2, OF get_sched_context_sp])
-   apply (rule liftE_validE[THEN iffD2, OF get_sc_sp'])
-  apply (case_tac cap; clarsimp)
-   apply (clarsimp simp: bindE_assoc)
-   apply (rule corres_splitEE_skip; (solves wpsimp)?)
-    apply (corresKsimp simp: sc_relation_def)
-   apply (rule corres_splitEE_forwards'[where r'="(=)"]; (solves wpsimp)?)
-    apply (corresKsimp corres: getNotification_corres
-                        simp: get_sk_obj_ref_def ntfn_relation_def valid_cap_def valid_cap'_def
-                          wp: hoare_vcg_all_lift)
-   apply (rule corres_splitEE_skip; (solves wpsimp)?)
-    apply (corresKsimp corres: getNotification_corres
-                        simp: get_sk_obj_ref_def sc_relation_def)
-   apply (clarsimp simp: returnOk_def)
-  apply (clarsimp simp: bindE_assoc get_tcb_obj_ref_def)
-  apply (rule corres_splitEE_skip; (solves wpsimp)?)
-   apply (corresKsimp simp: sc_relation_def)
-  apply (rule corres_splitEE_forwards'[where r'="(=)"])
-     apply (subst corres_liftE_rel_sum)
-     apply (rule corres_guard_imp)
-       apply (rule threadGet_corres)
-       apply (clarsimp simp: tcb_relation_def)
-      apply (clarsimp simp: valid_cap_def)
-     apply (clarsimp simp: valid_cap'_def)
-    apply (rule liftE_validE[THEN iffD2, OF thread_get_sp])
-   apply (rule liftE_validE[THEN iffD2, OF threadGet_sp])
-  apply (rule corres_splitEE_skip; (solves \<open>wpsimp simp: valid_cap'_def obj_at'_def\<close>)?)
-   apply (corresKsimp corres: getNotification_corres
-                       simp: get_sk_obj_ref_def sc_relation_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_eqrE)
-       apply (rule corres_liftE_rel_sum[THEN iffD2, OF get_sc_released_corres])
-      apply (rule corres_splitEE)
-         apply (subst corres_liftE_rel_sum)
-         apply (rule isBlocked_corres)
-        apply (rule whenE_throwError_corres)
-          apply simp
-         apply simp
-        apply (rule corres_trivial, clarsimp simp: returnOk_def)
-       apply wpsimp
-      apply wpsimp
-     apply wpsimp
-    apply (wpsimp simp: scReleased_def scActive_def)
-   apply (fastforce simp: obj_at_def is_tcb_def)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma decodeSchedContext_UnbindObject_corres:
-  "list_all2 cap_relation excaps excaps'
-   \<Longrightarrow> corres (ser \<oplus> sc_inv_rel)
-         (invs and sc_at sc_ptr)
-         invs'
-         (decode_sched_context_unbind_object sc_ptr excaps)
-         (decodeSchedContext_UnbindObject sc_ptr excaps')"
-  apply (clarsimp simp: decode_sched_context_unbind_object_def decodeSchedContext_UnbindObject_def)
-  apply (cases excaps; clarsimp)
-  apply (rename_tac cap list)
-  apply (cases excaps'; clarsimp)
-  apply (case_tac cap; clarsimp)
-   apply (clarsimp simp: bindE_assoc get_sc_obj_ref_def liftE_bind_return_bindE_returnOk)
-   apply (rule corres_splitEE_forwards')
-      apply (corresKsimp corres: get_sc_corres)
-      apply (fastforce intro: sc_at'_cross_rel[unfolded cross_rel_def, rule_format])
-     apply (rule liftE_validE[THEN iffD2, OF get_sched_context_sp])
-    apply (rule liftE_validE[THEN iffD2, OF get_sc_sp'])
-   apply (corresKsimp simp: sc_relation_def)
-  apply (clarsimp simp: bindE_assoc get_sc_obj_ref_def liftE_bind_return_bindE_returnOk)
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp corres: get_sc_corres)
-     apply (fastforce intro: sc_at'_cross_rel[unfolded cross_rel_def, rule_format])
-    apply (rule liftE_validE[THEN iffD2, OF get_sched_context_sp])
-   apply (rule liftE_validE[THEN iffD2, OF get_sc_sp'])
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp simp: sc_relation_def)
-    apply (rule whenE_throwError_sp[simplified validE_R_def])+
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp corres: getCurThread_corres)
-    apply (rule liftE_validE[THEN iffD2, OF gets_sp])
-   apply (rule liftE_validE[THEN iffD2, OF getCurThread_sp])
-  apply corresKsimp
-  done
-
-lemma decodeSchedContext_YieldTo_corres:
-  "corres (ser \<oplus> sc_inv_rel)
-          (invs and sc_at sc_ptr)
-          invs'
-          (decode_sched_context_yield_to sc_ptr args')
-          (decodeSchedContext_YieldTo sc_ptr args')"
-  apply add_cur_tcb'
-  apply (clarsimp simp: decode_sched_context_yield_to_def decodeSchedContext_YieldTo_def)
-  apply (clarsimp simp: bindE_assoc get_sc_obj_ref_def liftE_bind_return_bindE_returnOk)
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp corres: get_sc_corres)
-     apply (fastforce intro: sc_at'_cross_rel[unfolded cross_rel_def, rule_format])
-    apply (rule liftE_validE[THEN iffD2, OF get_sched_context_sp])
-   apply (rule liftE_validE[THEN iffD2, OF get_sc_sp'])
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp simp: sc_relation_def)
-    apply (rule whenE_throwError_sp[simplified validE_R_def])+
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp corres: getCurThread_corres)
-    apply (rule liftE_validE[THEN iffD2, OF gets_sp])
-   apply (rule liftE_validE[THEN iffD2, OF getCurThread_sp])
-  apply (rule corres_splitEE_skip; (solves wpsimp)?)
-   apply (corresKsimp simp: sc_relation_def)
-  apply (clarsimp simp: sc_relation_def)
-  apply (rule corres_splitEE_forwards'[where r'="(=)"])
-     apply (subst corres_liftE_rel_sum)
-     apply (rule corres_guard_imp)
-       apply (rule threadGet_corres)
-       apply (clarsimp simp: tcb_relation_def)
-      apply (fastforce dest: invs_valid_objs valid_objs_ko_at
-                       simp: valid_obj_def valid_sched_context_def)
-     apply (fastforce dest: sc_ko_at_valid_objs_valid_sc'
-                      simp: valid_sched_context'_def)
-    apply (rule liftE_validE[THEN iffD2, OF thread_get_sp])
-   apply (rule liftE_validE[THEN iffD2, OF threadGet_sp])
-  apply (rule corres_splitEE_forwards'[where r'="(=)"])
-     apply (subst corres_liftE_rel_sum)
-     apply (rule corres_guard_imp)
-       apply (rule threadGet_corres)
-       apply (clarsimp simp: tcb_relation_def)
-      apply fastforce
-     apply (fastforce simp: cur_tcb'_def)
-    apply (rule liftE_validE[THEN iffD2, OF thread_get_sp])
-   apply (rule liftE_validE[THEN iffD2, OF threadGet_sp])
-  apply (rule corres_splitEE_skip; corresKsimp; fastforce?)
-  apply (rule corres_splitEE_forwards'[where r'="(=)"])
-     apply (subst corres_liftE_rel_sum)
-     apply (rule corres_guard_imp)
-       apply (rule threadGet_corres)
-       apply (clarsimp simp: tcb_relation_def)
-      apply fastforce
-     apply fastforce
-    apply (rule liftE_validE[THEN iffD2, OF thread_get_sp])
-   apply (rule liftE_validE[THEN iffD2, OF threadGet_sp])
-  apply (rule corres_splitEE_skip; corresKsimp; fastforce?)
-  done
-
-lemma decode_sc_inv_corres:
-  "list_all2 cap_relation excaps excaps' \<Longrightarrow>
-   corres (ser \<oplus> sc_inv_rel)
-          (invs and valid_sched and sc_at sc_ptr and (\<lambda>s. \<forall>x\<in>set excaps. s \<turnstile> x)
-           and case_option \<top> in_user_frame args')
-          (invs' and (\<lambda>s. \<forall>x\<in>set excaps'. valid_cap' x s)
-           and case_option \<top> valid_ipc_buffer_ptr' args')
-          (decode_sched_context_invocation (mi_label mi) sc_ptr excaps args')
-          (decodeSchedContextInvocation (mi_label mi) sc_ptr excaps' args')"
-  apply (clarsimp simp: decode_sched_context_invocation_def decodeSchedContextInvocation_def
-             split del: if_split)
-  apply (cases "gen_invocation_type (mi_label mi)"
-         ; clarsimp split: gen_invocation_labels.split list.splits
-                split del: if_split)
-      apply (clarsimp simp: returnOk_def)
-     apply (corresKsimp corres: decodeSchedcontext_Bind_corres)
-    defer
-    apply (corresKsimp corres: decodeSchedContext_UnbindObject_corres)
-   apply (corresKsimp corres: decodeSchedContext_YieldTo_corres)
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp corres: get_sc_corres)
-     apply (fastforce intro: sc_at'_cross_rel[unfolded cross_rel_def, rule_format])
-    apply (rule liftE_validE[THEN iffD2, OF get_sched_context_sp])
-   apply (rule liftE_validE[THEN iffD2, OF get_sc_sp'])
-  apply (rule corres_splitEE_forwards')
-     apply (corresKsimp corres: getCurThread_corres)
-    apply (rule liftE_validE[THEN iffD2, OF gets_sp])
-   apply (rule liftE_validE[THEN iffD2, OF getCurThread_sp])
-  apply (rule corres_splitEE_skip; corresKsimp; fastforce?)
-  apply (clarsimp simp: sc_relation_def)
-  done
-
-lemma decode_sc_ctrl_inv_corres:
-  "list_all2 cap_relation excaps excaps' \<Longrightarrow>
-   corres (ser \<oplus> sc_ctrl_inv_rel) \<top> \<top>
-          (decode_sched_control_invocation_flags (mi_label mi) args' excaps)
-          (decodeSchedControlInvocation (mi_label mi) args' excaps')"
-  apply (clarsimp simp: decode_sched_control_invocation_flags_def decodeSchedControlInvocation_def)
-  apply (cases "gen_invocation_type (mi_label mi)"
-         ; clarsimp simp: decodeSchedControl_ConfigureFlags_def TIME_ARG_SIZE_def timeArgSize_def)
-  apply (cases excaps; clarsimp)
-  apply (rename_tac cap list)
-  apply (cases excaps'; clarsimp)
-  apply (rule corres_splitEE_skip; (solves wpsimp)?)
-   apply corresKsimp
-  apply (rule corres_splitEE_forwards')
-     apply corresKsimp
-     apply (case_tac cap; clarsimp simp: isSchedContextCap_def)
-    apply (rule whenE_throwError_sp[simplified validE_R_def])+
-  apply corresKsimp
-  apply (auto simp: minBudgetUs_def MIN_BUDGET_US_def maxPeriodUs_def parse_time_arg_def
-                    parseTimeArg_def usToTicks_def minRefills_def MIN_REFILLS_def
-                    max_num_refills_eq_refillAbsoluteMax' refillAbsoluteMax_def max_refills_cap_def
-             split: cap.splits)
-  done
-
-lemma schedContextBindNtfn_corres:
-  "corres dc
-     (valid_objs and sc_ntfn_sc_at ((=) None) scp
-      and (obj_at (\<lambda>ko. \<exists>ntfn. ko = Notification ntfn \<and> ntfn_sc ntfn = None) ntfnp))
-     (ntfn_at' ntfnp and sc_at' scp)
-     (sched_context_bind_ntfn scp ntfnp) (schedContextBindNtfn scp ntfnp)"
-  unfolding sched_context_bind_ntfn_def schedContextBindNtfn_def
-  apply (clarsimp simp: update_sk_obj_ref_def bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getNotification_corres])
-      apply (rule corres_guard_imp)
-        apply (rule corres_split[OF setNotification_corres])
-           apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
-          apply (fold updateSchedContext_def)
-          apply (rule updateSchedContext_corres)
-            apply (clarsimp simp: opt_map_red opt_pred_def obj_at_simps is_sc_obj)
-            apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-            apply (clarsimp simp: sc_relation_def)
-           apply (clarsimp simp: opt_map_red obj_at_simps is_sc_obj)
-           apply (drule (1) sc_replies_relation_prevs_list'[OF state_relation_sc_replies_relation])
-           apply (clarsimp simp: opt_map_red)
-          apply (clarsimp simp: objBits_simps')
-         apply wpsimp
-        apply wpsimp
-       apply simp+
-     apply wpsimp+
-   apply (fastforce simp: obj_at_simps sc_ntfn_sc_at_def is_ntfn is_sc_obj valid_obj_def)
-  apply clarsimp
-  done
-
-crunch tcb_sched_action, complete_yield_to, reschedule_required, sched_context_resume
-  for in_user_frame[wp]: "in_user_frame buf"
-  (simp: crunch_simps wp: crunch_wps ignore: set_tcb_obj_ref)
-
-lemma
-  schedContext_valid_ipc_buffer_ptr'[wp]:
-  "setSchedContext scp sc \<lbrace>valid_ipc_buffer_ptr' x\<rbrace>" and
-  threadSet_valid_ipc_buffer_ptr'[wp]:
-  "threadSet f tp \<lbrace>valid_ipc_buffer_ptr' x\<rbrace>" and
-  modifyReadyQueuesL1Bitmap_valid_ipc_buffer_ptr'[wp]:
-  "modifyReadyQueuesL1Bitmap d g \<lbrace>valid_ipc_buffer_ptr' x\<rbrace>" and
-  modifyReadyQueuesL2Bitmap_valid_ipc_buffer_ptr'[wp]:
-  "modifyReadyQueuesL2Bitmap d n g \<lbrace>valid_ipc_buffer_ptr' x\<rbrace>" and
-  setQueue_valid_ipc_buffer_ptr'[wp]:
-  "setQueue d prio p \<lbrace>valid_ipc_buffer_ptr' x\<rbrace>"
-  unfolding valid_ipc_buffer_ptr'_def
-  by wpsimp+
-
-crunch schedContextCompleteYieldTo, tcbSchedEnqueue, tcbSchedDequeue,
-         rescheduleRequired, schedContextResume
-  for valid_ipc_buffer_ptr'[wp]: "valid_ipc_buffer_ptr' buf"
-  and sc_at'[wp]: "sc_at' scp"
-  and cur_tcb'[wp]: cur_tcb'
-  (simp: crunch_simps wp: crunch_wps threadSet_cur ignore: setSchedContext)
-
-lemma threadSet_tcbYieldTo_update_valid_queues:
-  "threadSet (tcbYieldTo_update f) t \<lbrace>valid_queues\<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: valid_queues_def valid_queues_no_bitmap_def' pred_tcb_at'_def)
-   apply (wp hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def' pred_tcb_at'_def)
-  apply (fastforce simp: obj_at'_def projectKOs inQ_def)
-  done
-
-lemma sc_yield_from_update_sc_tcb_sc_at[wp]:
-  "set_sc_obj_ref sc_yield_from_update scp ptr \<lbrace>sc_tcb_sc_at P scp\<rbrace>"
-  apply (wpsimp wp: update_sched_context_wp)
-  by (clarsimp simp: sc_tcb_sc_at_def obj_at_def)
-
-lemma schedContextYieldTo_corres:
-  "corres dc
-      ((case_option \<top> in_user_frame buf and einvs) and
-       (\<lambda>s. bound_yt_tcb_at ((=) None) (cur_thread s) s
-            \<and> sc_tcb_sc_at (\<lambda>sctcb. \<exists>t. sctcb = Some t \<and> t \<noteq> cur_thread s) scp s))
-      ((case_option \<top> valid_ipc_buffer_ptr' buf and invs') and
-       (\<lambda>s. bound_yt_tcb_at' ((=) None) (ksCurThread s) s \<and>
-                  obj_at' (\<lambda>sc. \<exists>t. scTCB sc = Some t \<and> t \<noteq> ksCurThread s) scp s))
-      (sched_context_yield_to scp buf) (schedContextYieldTo scp buf)"
-  (is "corres _ (?abs_buf and (\<lambda>s. ?ct s \<and> ?scp s)) (?con_buf and ?scp') _ _")
-  apply add_cur_tcb'
-  unfolding sched_context_yield_to_def schedContextYieldTo_def get_sc_obj_ref_def bind_assoc
-    contextYieldToUpdateQueues_def
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_sc_corres])
-      apply (rename_tac sc sc')
-      apply (rule_tac P="?abs_buf and ?ct and ?scp and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext sc n) scp s)"
-                 and P'="?con_buf and cur_tcb' and ko_at' sc' scp"
-             in corres_inst)
-      apply simp
-      apply (erule exE)
-      apply (rule corres_underlying_split[where r'=dc])
-         apply (simp only: when_def fromJust_def)
-         apply (rule corres_guard_imp)
-           apply (rule corres_if2)
-             apply (clarsimp simp: sc_relation_def)
-            apply (rule_tac F="scYieldFrom sc' = sc_yield_from sc" in corres_req)
-             apply (clarsimp simp: sc_relation_def)
-            apply (rule_tac P="?abs_buf and ?ct and ?scp
-                               and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext sc n) scp s)
-                               and K (bound (sc_yield_from sc))"
-                       and P'="?con_buf and cur_tcb' and ko_at' sc' scp"
-                   in corres_inst)
-            apply (rule corres_gen_asm')
-            apply (erule exE, simp only: option.sel)
-            apply (rule corres_guard_imp)
-              apply (rule corres_bind_return2)
-              apply (rule corres_split[OF schedContextCompleteYieldTo_corres])
-                apply (rule_tac P="?abs_buf and ?ct and ?scp and sc_yf_sc_at ((=) None) scp"
-                           and P'="?con_buf and cur_tcb'"
-                       in corres_inst)
-                apply simp
-                apply (rule corres_symb_exec_l)
-                   apply (rename_tac sc'')
-                   apply (rule corres_bind_return)
-                   apply (rule corres_assert_assume_l)
-                   apply simp
-                  apply (wpsimp wp: get_sched_context_exs_valid simp: sc_yf_sc_at_def obj_at_def)
-                 apply (wpsimp simp: sc_yf_sc_at_def obj_at_def)
-                apply (wpsimp simp: sc_yf_sc_at_def obj_at_def)
-               supply if_split[split del]
-               apply ((wpsimp wp: complete_yield_to_sc_yf_sc_at_None hoare_case_option_wp
-                                  complete_yield_to_invs complete_yield_to_sc_tcb_sc_at
-                     | wps)+)[1]
-              apply (wpsimp wp: hoare_case_option_wp)
-             apply clarsimp
-             apply (fastforce simp: valid_obj_def valid_sched_context_def obj_at_def sc_yf_sc_at_def
-                             dest!: invs_valid_objs)
-            apply clarsimp
-            apply (fastforce simp: valid_obj'_def valid_sched_context'_def obj_at'_def projectKOs
-                            dest!: invs_valid_objs')
-
-           apply (rule_tac P="?abs_buf and sc_at scp"
-                      and P'="?con_buf and cur_tcb' and sc_at' scp" in corres_inst)
-           apply simp
-          apply (clarsimp simp: sc_yf_sc_at_def sc_tcb_sc_at_def obj_at_def is_sc_obj)
-          apply (fastforce dest!: invs_valid_objs simp: valid_obj_def valid_sched_context_def obj_at_def)
-         apply clarsimp
-        apply simp
-        apply (rule_tac P="?abs_buf and sc_yf_sc_at ((=) None) scp and ?ct and ?scp"
-                   and P'="?con_buf and cur_tcb' and sc_at' scp"
-               in corres_inst)
-        apply (rule corres_guard_imp)
-          apply (rule corres_split[OF schedContextResume_corres])
-            apply (rule corres_split[OF get_sc_corres _ get_sched_context_wp getSchedContext_wp])
-            apply (rename_tac sc0 sc0')
-            apply (rule_tac F="scTCB sc0' = sc_tcb sc0" in corres_req)
-             apply (clarsimp simp: sc_relation_def)
-            apply (rule corres_assert_opt_assume_l)
-            apply (rule_tac P="?abs_buf and sc_yf_sc_at ((=) None) scp and ?ct and ?scp
-                               and (\<lambda>s. \<exists>n. ko_at (Structures_A.SchedContext sc0 n) scp s)
-                               and K (bound (sc_tcb sc0))"
-                       and P'="?con_buf and cur_tcb' and ko_at' sc0' scp"
-                   in corres_inst)
-            apply (rule corres_gen_asm')
-            apply (elim exE)
-            apply (rename_tac tp)
-            apply (simp only: option.sel pred_conj_def simp_thms(21))
-            apply (rule corres_guard_imp)
-              apply (rule corres_split_eqr[OF isSchedulable_corres])
-                apply (rename_tac sched)
-                apply (rule corres_split_eqr)
-                   apply (rule_tac P="?abs_buf and sc_yf_sc_at ((=) None) scp and ?ct and ?scp
-                                      and (\<lambda>s. sched = schedulable tp s) and tcb_at tp
-                                      and sc_tcb_sc_at ((=) (Some tp)) scp"
-                              and P'="?con_buf and cur_tcb' and tcb_at' tp and ko_at' sc0' scp
-                                      and (\<lambda>s. scTCBs_of s scp = Some tp)"
-                          in corres_inst)
-                   apply (rule corres_guard_imp)
-                     apply (rule corres_if2, simp)
-                      apply (rule corres_split_eqr[OF getCurThread_corres])
-                        apply (rename_tac ct_ptr)
-                        apply (rule corres_split_eqr[OF threadGet_corres])
-                           apply (clarsimp simp: tcb_relation_def)
-                          apply (rule corres_split_eqr[OF threadGet_corres])
-                             apply (clarsimp simp: tcb_relation_def)
-                            apply (rule corres_if2)
-                              apply simp
-                             apply simp
-                             apply (rule corres_split[OF tcbSchedDequeue_corres])
-                               apply (rule corres_split[OF tcbSchedEnqueue_corres])
-                                 apply simp
-                                apply (wpsimp wp: tcbSchedDequeue_valid_queues)+
-                            apply (rule corres_split[OF tcb_yield_to_update_corres])
-                              apply (rule_tac sc'1=sc0' in corres_split[OF update_sc_no_reply_stack_update_ko_at'_corres])
-                                    apply ((clarsimp simp: sc_relation_def objBits_simps')+)[4]
-                                apply (rule_tac P="valid_objs and pspace_aligned and pspace_distinct
-                                                   and weak_valid_sched_action and active_scs_valid
-                                                   and sc_yf_sc_at ((=) (Some ct_ptr)) scp and ?scp
-                                                   and bound_yt_tcb_at ((=) (Some scp)) ct_ptr
-                                                   and tcb_at ct_ptr and tcb_at tp
-                                                   and sc_tcb_sc_at ((=) (Some tp)) scp"
-                                           and P'="valid_objs' and valid_queues and valid_queues' and cur_tcb'
-                                                   and valid_release_queue_iff and tcb_at' tp and sc_at' scp
-                                                   and obj_at' (\<lambda>sc. scYieldFrom sc = Some ct_ptr) scp
-                                                   and (\<lambda>s. scTCBs_of s scp = Some tp)"
-                                       in corres_inst)
-                                apply (rule corres_guard_imp)
-                                  apply (rule corres_split[OF tcbSchedDequeue_corres])
-                                    apply (rule corres_split[OF tcbSchedEnqueue_corres])
-                                      apply (rule corres_split[OF tcbSchedEnqueue_corres])
-                                        apply (rule corres_split[OF rescheduleRequired_corres])
-                                          apply simp
-                                         apply (wpsimp wp: tcbSchedDequeue_valid_queues)+
-                                apply (clarsimp simp: obj_at'_def projectKOs valid_objs'_valid_tcbs'
-                                               elim!: opt_mapE)
-                                apply (prop_tac "\<exists>tcb. ko_at' tcb tp s")
-                                 apply (fastforce simp: valid_obj'_def valid_sched_context'_def obj_at'_def)
-                                apply clarsimp
-                                apply (drule (1) tcb_ko_at_valid_objs_valid_tcb'[rotated])
-                                apply (clarsimp simp: valid_tcb'_def obj_at'_def projectKOs inQ_def tcb_cte_cases_def)
-                               apply (wpsimp wp: hoare_case_option_wp set_yf_sc_yf_sc_at[simplified op_equal])
-                              apply (wpsimp wp:hoare_case_option_wp)
-                              apply (wpsimp wp: set_sc'.obj_at' set_sc'.set_wp)
-                             apply (wpsimp wp: syt_bound_tcb_at')
-                            apply (clarsimp cong: conj_cong)
-                            apply (wpsimp wp: threadSet_valid_queues threadSet_valid_queues'
-                                              threadSet_vrq'_inv threadSet_vrq_inv threadSet_cur
-                                              threadSet_valid_objs' hoare_drop_imp
-                                        simp: fun_upd_def[symmetric])
-                           apply (rule_tac
-                                    Q="\<lambda>_. sc_at scp and
-                                           valid_objs and
-                                           pspace_aligned and
-                                           pspace_distinct and
-                                           weak_valid_sched_action and
-                                           active_scs_valid and
-                                           (\<lambda>s. bound_yt_tcb_at ((=) None) (cur_thread s) s) and
-                                           (\<lambda>s. sc_tcb_sc_at (\<lambda>sctcb. \<exists>t. sctcb = Some t \<and> t \<noteq> cur_thread s) scp s) and
-                                           tcb_at ct_ptr and
-                                           tcb_at tp and sc_tcb_sc_at ((=) (Some tp)) scp"
-                                  in hoare_strengthen_post)
-                            apply (wpsimp cong: conj_cong imp_cong wp: hoare_drop_imp hoare_vcg_conj_lift)
-                           apply clarsimp
-                          apply (rule_tac Q'="\<lambda>_. valid_objs' and cur_tcb'
-                                                 and (\<lambda>s. scTCBs_of s scp = Some tp)
-                                                 and ko_at' sc0' scp and tcb_at' ct_ptr
-                                                 and valid_release_queue_iff and valid_queues and valid_queues'"
-                                 in hoare_strengthen_post)
-                           apply (wpsimp wp: setSchedContext_scTCBs_of)
-                          apply (clarsimp simp: projectKOs opt_map_red)
-                          apply (frule (1) sc_ko_at_valid_objs_valid_sc'[rotated])
-                          apply (clarsimp simp: valid_sched_context'_def valid_sched_context_size'_def
-                                                obj_at'_def projectKOs)
-                          apply (erule_tac x=tp in valid_objsE', simp)
-                          apply (fastforce simp: valid_obj'_def valid_tcb'_def obj_at'_def projectKOs
-                                                 inQ_def tcb_cte_cases_def objBits_simps' scBits_simps)
-                         apply (wpsimp wp: hoare_vcg_if_lift2 hoare_drop_imp)
-                        apply (wpsimp wp: hoare_vcg_if_lift2 hoare_drop_imp)
-                       apply wpsimp
-                      apply wpsimp
-                     apply (rule_tac P="?abs_buf and sc_yf_sc_at ((=) None) scp and ?scp
-                                        and (\<lambda>s. sched = schedulable tp s)"
-                                 and P'="?con_buf and cur_tcb' and ko_at' sc0' scp"
-                            in corres_inst)
-                     apply simp
-                    apply (intro conjI impI; clarsimp cong: conj_cong)
-                    apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_def
-                                          valid_sched_action_weak_valid_sched_action pred_tcb_at_def
-                                          sc_tcb_sc_at_def obj_at_def is_tcb is_sc_obj)
-                    apply (fastforce simp: obj_at_def elim!: valid_sched_context_size_objsI)
-                   apply (clarsimp cong: conj_cong simp: invs'_def valid_pspace'_def cur_tcb'_def)
-                  apply (rule corres_when, simp)
-                  apply (rule setConsumed_corres)
-                 apply (clarsimp simp:obj_at'_def projectKOs)
-                 apply (wpsimp wp: thread_get_wp hoare_case_option_wp)+
-                   apply (wpsimp wp: threadGet_wp)+
-               apply (wpsimp wp: is_schedulable_wp)
-              apply (wpsimp wp: isSchedulable_wp)
-             apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_objs_valid_tcbs
-                             cong: conj_cong imp_cong if_cong)
-             apply (rule context_conjI;
-                    clarsimp simp: obj_at_def sc_tcb_sc_at_def is_sc_obj
-                            elim!: valid_sched_context_size_objsI dest!: invs_valid_objs)
-              apply (fastforce simp: valid_obj_def obj_at_def valid_sched_context_def)
-             apply (intro conjI impI; clarsimp simp: is_tcb pred_tcb_at_def obj_at_def)
-              apply (erule (1) valid_sched_context_size_objsI)+
-            apply (clarsimp simp: invs'_def valid_pspace'_def valid_objs'_valid_tcbs')
-            apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-           apply (rule_tac Q'="\<lambda>rv. (case buf of None \<Rightarrow> \<lambda>_. True | Some x \<Rightarrow> in_user_frame x) and
-                                   einvs and sc_yf_sc_at ((=) None) scp and
-                                   (\<lambda>s. bound_yt_tcb_at ((=) None) (cur_thread s) s \<and>
-                                        sc_tcb_sc_at (\<lambda>sctcb. \<exists>t. sctcb = Some t \<and> t \<noteq> cur_thread s) scp s)"
-                  in hoare_strengthen_post[rotated])
-            apply (fastforce simp: sc_tcb_sc_at_def obj_at_def is_sc_obj
-                            elim!: valid_sched_context_size_objsI[OF invs_valid_objs])
-           apply (wpsimp wp: hoare_case_option_wp sched_context_resume_valid_sched)
-           apply ((wpsimp | wps)+)[1]
-          apply (rule_tac Q'="\<lambda>rv'. (case buf of None \<Rightarrow> \<lambda>_. True | Some x \<Rightarrow> valid_ipc_buffer_ptr' x)
-                                   and invs' and sc_at' scp and cur_tcb'"
-                 in hoare_strengthen_post[rotated])
-           apply clarsimp
-          apply (wpsimp wp:hoare_case_option_wp)
-         apply clarsimp
-         apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_def)
-         apply (fastforce simp: sc_tcb_sc_at_def obj_at_def)
-        apply (clarsimp simp: invs'_def valid_pspace'_def obj_at'_def projectKOs)
-       apply wpsimp
-        apply (rule_tac Q'="\<lambda>_ s. (case buf of None \<Rightarrow> \<lambda>_. True | Some x \<Rightarrow> in_user_frame x) s \<and>
-                                 invs s \<and> valid_list s \<and> valid_sched s \<and>
-                                 bound_yt_tcb_at ((=) None) (cur_thread s) s \<and>
-                                 sc_tcb_sc_at (\<lambda>sctcb. \<exists>t. sctcb = Some t \<and> t \<noteq> cur_thread s) scp s"
-               in hoare_strengthen_post[rotated])
-         apply (clarsimp simp: sc_yf_sc_at_def obj_at_def)
-        apply (wpsimp wp: hoare_case_option_wp complete_yield_to_invs split: option.splits)
-        apply ((wpsimp wp: complete_yield_to_sc_tcb_sc_at | wps)+)
-       apply (clarsimp split: if_split simp: sc_yf_sc_at_def obj_at_def)
-      apply (wpsimp wp: hoare_case_option_wp schedContextCompleteYieldTo_invs' split: option.splits)
-     apply wpsimp+
-   apply (fastforce simp: sc_tcb_sc_at_def obj_at_def is_sc_obj
-                   elim!: valid_sched_context_size_objsI[OF invs_valid_objs])
-  apply clarsimp
-  done
-
-crunch sched_context_unbind_ntfn, sched_context_unbind_all_tcbs
-  for sc_at[wp]: "sc_at scp"
-  (wp: crunch_wps)
-
-crunch schedContextUnbindNtfn, schedContextUnbindAllTCBs
-  for sc_at'[wp]: "sc_at' scp"
-  (wp: crunch_wps)
-
-lemma invokeSchedContext_corres:
-  "sc_inv_rel sc_inv sc_inv' \<Longrightarrow>
-   corres (=)
-          (einvs and valid_sched_context_inv sc_inv and simple_sched_action
-           and current_time_bounded)
-          (invs' and sch_act_simple and valid_sc_inv' sc_inv')
-          (invoke_sched_context sc_inv)
-          (invokeSchedContext sc_inv')"
-  apply (simp add: invoke_sched_context_def invokeSchedContext_def)
-  apply (cases sc_inv; cases sc_inv'; clarsimp simp: cap_relation_def)
-      apply (rule corres_rel_imp)
-       apply (rule corres_guard_imp)
-         apply (rule setConsumed_corres)
-        apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-       apply clarsimp
-      apply simp
-     apply (clarsimp  split: cap.split capability.split; intro conjI impI allI; clarsimp)
-      apply (rule corres_guard_imp)
-        apply (rule corres_rel_imp)
-         apply (rule schedContextBindTCB_corres, simp)
-       apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-      apply clarsimp
-     apply (rule corres_guard_imp)
-       apply (rule corres_rel_imp)
-        apply (rule schedContextBindNtfn_corres)
-       apply simp
-      apply clarsimp
-     apply (clarsimp simp: obj_at'_def)
-    apply (clarsimp  split: cap.split capability.split; intro conjI impI allI; clarsimp)
-     apply (rule corres_guard_imp)
-       apply (rule corres_rel_imp)
-        apply (rule schedContextUnbindTCB_corres, simp)
-      apply (clarsimp simp: sc_tcb_sc_at_def obj_at_def obj_at'_def)+
-    apply (rule corres_guard_imp)
-      apply (rule corres_rel_imp)
-       apply (rule schedContextUnbindNtfn_corres, simp)
-     apply (clarsimp simp: sc_ntfn_sc_at_def obj_at_def is_sc_obj)+
-     apply (fastforce simp: valid_sched_context_size_objsI dest!: invs_valid_objs)
-    apply simp
-   apply (rule corres_guard_imp)
-     apply (rule corres_rel_imp)
-      apply (rule corres_split[OF schedContextUnbindAllTCBs_corres])
-        apply (rule corres_split[OF schedContextUnbindNtfn_corres])
-          apply (rule schedContextUnbindReply_corres)
-         apply wpsimp+
-    apply (fastforce dest!: ex_nonz_cap_to_not_idle_sc_ptr)
-   apply wpsimp
-   apply (frule invs_valid_global')
-   apply (fastforce dest!: invs_valid_pspace' global'_sc_no_ex_cap)
-  apply (rule corres_guard_imp)
-    apply (rule corres_rel_imp)
-     apply (rule schedContextYieldTo_corres)
-    apply simp
-   apply clarsimp
-  apply clarsimp
-  done
-
-lemmas sc_relation_refillResetRR1 =
-  sc_relation_updateRefillTl[where f="r_amount_update (\<lambda>_. 0)" and f'="rAmount_update (\<lambda>_. 0)"]
-
-lemma sc_relation_refillResetRR2:
-  "\<lbrakk>sc_relation sc n sc'; length (sc_refills sc) = 2; sc_refill_max sc = MIN_REFILLS;
-    sc_valid_refills' sc'; 1 < scRefillCount sc'\<rbrakk>
-    \<Longrightarrow> sc_relation
-             (sc_refills_update
-               (\<lambda>refills. r_amount_update (\<lambda>m. m + r_amount (hd (tl refills))) (hd refills) # tl refills)
-               sc)
-             n ((scRefills_update
-                         (\<lambda>_. updateAt (scRefillHead sc') (scRefills sc')
-                                (\<lambda>hd. rAmount_update (\<lambda>_. rAmount hd + rAmount (refillTl sc')) hd)))
-                 sc')"
-  apply (case_tac "sc_refills sc"; simp)
-  apply (rename_tac ls; case_tac ls; clarsimp simp: MIN_REFILLS_def)
-  apply (cases sc; simp add: sc_relation_def refills_map_def)
-  apply (prop_tac "scRefillCount sc' = 2")
-   apply (insert length_wrap_slice[of "scRefillCount sc'" "scRefillMax sc'" "scRefillHead sc'" "scRefills sc'"])
-   apply (case_tac "scRefillHead sc'"; simp)
-  apply (clarsimp simp: refill_map_def updateAt_def Let_def null_def)
-  apply (clarsimp simp: wrap_slice_def)
-  apply (intro conjI; clarsimp simp: updateAt_def Let_def null_def refill_map_def)
-   apply (case_tac "scRefills sc'"; simp)
-   apply (rename_tac list; case_tac list; simp add: refill_map_def refillTl_def refillTailIndex_def)
-  apply (case_tac "scRefillHead sc'"; simp)
-  apply (intro conjI; clarsimp)
-  apply (case_tac "scRefills sc'"; simp)
-  apply (rename_tac list; case_tac list; simp add: refill_map_def refillTl_def refillTailIndex_def)
-  done
-
-lemma sc_relation_refillResetRR:
-  "\<lbrakk>sc_relation sc n sc'; length (sc_refills sc) = 2; sc_refill_max sc = MIN_REFILLS;
-    sc_valid_refills' sc'; 1 < scRefillCount sc'\<rbrakk>
-   \<Longrightarrow> sc_relation
-             (sc_refills_update
-               ((\<lambda>refills. butlast refills @ [last refills\<lparr>r_amount := 0\<rparr>]) \<circ>
-                (\<lambda>refills. r_amount_update (\<lambda>m. m + r_amount (hd (tl refills))) (hd refills) # tl refills))
-               sc)
-             n (((\<lambda>sc. scRefills_update (\<lambda>_. updateAt (refillTailIndex sc) (scRefills sc) (rAmount_update (\<lambda>_. 0)))
-                         sc) \<circ>
-                 (\<lambda>sc. scRefills_update
-                         (\<lambda>_. updateAt (scRefillHead sc) (scRefills sc)
-                                (\<lambda>hd. rAmount_update (\<lambda>_. rAmount hd + rAmount (refillTl sc)) hd))
-                         sc))
-                 sc')"
-  apply (drule sc_relation_refillResetRR2; fastforce?)
-  by (drule sc_relation_refillResetRR1; clarsimp simp: refill_map_def)
-
-lemma refillResetRR_corres:
-  "corres dc (sc_at csc_ptr and is_active_sc csc_ptr
-                  and round_robin csc_ptr and valid_refills csc_ptr)
-             (valid_objs' and sc_at' csc_ptr)
-             (refill_reset_rr csc_ptr) (refillResetRR csc_ptr)"
-  (is "corres dc ?abs ?conc _ _")
-  supply projection_rewrites[simp]
-  apply (subst is_active_sc_rewrite)
-  apply (subst valid_refills_rewrite)
-  apply (rule_tac Q="is_active_sc' csc_ptr" in corres_cross_add_guard)
-   apply (fastforce dest!: is_active_sc'_cross[OF state_relation_pspace_relation])
-  apply (rule_tac Q="\<lambda>s'. ((\<lambda>sc'. scRefillCount sc' = 2) |< scs_of' s') csc_ptr"
-         in corres_cross_add_guard)
-   apply (clarsimp simp: obj_at'_def projectKOs round_robin2_def obj_at_def is_sc_obj
-                         rr_valid_refills_def is_active_sc2_def is_active_sc'_def opt_map_red
-                         opt_pred_def)
-   apply (drule (1) pspace_relation_absD[where x=csc_ptr, OF _ state_relation_pspace_relation])
-   apply (erule (1) valid_objsE')
-   apply (clarsimp simp: sc_relation_def refills_map_def valid_sched_context'_def valid_obj'_def)
-  apply (clarsimp simp: refill_reset_rr_def refillResetRR_def get_refills_def updateRefillTl_def
-                        update_sched_context_decompose[symmetric, simplified] update_refill_tl_def)
-  apply (rule corres_guard_imp)
-    apply (rule monadic_rewrite_corres_r[OF monadic_rewrite_sym[OF updateSchedContext_decompose[simplified]]])
-    apply (rule updateSchedContext_corres_gen[where
-                 P="(\<lambda>s. ((\<lambda>sc. length (sc_refills sc) = 2 \<and> sc_refill_max sc = MIN_REFILLS) |< scs_of2 s) csc_ptr)"
-            and P'="valid_objs' and is_active_sc' csc_ptr and (\<lambda>s'. ((\<lambda>sc'. scRefillCount sc' = 2) |< scs_of' s') csc_ptr)"])
-      apply (clarsimp, drule (2) state_relation_sc_relation)
-      apply (clarsimp simp: is_sc_obj obj_at_simps is_active_sc'_def opt_map_red opt_pred_def)
-      apply (erule (1) valid_objsE', clarsimp simp: valid_obj'_def valid_sched_context'_def)
-      apply (fastforce elim!: sc_relation_refillResetRR[simplified])
-     apply (fastforce simp: obj_at_simps is_sc_obj opt_map_red
-                     dest!: state_relation_sc_replies_relation_sc)
-    apply (clarsimp simp: objBits_simps)+
-   apply (clarsimp simp: round_robin2_def obj_at_def is_sc_obj rr_valid_refills_def opt_map_red
-                         opt_pred_def)
-  by (clarsimp simp: objBits_simps)
-
-lemma refillNew_corres:
-  "\<lbrakk>1 < max_refills; valid_refills_number' max_refills (minSchedContextBits + n)\<rbrakk>
-   \<Longrightarrow> corres dc
-         (pspace_aligned and pspace_distinct and sc_obj_at n sc_ptr) valid_objs'
-            (refill_new sc_ptr max_refills budget period)
-            (refillNew sc_ptr max_refills budget period)"
-  supply projection_rewrites[simp]
-  supply getSchedContext_wp[wp del] set_sc'.get_wp[wp del]
-  apply (rule corres_cross_add_guard[where Q = "sc_at' sc_ptr
-                                                and (\<lambda>s'. ((\<lambda>sc. scSize sc = n) |< scs_of' s') sc_ptr)"])
-   apply (fastforce dest!: sc_obj_at_cross[OF state_relation_pspace_relation]
-                     simp: obj_at'_def opt_map_red opt_pred_def objBits_simps projectKOs)
-  apply (unfold refillNew_def refill_new_def setRefillHd_def updateRefillHd_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_eqr[OF getCurTime_corres])
-      (* period *)
-      apply (rule corres_split[OF updateSchedContext_corres]; clarsimp simp: objBits_simps)
-          apply (fastforce simp: obj_at_simps is_sc_obj sc_relation_def opt_map_red opt_pred_def
-                          dest!: state_relation_sc_relation)
-         apply (fastforce simp: obj_at_simps is_sc_obj opt_map_red
-                         dest!: state_relation_sc_replies_relation_sc)
-        (* budget, max_refills, sc_refills update: rewrite into one step updateSchedContext corres *)
-        apply (rename_tac ctime)
-        apply (rule_tac P="sc_obj_at n sc_ptr and (\<lambda>s. ctime = cur_time s)"
-                    and P'="sc_at' sc_ptr and (\<lambda>s'. ctime = ksCurTime s')
-                            and (\<lambda>s'. ((\<lambda>sc'. scSize sc' = n
-                                              \<and> length (scRefills sc') =
-                                                refillAbsoluteMax' (minSchedContextBits + scSize sc'))
-                                       |< scs_of' s') sc_ptr)"
-               in corres_inst)
-        apply (subst bind_assoc[symmetric])+
-        apply (subst update_sched_context_decompose[symmetric, simplified])+
-        apply (subst bind_assoc)
-        apply (rule corres_guard_imp)
-          apply (rule corres_split[OF monadic_rewrite_corres_r
-                                       [OF monadic_rewrite_sym
-                                        [OF updateSchedContext_decompose_x2[simplified]]]])
-               apply (clarsimp simp: objBits_simps)+
-              (* use setSchedContext_corres *)
-               apply (rule monadic_rewrite_corres_l[OF update_sched_context_rewrite[where n=n]])
-               apply (simp add: updateSchedContext_def)
-               apply (rule corres_split[OF get_sc_corres_size[where n=n]])
-                 apply (rename_tac sc')
-                 apply (rule_tac P="ko_at (kernel_object.SchedContext sc n) sc_ptr"
-                             and P'="\<lambda>s'. ko_at' sc' sc_ptr s'
-                                          \<and> ((\<lambda>sc'. length (scRefills sc') =
-                                                    refillAbsoluteMax' (minSchedContextBits + scSize sc')
-                                                    \<and> scSize sc' = n)
-                                             |< scs_of' s') sc_ptr"
-                        in corres_inst)
-                 apply (rule_tac F="length (scRefills sc') =
-                                    refillAbsoluteMax' (minSchedContextBits + scSize sc')"
-                              in corres_req)
-                  apply (fastforce simp: obj_at_simps opt_map_red opt_pred_def)
-                 apply (rule stronger_corres_guard_imp)
-                   apply (rule_tac sc'="sc'\<lparr> scRefillMax := max_refills,
-                                             scRefillHead := 0,
-                                             scRefillCount := Suc 0,
-                                             scRefills := updateAt 0 (scRefills sc') (\<lambda>r. Refill ctime budget)\<rparr>"
-                          in setSchedContext_corres)
-                    apply (clarsimp simp: sc_relation_def refills_map_def valid_refills_number'_def
-                                          wrap_slice_start_0 max_num_refills_eq_refillAbsoluteMax')
-                    apply (case_tac "scRefills sc'"; simp add: updateAt_def null_def refill_map_def)
-                   apply (clarsimp simp: objBits_simps scBits_simps sc_relation_def)
-                  apply simp
-                 apply (fastforce simp: obj_at_simps is_sc_obj opt_map_red
-                                 dest!: sc_replies_relation_prevs_list[OF state_relation_sc_replies_relation])
-                apply (wpsimp wp: getSchedContext_wp')+
-            (* last step : add tail *)
-            apply (rule_tac P="sc_obj_at n sc_ptr and is_active_sc2 sc_ptr"
-                        and P'="sc_at' sc_ptr
-                                and (\<lambda>s'. ((\<lambda>sc'. length (scRefills sc') =
-                                                  refillAbsoluteMax' (minSchedContextBits + scSize sc')
-                                                  \<and> scSize sc' = n
-                                                  \<and> scRefillHead sc' = 0 \<and> scRefillCount sc' = 1
-                                                  \<and> scRefillMax sc' = max_refills)
-                                           |< scs_of' s') sc_ptr)"
-                   in corres_inst)
-            apply (rule stronger_corres_guard_imp)
-              apply (rule maybeAddEmptyTail_corres)
-             apply simp
-            apply (clarsimp simp: obj_at_simps is_sc_obj scBits_simps opt_map_red opt_pred_def
-                                  valid_refills_number'_def)
-            apply (clarsimp simp: valid_sched_context'_def)
-           apply (wpsimp wp: update_sched_context_wp updateSchedContext_wp)+
-         apply (clarsimp simp:  obj_at_def is_sc_obj is_active_sc2_def)
-        apply (clarsimp simp: obj_at_simps fun_upd_def[symmetric] valid_objs'_def ps_clear_upd
-                              opt_map_red opt_pred_def)
-       apply (wpsimp wp: update_sched_context_wp updateSchedContext_wp)+
-   apply (clarsimp simp:  obj_at_def is_sc_obj is_active_sc2_def)
-  apply (clarsimp simp: obj_at_simps fun_upd_def[symmetric] ps_clear_upd opt_map_red opt_pred_def)
-  apply (fastforce simp: valid_objs'_def valid_obj'_def valid_sched_context'_def
-                  split: kernel_object.splits)
-  done
-
-lemma refillUpdate_corres:
-  "\<lbrakk>1 < max_refills; valid_refills_number' max_refills (minSchedContextBits + n)\<rbrakk>
-   \<Longrightarrow> corres dc
-              ((is_active_sc2 sc_ptr and sc_obj_at n sc_ptr) and (pspace_aligned and pspace_distinct))
-              (valid_refills' sc_ptr and valid_objs')
-              (refill_update sc_ptr period budget max_refills)
-              (refillUpdate sc_ptr period budget max_refills)"
-  (is "_ \<Longrightarrow> _ \<Longrightarrow> corres _ (?pred and _) ?conc _ _")
-  supply getSchedContext_wp[wp del] set_sc'.get_wp[wp del] projection_rewrites[simp]
-  apply (rule corres_cross_add_guard[where Q = "sc_at' sc_ptr"])
-   apply (fastforce dest!: sc_obj_at_cross[OF state_relation_pspace_relation]
-                     simp: obj_at'_def opt_map_red objBits_simps)
-  apply (rule_tac Q="is_active_sc' sc_ptr" in corres_cross_add_guard)
-   apply (rule is_active_sc'_cross, fastforce+)
-  apply (rule corres_guard_imp)
-    apply (rule_tac P="?pred" and P'="?conc and sc_at' sc_ptr" in corres_inst)
-    apply (unfold refillUpdate_def refill_update_def)
-    apply simp
-    (* rewrite the refill list update steps into one step updateSchedContext corres *)
-    apply (subst bind_assoc[where m="update_sched_context _ _", symmetric])
-    apply (subst update_sched_context_decompose[symmetric, simplified])
-    apply (subst bind_assoc[where m="updateSchedContext _ _", symmetric])
-    apply (subst bind_assoc[where m="do _ \<leftarrow> updateSchedContext _ _; updateSchedContext _ _ od", symmetric])
-    apply (subst bind_assoc[where m="do _ \<leftarrow> (do _ \<leftarrow> updateSchedContext _ _; updateSchedContext _ _ od);
-                                     updateSchedContext _ _ od", symmetric])
-    apply (subst bind_assoc[where m="updateSchedContext _ _"])
-    apply (subst bind_assoc[where m="updateSchedContext _ _"])
-    apply (subst bind_assoc[where m="updateSchedContext _ _"])
-    apply (rule stronger_corres_guard_imp)
-      apply (rule corres_split[OF  monadic_rewrite_corres_r
-                                     [OF monadic_rewrite_sym
-                                             [OF updateSchedContext_decompose_x3[simplified]]]])
-           apply ((clarsimp simp: objBits_simps)+)[2]
-                                       (* now use setSchedContext_corres *)
-             apply (rule corres_inst[where P="?pred and sc_obj_at n sc_ptr" and P'="?conc and sc_at' sc_ptr"])
-             (* one of the sc_obj_at n sc_ptr will be consumed by the next line *)
-             apply (rule monadic_rewrite_corres_l[OF update_sched_context_rewrite[where n=n]])
-             apply (simp add: updateSchedContext_def)
-             apply (rule stronger_corres_guard_imp)
-               apply (rule corres_split[OF get_sc_corres_size[where n=n]])
-                 apply (rename_tac sc sc')
-                 apply (rule_tac P="?pred and ko_at (kernel_object.SchedContext sc n) sc_ptr"
-                             and P'="ko_at' sc' sc_ptr and valid_sched_context' sc'
-                                     and K (0 < scRefillMax sc' \<and> sc_valid_refills' sc')"
-                        in corres_inst)
-                apply (rule_tac F="0 < scRefillMax sc' \<and> sc_valid_refills' sc'
-                                    \<and> length (scRefills sc') = max_num_refills (minSchedContextBits + n)"
-                        in corres_req)
-                  apply (clarsimp simp: obj_at'_def objBits_simps scBits_simps
-                                        valid_sched_context'_def sc_relation_def)
-                 apply (rule stronger_corres_guard_imp)
-                   apply (rule setSchedContext_corres)
-                    apply (unfold sc_relation_def; elim conjE exE; intro conjI; fastforce?)
-                    apply (clarsimp simp: refills_map_def wrap_slice_start_0 hd_map neq_Nil_lengthI
-                                          refill_map_def updateAt_def null_def refillHd_def hd_wrap_slice
-                                          valid_refills_number'_def max_num_refills_eq_refillAbsoluteMax')
-                   apply (clarsimp simp: objBits_simps scBits_simps sc_relation_def)
-                  apply simp
-                 apply (clarsimp simp: obj_at_simps scBits_simps is_sc_obj)
-                 apply (fastforce elim!: sc_replies_relation_prevs_list[OF state_relation_sc_replies_relation])
-                apply wpsimp
-               apply (wpsimp wp: getSchedContext_wp')
-              apply (clarsimp simp: obj_at_def is_sc_obj)
-             apply (drule state_relation_sc_relation[where ptr=sc_ptr];
-                   (fastforce simp: obj_at_simps is_sc_obj obj_bits_def)?)
-             apply (clarsimp simp: obj_at_simps is_sc_obj valid_refills_number'_def scBits_simps
-                                   opt_map_red opt_pred_def valid_refills'_def sc_relation_def
-                                   valid_objs'_def valid_obj'_def)
-             apply force
-            apply ((clarsimp simp: objBits_simps)+)[2]
-        (* sc_budget and sc_period *)
-        apply (subst bind_assoc[where m="update_sched_context _ _", symmetric])
-        apply (subst update_sched_context_decompose[symmetric, simplified])
-        apply (rule corres_split[OF updateSchedContext_corres])
-             apply (fastforce dest!: state_relation_sc_relation
-                               simp: obj_at_simps is_sc_obj sc_relation_def opt_map_red opt_pred_def)
-            apply (fastforce dest!: state_relation_sc_replies_relation_sc
-                              simp: obj_at_simps is_sc_obj sc_relation_def opt_map_red)
-           apply (simp add: objBits_simps)
-            (* the rest *)
-            apply (rule_tac P="sc_obj_at n sc_ptr and
-                              (\<lambda>s. ((\<lambda>sc. sc_refills sc\<noteq> [] \<and> 0 < sc_refill_max sc) |< scs_of s) sc_ptr)"
-                       and P'="sc_at' sc_ptr and
-                              (\<lambda>s'. ((\<lambda>ko. 1 < scRefillMax ko \<and> scRefillCount ko = 1 \<and> sc_valid_refills' ko)
-                                     |< scs_of' s') sc_ptr)"
-                   in corres_inst)
-            apply (simp add: when_def[symmetric] whenM_def ifM_def bind_assoc split del: if_split)
-            apply (rule corres_guard_imp)
-              apply (rule corres_split[OF refillReady_corres]) (* projection version *)
-                (* when-block *)
-                apply (rule corres_split[OF corres_when], simp)
-                   apply (rule corres_split[OF getCurTime_corres])
-                     apply (rule corres_guard_imp)
-                       apply (rule updateRefillHd_corres, simp)
-                       apply (simp add: refill_map_def)
-                      apply (simp+)[2]
-                    apply (wpsimp+)[2]
-                  apply (simp add: liftM_def bind_assoc)
-                  apply (rule corres_split[OF get_sc_corres])
-                    (* if-block *)
-                    apply (rename_tac sc sc')
-                    apply (rule_tac P="ko_at (kernel_object.SchedContext sc n) sc_ptr
-                                       and K (0 < sc_refill_max sc) and K (sc_refills sc \<noteq> [])
-                                        and K (valid_sched_context_size n)"
-                                and P'="ko_at' sc' sc_ptr
-                                        and K (1 < scRefillMax sc' \<and> scRefillCount sc' = 1
-                                               \<and> sc_valid_refills' sc')"
-                           in corres_inst)
-                    apply (rule_tac F="refill_hd sc = refill_map (refillHd sc')" in corres_req)
-                     apply (fastforce dest!: refill_hd_relation)
-                    apply (rule corres_guard_imp)
-                      apply (rule corres_if)
-                        apply (clarsimp simp: refill_map_def)
-                       apply (rule corres_split[OF updateRefillHd_corres], simp)
-                          apply (clarsimp simp: refill_map_def)
-                         apply (rule maybeAddEmptyTail_corres[simplified dc_def])
-                        apply (wpsimp simp: update_refill_hd_rewrite)
-                       apply (wpsimp simp: updateRefillHd_def wp: updateSchedContext_wp)
-                      apply (rule refillAddTail_corres[simplified dc_def])
-                      apply (clarsimp simp: refill_map_def)
-                     apply (clarsimp simp: obj_at_def is_sc_obj is_active_sc2_def opt_map_red opt_pred_def)
-                    apply (clarsimp simp: obj_at_simps opt_map_red opt_pred_def is_sc_obj ps_clear_upd
-                                          scBits_simps fun_upd_def[symmetric] valid_refills'_def)
-                   apply wpsimp
-                  apply (wpsimp wp: getSchedContext_wp')
-                 apply (wpsimp simp: update_refill_hd_def wp: update_sched_context_wp)
-                apply (wpsimp simp: updateRefillHd_def objBits_simps
-                                wp: updateSchedContext_wp)
-               apply (wpsimp wp: get_sc_refill_ready_wp)
-              apply (wpsimp wp: refillReady_wp')
-             apply (fastforce simp: obj_at_def is_sc_obj is_active_sc2_def opt_map_red opt_pred_def)
-            apply (clarsimp simp: obj_at_simps ps_clear_upd fun_upd_def[symmetric]
-                                  valid_refills'_def opt_map_red opt_pred_def)
-           apply ((wpsimp wp: updateSchedContext_wp update_sched_context_wp simp: objBits_simps)+)[5]
-     apply (clarsimp simp: obj_at_def is_sc_obj is_active_sc2_def opt_map_red opt_pred_def)
-    apply (clarsimp simp: obj_at_simps scBits_simps ps_clear_upd fun_upd_def[symmetric]
-                          valid_refills_number'_def is_sc_obj)
-    apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-    apply (fastforce simp: valid_sched_context'_def valid_obj'_def valid_refills_number'_def
-                           scBits_simps opt_map_red sc_relation_def)
-   apply clarsimp+
-  done
-
-crunch maybeAddEmptyTail, setRefillHd
-  for invs'[wp]: invs'
-  (simp: crunch_simps wp: crunch_wps)
-
-lemma refillNew_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> (\<exists>n. sc_at'_n n scPtr s \<and> valid_refills_number' maxRefills n)
-        \<and> ex_nonz_cap_to' scPtr s \<and> MIN_REFILLS \<le> maxRefills\<rbrace>
-   refillNew scPtr maxRefills budget period
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  (is "\<lbrace>?P\<rbrace> _ \<lbrace>?Q\<rbrace>")
-  apply (clarsimp simp: refillNew_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-
-  apply (rule bind_wp_fwd_skip)
-   apply (intro hoare_vcg_conj_lift_pre_fix; (solves wpsimp)?)
-    apply (wpsimp wp: updateSchedContext_invs')
-    apply (fastforce dest: invs'_ko_at_valid_sched_context'
-                     simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
-   apply (wpsimp wp: updateSchedContext_wp)
-   apply (clarsimp simp: obj_at_simps ko_wp_at'_def ps_clear_def opt_map_def)
-
-  apply (simp flip: bind_assoc)
-  apply (rule bind_wp)
-   apply wpsimp
-  apply (rule bind_wp)
-   apply wpsimp
-
-  apply (clarsimp simp: pred_conj_def)
-  apply (intro hoare_vcg_conj_lift_pre_fix)
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. active_sc_at' scPtr\<rbrace>" for P f \<Rightarrow> -\<close>)
-   apply (wpsimp wp: updateSchedContext_wp)
-   apply (clarsimp simp: active_sc_at'_def obj_at_simps MIN_REFILLS_def ps_clear_def)
-  apply (clarsimp simp: updateSchedContext_def bind_assoc)
-  apply (subst bind_dummy_ret_val)+
-  apply (rule hoare_weaken_pre)
-   apply (rule_tac P'="?P" and P''="sc_at' scPtr" and Q="?Q"
-                in monadic_rewrite_refine_valid[OF getSchedContext_setSchedContext_decompose];
-          (solves wpsimp)?)
-   apply (wpsimp wp: setSchedContext_invs')
-   apply (fastforce dest: invs'_ko_at_valid_sched_context'
-                    simp: valid_sched_context'_def valid_sched_context_size'_def obj_at_simps
-                          ko_wp_at'_def valid_refills_number'_def)
-  apply (clarsimp simp: obj_at_simps ko_wp_at'_def)
-  apply (case_tac ko; clarsimp)
-  done
-
-lemma refillUpdate_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> (\<exists>n. sc_at'_n n scPtr s \<and> valid_refills_number' newMaxRefills n)
-        \<and> ex_nonz_cap_to' scPtr s \<and> MIN_REFILLS \<le> newMaxRefills\<rbrace>
-   refillUpdate  scPtr newPeriod newBudget newMaxRefills
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  (is "\<lbrace>?P\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (clarsimp simp: refillUpdate_def)
-  apply (simp flip: bind_assoc)
-  apply (rule_tac Q'="\<lambda>_. invs' and active_sc_at' scPtr" in bind_wp)
-   apply (wpsimp wp: updateRefillHd_invs')
-  apply (clarsimp simp: pred_conj_def)
-  apply (intro hoare_vcg_conj_lift_pre_fix)
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. active_sc_at' scPtr\<rbrace>" for P f \<Rightarrow> -\<close>)
-   apply (wpsimp wp: updateSchedContext_wp refillReady_wp
-               simp: updateRefillHd_def)
-   apply (clarsimp simp: active_sc_at'_def obj_at_simps MIN_REFILLS_def ps_clear_def)
-  apply (rule_tac Q'="\<lambda>_. invs'" in bind_wp)
-   apply wpsimp
-  apply (rule_tac Q'="\<lambda>_. invs' and active_sc_at' scPtr" in bind_wp)
-   apply (wpsimp wp: updateRefillHd_invs' refillReady_wp)
-  apply (clarsimp simp: pred_conj_def)
-  apply (intro hoare_vcg_conj_lift_pre_fix)
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. active_sc_at' scPtr\<rbrace>" for P f \<Rightarrow> -\<close>)
-   apply (wpsimp wp: updateSchedContext_wp refillReady_wp
-               simp: updateRefillHd_def)
-   apply (clarsimp simp: active_sc_at'_def obj_at_simps MIN_REFILLS_def ps_clear_def)
-  apply (rule_tac Q'="\<lambda>_. invs' and ex_nonz_cap_to' scPtr" in bind_wp)
-   apply (wpsimp wp: updateSchedContext_invs')
-   apply (fastforce dest: invs'_ko_at_valid_sched_context'
-                    simp: valid_sched_context'_def valid_sched_context_size'_def obj_at_simps)
-  apply (clarsimp simp: pred_conj_def)
-  apply (intro hoare_vcg_conj_lift_pre_fix)
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>_. ex_nonz_cap_to' scPtr\<rbrace>" for P f \<Rightarrow> -\<close>)
-   apply (wpsimp wp: updateSchedContext_ex_nonz_cap_to' refillReady_wp
-               simp: updateRefillHd_def)
-  apply (simp add: bind_assoc)
-  apply (rule bind_wp_fwd_skip)
-   apply (intro hoare_vcg_conj_lift_pre_fix; (solves wpsimp)?)
-    apply (wpsimp wp: updateSchedContext_invs')
-    apply (fastforce dest: invs'_ko_at_valid_sched_context'
-                     simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
-   apply (wpsimp wp: updateSchedContext_wp)
-   apply (clarsimp simp: obj_at_simps ko_wp_at'_def ps_clear_def opt_map_def)
-  apply (rule_tac Q'="\<lambda>_. ?P and (\<lambda>s'. ((\<lambda>sc'. scRefillHead sc' = 0) |< scs_of' s') scPtr)"
-               in bind_wp_fwd)
-   apply (clarsimp simp: pred_conj_def)
-   apply (intro hoare_vcg_conj_lift_pre_fix; (solves wpsimp)?)
-     apply (wpsimp wp: updateSchedContext_invs')
-     apply (fastforce dest: invs'_ko_at_valid_sched_context'
-                      simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
-    apply (wpsimp wp: updateSchedContext_wp)
-    apply (clarsimp simp: obj_at_simps ko_wp_at'_def ps_clear_def opt_map_def)
-   apply (wpsimp wp: updateSchedContext_wp)
-  apply (rule_tac Q'="\<lambda>_. ?P and (\<lambda>s'. ((\<lambda>sc'. scRefillHead sc' = 0) |< scs_of' s') scPtr)
-                            and (\<lambda>s'. ((\<lambda>sc'. scRefillCount sc' = 1) |< scs_of' s') scPtr)"
-               in bind_wp_fwd)
-   apply (clarsimp simp: pred_conj_def)
-   apply (intro hoare_vcg_conj_lift_pre_fix; (solves wpsimp)?)
-      apply (wpsimp wp: updateSchedContext_invs')
-      apply (fastforce dest: invs'_ko_at_valid_sched_context'
-                     simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
-     apply (wpsimp wp: updateSchedContext_wp)
-     apply (clarsimp simp: obj_at_simps ko_wp_at'_def ps_clear_def opt_map_def)
-    apply (wpsimp wp: updateSchedContext_wp)
-    apply (clarsimp simp: obj_at_simps ko_wp_at'_def ps_clear_def opt_map_def opt_pred_def)
-   apply (wpsimp wp: updateSchedContext_wp)
-  apply (wpsimp wp: updateSchedContext_invs')
-  apply (fastforce dest: invs'_ko_at_valid_sched_context'
-                   simp: valid_sched_context'_def valid_sched_context_size'_def obj_at_simps
-                         ko_wp_at'_def valid_refills_number'_def opt_map_red opt_pred_def)
-  done
-
-lemma tcbSchedDequeue_valid_refills'[wp]:
-  "tcbSchedDequeue tcbPtr \<lbrace>valid_refills' scPtr\<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (wpsimp wp: threadSet_wp threadGet_wp
-              simp: bitmap_fun_defs setQueue_def
-         | intro conjI impI)+
-  apply (fastforce simp: obj_at_simps valid_refills'_def opt_map_def opt_pred_def split: option.splits)
-  done
-
-crunch tcbSchedDequeue, tcbReleaseRemove
-  for ksCurSc[wp]: "\<lambda>s. P (ksCurSc s)"
-  (wp: crunch_wps threadSet_wp simp: setQueue_def valid_refills'_def bitmap_fun_defs crunch_simps)
-
-lemma tcbReleaseRemove_valid_refills'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_refills' scPtr\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def)
-  apply (wpsimp wp: threadSet_wp threadGet_wp
-              simp: bitmap_fun_defs setReleaseQueue_def setReprogramTimer_def
-         | intro conjI impI)+
-    apply (fastforce simp: obj_at_simps valid_refills'_def opt_map_def opt_pred_def split: option.splits)+
-  done
-
-crunch commitTime, refillNew, refillUpdate
-  for ksCurSc[wp]: "\<lambda>s. P (ksCurSc s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-crunch commitTime
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' ptr"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma invokeSchedControlConfigureFlags_corres:
-  "sc_ctrl_inv_rel sc_inv sc_inv' \<Longrightarrow>
-   corres dc
-          (einvs and valid_sched_control_inv sc_inv and cur_sc_active and schact_is_rct
-           and ct_not_in_release_q and ct_active
-           and current_time_bounded and consumed_time_bounded
-           and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-           and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s))
-          (invs' and sch_act_simple and valid_sc_ctrl_inv' sc_inv' and ct_active')
-          (invoke_sched_control_configure_flags sc_inv)
-          (invokeSchedControlConfigureFlags sc_inv')"
-  apply (cases sc_inv)
-  apply (rename_tac sc_ptr budget period mrefills badge flag)
-  apply (simp add: invoke_sched_control_configure_flags_def invokeSchedControlConfigureFlags_def)
-  apply (subst bind_dummy_ret_val)+
-
-  apply (rule_tac Q="\<lambda>s. sc_at sc_ptr s" in corres_cross_add_abs_guard)
-   apply (fastforce intro: valid_sched_context_size_objsI
-                     simp: sc_at_pred_n_def obj_at_def is_sc_obj_def)
-  apply (simp add: pred_conj_comm)
-  apply (rule_tac Q="\<lambda>s'. sc_at' sc_ptr s'" in corres_cross_add_guard)
-   apply (fastforce intro: sc_at_cross)
-  apply (rule_tac Q="\<lambda>s. sc_at (cur_sc s) s" in corres_cross_add_abs_guard)
-   apply (fastforce intro: cur_sc_tcb_sc_at_cur_sc)
-  apply (rule_tac Q="\<lambda>s'. active_sc_at' (ksCurSc s') s'" in corres_cross_add_guard)
-   apply (fastforce intro: active_sc_at'_cross simp: state_relation_def)
-
-  apply (rule_tac Q="\<lambda>_ s. ?abs s \<and> sc_at sc_ptr s \<and> sc_at (cur_sc s) s"
-              and Q'="\<lambda>_  s'. ?conc s' \<and> ex_nonz_cap_to' sc_ptr s' \<and> sc_at' sc_ptr s'
-                              \<and> active_sc_at' (ksCurSc s') s'"
-               in corres_underlying_split)
-
-     apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-     apply wps_conj_solves
-      apply (wpsimp wp: update_sc_badge_invs')
-      apply (fastforce dest: ex_nonz_cap_to_not_idle_sc_ptr)
-     apply (wpsimp wp: update_sched_context_wp)
-     apply (clarsimp simp: obj_at_def)
-
-    apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-    apply (wps_conj_solves wp: ct_in_state_thread_state_lift' updateSchedContext_active_sc_at')
-     apply (clarsimp simp: updateSchedContext_def)
-     apply (wpsimp wp: setSchedContext_invs')
-     apply (fastforce dest!: sc_ko_at_valid_objs_valid_sc')
-
-   apply (corresKsimp corres: updateSchedContext_corres)
-   apply (intro conjI impI allI)
-     apply (rename_tac abs_state conc_state n')
-     apply (frule_tac ptr=sc_ptr and s=abs_state in state_relation_sc_relation; simp?)
-     apply (clarsimp simp: sc_relation_def opt_map_def opt_pred_def is_sc_obj_def obj_at_simps
-                    split: Structures_A.kernel_object.splits)
-    apply (rename_tac abs_state conc_state)
-    apply (frule_tac s=abs_state in state_relation_sc_replies_relation)
-    apply (clarsimp simp: sc_replies_relation2_def sc_replies_relation_rewrite)
-    apply (fastforce simp: opt_map_def opt_pred_def is_sc_obj_def obj_at_simps
-                    split: option.splits Structures_A.kernel_object.splits)
-   apply (clarsimp simp: obj_at_simps)
-
-  apply (clarsimp split del: if_split)
-  apply (rule_tac Q="\<lambda>_ s. sc_at sc_ptr s \<and> ?abs s \<and> sc_at (cur_sc s) s"
-              and Q'="\<lambda>_  s'. ?conc s' \<and> sc_at' sc_ptr s' \<and> active_sc_at' (ksCurSc s') s'
-                              \<and> ex_nonz_cap_to' sc_ptr s'"
-               in corres_underlying_split)
-
-     apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-     apply wps_conj_solves
-      apply (wpsimp wp: update_sc_sporadic_invs')
-      apply (fastforce dest: ex_nonz_cap_to_not_idle_sc_ptr)
-     apply (wpsimp wp: update_sched_context_wp)
-     apply (clarsimp simp: obj_at_def)
-
-    apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-    apply (wps_conj_solves wp: ct_in_state_thread_state_lift' updateSchedContext_active_sc_at')
-     apply (clarsimp simp: updateSchedContext_def)
-     apply (wpsimp wp: setSchedContext_invs')
-     apply (fastforce dest!: sc_ko_at_valid_objs_valid_sc')
-
-   apply (corresKsimp corres: updateSchedContext_corres)
-   apply (intro conjI impI allI)
-     apply (rename_tac abs_state conc_state n')
-     apply (frule_tac ptr=sc_ptr and s=abs_state in state_relation_sc_relation; simp?)
-     apply (clarsimp simp: sc_relation_def opt_map_def opt_pred_def is_sc_obj_def obj_at_simps
-                    split: Structures_A.kernel_object.splits)
-    apply (rename_tac abs_state conc_state)
-    apply (frule_tac s=abs_state in state_relation_sc_replies_relation)
-    apply (clarsimp simp: sc_replies_relation2_def sc_replies_relation_rewrite)
-    apply (fastforce simp: opt_map_def opt_pred_def is_sc_obj_def obj_at_simps
-                    split: option.splits Structures_A.kernel_object.splits)
-   apply (clarsimp simp: obj_at_simps)
-
-  apply (rule_tac F="budget \<ge> MIN_BUDGET \<and> period \<le> MAX_PERIOD \<and> MIN_REFILLS \<le> mrefills
-                     \<and> budget \<le> period"
-               in corres_req)
-   apply simp
-
-  apply (clarsimp simp: sc_at_sc_obj_at pred_conj_def)
-  apply (rule abs_ex_lift_corres)
-  apply (rename_tac n)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (rule corres_guard_imp)
-     apply (rule_tac n=n in get_sc_corres_size)
-    apply fast
-   apply fast
-
-  apply (rule_tac F="valid_refills_number' mrefills (minSchedContextBits + n)" in corres_req)
-   apply (clarsimp simp: obj_at_simps valid_refills_number'_def ko_wp_at'_def sc_const_eq
-                         sc_relation_def)
-
-  apply (rename_tac sc')
-  apply (rule_tac Q="\<lambda>_ s. invs s \<and> schact_is_rct s \<and> current_time_bounded s
-                           \<and> valid_sched_action s \<and> active_scs_valid s
-                           \<and> valid_ready_qs s \<and> valid_release_q s
-                           \<and> sc_at (cur_sc s) s
-                           \<and> sc_not_in_release_q sc_ptr s \<and> sc_not_in_ready_q sc_ptr s
-                           \<and> sc_ptr \<noteq> idle_sc_ptr \<and> sc_at sc_ptr s
-                           \<and> sc_refill_max_sc_at (\<lambda>rm. rm = sc_refill_max sc) sc_ptr s
-                           \<and> sc_tcb_sc_at (\<lambda>to. to = sc_tcb sc) sc_ptr s
-                           \<and> sc_obj_at n sc_ptr s
-                           \<and> (\<forall>tcb_ptr. sc_tcb_sc_at ((=) (Some tcb_ptr)) sc_ptr s \<longrightarrow> tcb_at tcb_ptr s)"
-              and Q'="\<lambda>_ s'. invs' s' \<and> sc_at' (ksCurSc s') s'
-                             \<and> (\<exists>n. sc_at'_n n sc_ptr s' \<and> valid_refills_number' mrefills n)
-                             \<and> ex_nonz_cap_to' sc_ptr s'"
-              and r'=dc
-               in corres_underlying_split)
-
-     apply (clarsimp simp: when_def split del: if_split)
-     apply (rule corres_if_split; (solves \<open>corresKsimp simp: sc_relation_def\<close>)?)
-     apply (rule corres_symb_exec_l[rotated])
-        apply (wpsimp wp: exs_valid_assert_opt)
-       apply (rule assert_opt_sp)
-      apply wpsimp
-     apply (rule_tac F="scTCB sc' = Some tcb_ptr" in corres_req)
-      apply (fastforce simp: sc_relation_def)
-     apply (rule corres_guard_imp)
-       apply (rule corres_split[OF tcbReleaseRemove_corres])
-          apply (clarsimp simp: sc_relation_def)
-         apply clarsimp
-         apply (rule corres_split[OF tcbSchedDequeue_corres])
-           apply (rule corres_split[OF getCurSc_corres])
-             apply clarsimp
-             apply (simp add: dc_def[symmetric])
-             apply (rule commitTime_corres)
-            apply (wpsimp wp: hoare_drop_imps tcbReleaseRemove_valid_queues | wps)+
-      apply (intro conjI impI; fastforce?)
-       apply (fastforce dest: invs_valid_objs valid_sched_context_objsI
-                        simp: valid_sched_context_def valid_bound_obj_def obj_at_def)
-      apply (fastforce intro: active_scs_validE)
-     apply (fastforce dest: invs_valid_objs' sc_ko_at_valid_objs_valid_sc'
-                     intro: valid_objs'_valid_refills'
-                      simp: valid_sched_context'_def valid_bound_obj'_def active_sc_at'_rewrite)
-
-    apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-    apply wps_conj_solves
-            apply (wpsimp wp: commit_time_invs)
-           apply (wpsimp wp: commit_time_valid_sched_action hoare_vcg_imp_lift')
-           apply fastforce
-          apply (wpsimp wp: commit_time_active_scs_valid
-                            hoare_vcg_imp_lift')
-          apply (fastforce intro: cur_sc_active_offset_ready_and_sufficient_implies_cur_sc_more_than_ready)
-         apply (wpsimp wp: commit_time_valid_ready_qs hoare_vcg_imp_lift'
-                           tcb_sched_dequeue_valid_ready_qs hoare_vcg_disj_lift)
-         apply (fastforce intro: cur_sc_active_offset_ready_and_sufficient_implies_cur_sc_more_than_ready)
-        apply (wpsimp wp: commit_time_valid_release_q hoare_vcg_imp_lift'
-                          tcb_release_remove_cur_sc_in_release_q_imp_zero_consumed'
-               | strengthen invs_valid_stateI)+
-        apply (frule cur_sc_tcb_are_bound_cur_sc_in_release_q_imp_zero_consumed[rotated 2])
-          apply (fastforce intro: invs_strengthen_cur_sc_tcb_are_bound)
-         apply fastforce
-        apply (fastforce simp: cur_sc_in_release_q_imp_zero_consumed_2_def)
-       apply (wpsimp wp: tcb_release_remove_sc_not_in_release_q)
-       apply (intro conjI impI; fastforce?)
-        apply (rule disjI2)
-        apply (intro conjI)
-         apply (fastforce dest!: invs_sym_refs sym_ref_sc_tcb
-                           simp: heap_refs_inv_def vs_all_heap_simps obj_at_def sc_at_pred_n_def)
-        apply (fastforce intro: sym_refs_inj_tcb_scps)
-       apply (drule valid_sched_valid_release_q)
-       apply (clarsimp simp: vs_all_heap_simps)
-       apply (frule_tac ref=t in valid_release_q_no_sc_not_in_release_q)
-        apply (fastforce dest!: invs_sym_refs sym_ref_tcb_sc
-                          simp: obj_at_def vs_all_heap_simps is_sc_obj_def)
-       apply fastforce
-      apply (wpsimp wp: tcb_sched_dequeue_sc_not_in_ready_q)
-
-       apply (intro conjI impI; fastforce?)
-         apply (fastforce dest!: invs_sym_refs sym_ref_sc_tcb
-                           simp: heap_refs_inv_def vs_all_heap_simps obj_at_def sc_at_pred_n_def)
-        apply (fastforce intro: sym_refs_inj_tcb_scps)
-       apply (frule invs_valid_objs)
-       apply (frule_tac r=sc_ptr in valid_sched_context_objsI)
-        apply (fastforce simp: obj_at_def)
-       apply (clarsimp simp: valid_sched_context_def)
-       apply (drule valid_sched_valid_ready_qs)
-       apply (clarsimp simp: vs_all_heap_simps)
-       apply (frule_tac ref=t in valid_ready_qs_no_sc_not_queued)
-        apply (fastforce dest!: invs_sym_refs sym_ref_tcb_sc
-                          simp: obj_at_def vs_all_heap_simps is_sc_obj_def)
-       apply fastforce
-     apply wpsimp
-     using idle_sc_no_ex_cap apply fastforce
-    apply wpsimp
-    apply (clarsimp simp: sc_at_pred_n_def obj_at_def)
-
-     apply (rule hoare_when_cases, simp)
-      apply (clarsimp simp: sc_at_pred_n_def obj_at_def)
-     apply (rule_tac P'="sc_tcb_sc_at (\<lambda>to. to = sc_tcb sc) sc_ptr" in hoare_weaken_pre[rotated])
-      apply (clarsimp simp: sc_at_pred_n_def obj_at_def)
-     apply (rule bind_wp_fwd_skip, wpsimp)+
-     apply wpsimp
-
-    apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
-    apply (fastforce dest: invs_valid_objs valid_sched_context_objsI
-                     simp: valid_sched_context_def valid_bound_obj_def sc_at_pred_n_def obj_at_def
-                    split: option.splits)
-
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-   apply (wps_conj_solves wp: commitTime_invs' tcbReleaseRemove_invs'
-                        simp: active_sc_at'_rewrite)
-
-  apply (rule_tac Q="\<lambda>_ s. invs s \<and> schact_is_rct s \<and> current_time_bounded s
-                           \<and> valid_sched_action s \<and> active_scs_valid s
-                           \<and> valid_ready_qs s \<and> valid_release_q s
-                           \<and> sc_at (cur_sc s) s
-                           \<and> sc_at sc_ptr s
-                           \<and> sc_tcb_sc_at (\<lambda>to. to = sc_tcb sc) sc_ptr s
-                           \<and> (\<forall>tcb_ptr. sc_tcb_sc_at ((=) (Some tcb_ptr)) sc_ptr s \<longrightarrow> tcb_at tcb_ptr s)"
-              and Q'="\<lambda>_ s'. invs' s' \<and>  sc_at' (ksCurSc s') s'"
-              and r'=dc
-               in corres_underlying_split)
-
-     apply (rule corres_if_split; (solves simp)?)
-
-      apply clarsimp
-      apply (rule corres_guard_imp)
-        apply (rule_tac n=n in refillNew_corres)
-         apply (clarsimp simp: MIN_REFILLS_def)
-        apply (clarsimp simp: valid_refills_number'_def MIN_REFILLS_def)
-       apply fastforce
-      apply fastforce
-
-     apply (rule corres_if_split)
-       apply (clarsimp simp: sc_relation_def)
-
-      apply (rule corres_symb_exec_l[rotated 2, OF assert_opt_sp]; (solves wpsimp)?)
-       apply (rule corres_underlying_split[rotated 2, OF gts_sp isRunnable_sp])
-        apply (corresKsimp corres: isRunnable_corres')
-        apply (fastforce simp: sc_relation_def sc_at_pred_n_def obj_at_def
-                       intro!: tcb_at_cross Some_to_the)
-
-       apply (rule corres_if_split; (solves simp)?)
-
-        apply (rule_tac Q="is_active_sc' sc_ptr" in corres_cross_add_guard)
-         apply (fastforce simp: is_active_sc_rewrite[symmetric] sc_at_pred_n_def obj_at_def
-                                is_sc_obj_def vs_all_heap_simps opt_map_def active_sc_def
-                        intro!: is_active_sc'_cross)
-
-        apply (rule corres_guard_imp)
-          apply (rule_tac n=n in refillUpdate_corres)
-           apply (clarsimp simp: MIN_REFILLS_def)
-          apply (clarsimp simp: valid_refills_number'_def MIN_REFILLS_def)
-         apply clarsimp
-         apply (fastforce simp: is_active_sc_rewrite[symmetric] sc_at_pred_n_def obj_at_def
-                                vs_all_heap_simps active_sc_def)
-       apply clarsimp
-       apply (intro conjI)
-        apply (rule valid_objs'_valid_refills')
-          apply fastforce
-         apply (clarsimp simp: obj_at_simps ko_wp_at'_def)
-         apply (rename_tac ko obj, case_tac ko; clarsimp)
-        apply simp
-       apply fastforce
-
-      apply (rule corres_guard_imp)
-        apply (rule_tac n=n in refillNew_corres)
-         apply (clarsimp simp: MIN_REFILLS_def)
-        apply (clarsimp simp: valid_refills_number'_def MIN_REFILLS_def)
-       apply fastforce
-      apply fastforce
-
-     apply (rule corres_guard_imp)
-       apply (rule_tac n=n in refillNew_corres)
-        apply (clarsimp simp: MIN_REFILLS_def)
-       apply (clarsimp simp: valid_refills_number'_def MIN_REFILLS_def)
-      apply fastforce
-     apply fastforce
-
-    apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-    apply (rule hoare_if)
-     apply (wps_conj_solves wp: refill_new_valid_sched_action refill_new_valid_release_q)
-       apply (wpsimp wp: refill_new_active_scs_valid)
-       apply (clarsimp simp: current_time_bounded_def sc_at_pred_n_def obj_at_def)
-      apply (wpsimp wp: refill_new_valid_ready_qs)
-      apply (clarsimp simp: current_time_bounded_def active_sc_def MIN_REFILLS_def)
-     apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-
-    apply (rule hoare_if)
-     apply (rule bind_wp_fwd_skip, wpsimp)
-     apply (rule bind_wp[OF _ gts_sp])
-     apply (rule hoare_if)
-
-      apply (wps_conj_solves wp: refill_update_valid_sched_action refill_update_invs)
-         apply (wpsimp wp: refill_update_active_scs_valid)
-         apply (clarsimp simp: current_time_bounded_def sc_at_pred_n_def obj_at_def
-                               active_scs_valid_def vs_all_heap_simps active_sc_def)
-        apply (wpsimp wp: refill_update_valid_ready_qs)
-        apply (simp add: obj_at_kh_kheap_simps pred_map_eq_normalise)
-       apply (wpsimp wp: refill_update_valid_release_q)
-       apply (clarsimp simp: active_scs_valid_def vs_all_heap_simps)
-      apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
-
-     apply (wps_conj_solves wp: refill_new_valid_sched_action refill_new_valid_release_q)
-       apply (wpsimp wp: refill_new_active_scs_valid)
-       apply (clarsimp simp: current_time_bounded_def sc_at_pred_n_def obj_at_def)
-      apply (wpsimp wp: refill_new_valid_ready_qs)
-      apply (clarsimp simp: current_time_bounded_def active_sc_def MIN_REFILLS_def)
-     apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-
-     apply (wps_conj_solves wp: refill_new_valid_sched_action refill_new_valid_release_q)
-       apply (wpsimp wp: refill_new_active_scs_valid)
-       apply (clarsimp simp: current_time_bounded_def sc_at_pred_n_def obj_at_def)
-      apply (wpsimp wp: refill_new_valid_ready_qs)
-      apply (clarsimp simp: current_time_bounded_def active_sc_def MIN_REFILLS_def)
-     apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-   apply (rule hoare_if)
-    apply wps_conj_solves
-     apply (wpsimp wp: refillNew_invs')
-    apply (clarsimp simp: ko_wp_at'_def valid_refills_number'_def)
-   apply (rule hoare_if)
-    apply wps_conj_solves
-    apply (rule bind_wp[OF _ isRunnable_sp])
-    apply (rule hoare_if)
-     apply (wpsimp wp: refillUpdate_invs')
-     apply (clarsimp simp: ko_wp_at'_def valid_refills_number'_def)
-    apply (wpsimp wp: refillNew_invs')
-    apply (clarsimp simp: ko_wp_at'_def valid_refills_number'_def)
-   apply wps_conj_solves
-   apply (wpsimp wp: refillNew_invs')
-  apply (clarsimp simp: ko_wp_at'_def valid_refills_number'_def)
-
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split[where r'=dc])
-       apply (rule corres_when)
-        apply (clarsimp simp: sc_relation_def)
-       apply (rule corres_assert_opt_l)
-       apply (rule corres_split[OF isRunnable_corres'])
-          apply (clarsimp simp: sc_relation_def Some_to_the split: if_splits)
-         apply (rule corres_split[OF schedContextResume_corres])
-           apply (rule corres_split[OF getCurThread_corres])
-             apply (rule corres_if)
-               apply (fastforce dest!: Some_to_the simp: sc_relation_def)
-              apply (rule rescheduleRequired_corres)
-             apply (erule corres_when)
-             apply (rule possibleSwitchTo_corres)
-             apply (fastforce simp: sc_relation_def Some_to_the)
-            apply wpsimp
-           apply wpsimp
-          apply ((wpsimp wp: hoare_vcg_imp_lift' sched_context_resume_valid_sched_action
-                 | strengthen valid_objs_valid_tcbs)+)[1]
-         apply (rule_tac Q'="\<lambda>_. invs'" in hoare_post_imp, fastforce)
-         apply (rule schedContextResume_invs')
-        apply (wpsimp wp: gts_wp)
-       apply wpsimp
-      apply (rule corres_split[OF updateSchedContext_corres])
-           apply (clarsimp simp: opt_map_red opt_pred_def obj_at_simps is_sc_obj)
-           apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-           apply (clarsimp simp: sc_relation_def)
-          apply (fastforce dest: state_relation_sc_replies_relation sc_replies_relation_prevs_list
-                           simp: opt_map_def obj_at_simps is_sc_obj_def
-                          split: Structures_A.kernel_object.splits)
-         apply (clarsimp simp: objBits_simps)
-        apply (rule updateSchedContext_corres)
-          apply (clarsimp simp: opt_map_red opt_pred_def obj_at_simps is_sc_obj)
-          apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-          apply (clarsimp simp: sc_relation_def)
-         apply (fastforce dest: state_relation_sc_replies_relation sc_replies_relation_prevs_list
-                          simp: opt_map_def obj_at_simps is_sc_obj_def
-                         split: Structures_A.kernel_object.splits)
-        apply (clarsimp simp: objBits_simps)
-       apply wpsimp+
-   apply (fastforce simp: sc_at_pred_n_def obj_at_def schact_is_rct_def
-                   intro: valid_sched_action_weak_valid_sched_action)
-  apply (fastforce intro: sc_at_cross)
-  done
-
-end
-
-end
diff --git a/proof/refine/ARM/SchedContext_R.thy b/proof/refine/ARM/SchedContext_R.thy
deleted file mode 100644
index 90e87133c7..0000000000
--- a/proof/refine/ARM/SchedContext_R.thy
+++ /dev/null
@@ -1,860 +0,0 @@
-(*
- * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
- *
- * SPDX-License-Identifier: GPL-2.0-only
- *)
-
-theory SchedContext_R
-imports VSpace_R
-begin
-
-lemma live_sc'_scConsumed_update[simp]:
-  "live_sc' (scConsumed_update f koc) = live_sc' koc"
-  by (clarsimp simp: live_sc'_def)
-
-lemma live_sc'_scRefills_update[simp]:
-  "live_sc' (scRefills_update f koc) = live_sc' koc"
-  by (clarsimp simp: live_sc'_def)
-
-lemma live_sc'_scRefillCount_update[simp]:
-  "live_sc' (scRefillCount_update f koc) = live_sc' koc"
-  by (clarsimp simp: live_sc'_def)
-
-lemma valid_sched_context'_updates[simp]:
-  "\<And>f. valid_sched_context' sc' (ksReprogramTimer_update f s) = valid_sched_context' sc' s"
-  "\<And>f. valid_sched_context' sc' (ksReleaseQueue_update f s) = valid_sched_context' sc' s"
-  by (auto simp: valid_sched_context'_def valid_bound_obj'_def split: option.splits)
-
-lemma valid_sched_context'_scConsumed_update[simp]:
-  "valid_sched_context' (scConsumed_update f ko) s = valid_sched_context' ko s"
-  by (clarsimp simp: valid_sched_context'_def)
-
-lemma valid_sched_context_size'_scConsumed_update[simp]:
-  "valid_sched_context_size' (scConsumed_update f sc') = valid_sched_context_size' sc'"
-  by (clarsimp simp: valid_sched_context_size'_def objBits_simps)
-
-lemma readSchedContext_SomeD:
-  "readSchedContext scp s = Some sc'
-   \<Longrightarrow> ksPSpace s scp = Some (KOSchedContext sc')"
-  by (clarsimp simp: readSchedContext_def asks_def obj_at'_def projectKOs
-              dest!: readObject_misc_ko_at')
-
-lemma no_ofail_readSchedContext:
-  "no_ofail (sc_at' p) (readSchedContext p)"
-  unfolding readSchedContext_def by wpsimp
-
-lemma sym_refs_tcbSchedContext:
-  "\<lbrakk>ko_at' tcb tcbPtr s; sym_refs (state_refs_of' s); tcbSchedContext tcb = Some scPtr\<rbrakk>
-   \<Longrightarrow> obj_at' (\<lambda>sc. scTCB sc = Some tcbPtr) scPtr s"
-  apply (drule (1) sym_refs_obj_atD')
-  apply (auto simp: state_refs_of'_def ko_wp_at'_def obj_at'_def
-                    refs_of_rev' projectKOs)
-  done
-
-lemma setSchedContext_valid_idle'[wp]:
-  "\<lbrace>valid_idle' and K (scPtr = idle_sc_ptr \<longrightarrow> idle_sc' v)\<rbrace>
-   setSchedContext scPtr v
-   \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
-  apply (rule hoare_weaken_pre)
-  apply (simp add: valid_idle'_def)
-  apply (wpsimp simp: setSchedContext_def wp: setObject_ko_wp_at)
-  apply (rule hoare_lift_Pf3[where f=ksIdleThread])
-  apply (wpsimp wp: hoare_vcg_conj_lift)
-   apply (wpsimp simp: obj_at'_real_def wp: setObject_ko_wp_at)
-  apply wpsimp
-  apply (wpsimp wp: updateObject_default_inv)
-  by (auto simp: valid_idle'_def obj_at'_real_def ko_wp_at'_def)[1]
-
-lemma setSchedContext_invs':
-  "\<lbrace>invs'
-    and (\<lambda>s. live_sc' sc \<longrightarrow> ex_nonz_cap_to' scPtr s)
-    and valid_sched_context' sc
-    and (\<lambda>_. valid_sched_context_size' sc)\<rbrace>
-    setSchedContext scPtr sc
-    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: valid_pde_mappings_lift' untyped_ranges_zero_lift simp: cteCaps_of_def o_def)
-  done
-
-lemma setSchedContext_active_sc_at':
-  "\<lbrace>active_sc_at' scPtr' and K (scPtr' = scPtr \<longrightarrow> 0 < scRefillMax sc)\<rbrace>
-   setSchedContext scPtr sc
-   \<lbrace>\<lambda>rv s. active_sc_at' scPtr' s\<rbrace>"
-  apply (simp add: active_sc_at'_def obj_at'_real_def setSchedContext_def)
-  apply (wpsimp wp: setObject_ko_wp_at)
-  apply (clarsimp simp: ko_wp_at'_def obj_at'_real_def)
-  done
-
-lemma updateSchedContext_invs':
-  "\<lbrace>invs'
-    and (\<lambda>s. \<forall>ko. ko_at' ko scPtr s \<longrightarrow> live_sc' (f ko) \<longrightarrow> ex_nonz_cap_to' scPtr s)
-    and (\<lambda>s. \<forall>ko. ko_at' ko scPtr s \<longrightarrow> valid_sched_context' (f ko) s
-                                        \<and> valid_sched_context_size' (f ko))\<rbrace>
-    updateSchedContext scPtr f
-    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: updateSchedContext_def)
-  by (wpsimp wp: setSchedContext_invs')
-
-lemma sym_refs_sc_trivial_update:
-  "ko_at' ko scPtr s
-   \<Longrightarrow> sym_refs (\<lambda>a. if a = scPtr
-                   then get_refs SCNtfn (scNtfn ko) \<union>
-                        get_refs SCTcb (scTCB ko) \<union>
-                        get_refs SCYieldFrom (scYieldFrom ko) \<union>
-                        get_refs SCReply (scReply ko)
-                   else state_refs_of' s a)
-       = sym_refs (state_refs_of' s)"
-  apply (rule arg_cong[where f=sym_refs])
-  apply (rule ext)
-  by (clarsimp simp: state_refs_of'_def obj_at'_real_def ko_wp_at'_def projectKO_sc)
-
-lemma live_sc'_ko_ex_nonz_cap_to':
-  "\<lbrakk>invs' s; ko_at' ko scPtr s\<rbrakk> \<Longrightarrow> live_sc' ko \<Longrightarrow> ex_nonz_cap_to' scPtr s"
-  apply (drule invs_iflive')
-  apply (erule if_live_then_nonz_capE')
-  by (clarsimp simp: ko_wp_at'_def obj_at'_real_def projectKO_sc)
-
-lemma updateSchedContext_refills_invs':
-  "\<lbrace>invs'
-    and (\<lambda>s. \<forall>ko. ko_at' ko scPtr s \<longrightarrow> valid_sched_context' (f ko) s \<and> valid_sched_context_size' (f ko))
-    and (\<lambda>_. \<forall>ko. scNtfn (f ko) = scNtfn ko)
-    and (\<lambda>_. \<forall>ko. scTCB (f ko) = scTCB ko)
-    and (\<lambda>_. \<forall>ko. scYieldFrom (f ko) = scYieldFrom ko)
-    and (\<lambda>_. \<forall>ko. scReply (f ko) = scReply ko)\<rbrace>
-    updateSchedContext scPtr f
-    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: updateSchedContext_def)
-  apply (wpsimp wp: setSchedContext_invs')
-  apply (erule (1) live_sc'_ko_ex_nonz_cap_to')
-  apply (clarsimp simp: live_sc'_def)
-  done
-
-lemma updateSchedContext_active_sc_at':
-  "\<lbrace>active_sc_at' scPtr'
-    and (\<lambda>s. scPtr = scPtr' \<longrightarrow> (\<forall>ko. ko_at' ko scPtr s \<longrightarrow> 0 < scRefillMax ko \<longrightarrow> 0 < scRefillMax (f ko)))\<rbrace>
-    updateSchedContext scPtr f
-    \<lbrace>\<lambda>rv. active_sc_at' scPtr'\<rbrace>"
-  apply (simp add: updateSchedContext_def)
-  apply (wpsimp wp: setSchedContext_active_sc_at')
-  apply (clarsimp simp: active_sc_at'_def obj_at'_real_def ko_wp_at'_def projectKO_sc)
-  done
-
-lemma invs'_ko_at_valid_sched_context':
-  "\<lbrakk>invs' s; ko_at' ko scPtr s\<rbrakk> \<Longrightarrow> valid_sched_context' ko s \<and> valid_sched_context_size' ko"
-  apply (drule invs_valid_objs')
-  apply (drule (1) sc_ko_at_valid_objs_valid_sc', simp)
-  done
-
-lemma updateSchedContext_invs'_indep:
-  "\<lbrace>invs'
-    and (\<lambda>s. \<forall>ko. valid_sched_context' ko s \<longrightarrow> valid_sched_context' (f ko) s)
-    and (\<lambda>_. \<forall>ko. valid_sched_context_size' ko \<longrightarrow> valid_sched_context_size' (f ko))
-    and (\<lambda>s. \<forall>ko. scNtfn (f ko) = scNtfn ko
-                  \<and> scTCB (f ko) = scTCB ko
-                  \<and> scYieldFrom (f ko) = scYieldFrom ko
-                  \<and> scReply (f ko) = scReply ko )\<rbrace>
-    updateSchedContext scPtr f
-    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (wpsimp wp: updateSchedContext_invs')
-  apply (intro conjI; intro allI impI; (drule_tac x=ko in spec)+)
-   apply (clarsimp simp: invs'_def valid_objs'_def obj_at'_def)
-   apply (erule if_live_then_nonz_capE')
-   apply (clarsimp simp: ko_wp_at'_def projectKO_eq projectKO_sc live_sc'_def)
-  apply (frule (1) invs'_ko_at_valid_sched_context', simp)
-  done
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemma schedContextUpdateConsumed_corres:
- "corres (=) (sc_at scp) (sc_at' scp)
-            (sched_context_update_consumed scp)
-            (schedContextUpdateConsumed scp)"
-  apply (clarsimp simp: sched_context_update_consumed_def schedContextUpdateConsumed_def)
-  apply (simp add: maxTicksToUs_def ticksToUs_def)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (corresKsimp corres: get_sc_corres)
-  apply (rename_tac abs_sc conc_sc)
-  apply (rule corres_if_split)
-    apply (clarsimp simp: sc_relation_def)
-   apply (rule corres_underlying_split)
-      apply (rule corres_guard_imp)
-        apply clarsimp
-        apply (rule_tac f="\<lambda>sc. sc\<lparr>sc_consumed := sc_consumed abs_sc - max_ticks_to_us\<rparr>"
-                    and f'="\<lambda>sc'. scConsumed_update (\<lambda>_. scConsumed conc_sc - maxTicksToUs) sc'"
-                     in setSchedContext_update_sched_context_no_stack_update_corres)
-           apply (clarsimp simp: sc_relation_def maxTicksToUs_def)
-          apply (clarsimp simp: sc_relation_def)
-         apply (clarsimp simp: sc_relation_def objBits_simps)
-        apply (clarsimp simp: sc_relation_def)
-       apply (clarsimp simp: obj_at_def)
-      apply (clarsimp simp: obj_at_simps)
-     apply (clarsimp simp: maxTicksToUs_def ticksToUs_def)
-    apply wpsimp
-   apply wpsimp
-  apply (rule corres_underlying_split)
-     apply (rule corres_guard_imp)
-       apply clarsimp
-       apply (rule_tac f="\<lambda>sc. sc\<lparr>sc_consumed := 0\<rparr>"
-                   and f'="\<lambda>sc'. scConsumed_update (\<lambda>_. 0) sc'"
-                    in setSchedContext_update_sched_context_no_stack_update_corres)
-          apply (clarsimp simp: sc_relation_def maxTicksToUs_def)
-         apply (clarsimp simp: sc_relation_def)
-        apply (clarsimp simp: sc_relation_def objBits_simps)
-       apply (clarsimp simp: sc_relation_def)
-      apply (clarsimp simp: obj_at_def)
-     apply (clarsimp simp: obj_at_simps)
-    apply (clarsimp simp: maxTicksToUs_def ticksToUs_def sc_relation_def)
-   apply wpsimp
-  apply wpsimp
-  done
-
-end
-
-crunch sched_context_update_consumed
-  for in_user_Frame[wp]: "in_user_frame buffer"
-
-lemma schedContextUpdateConsumed_valid_ipc_buffer_ptr'[wp]:
-  "schedContextUpdateConsumed scp \<lbrace>valid_ipc_buffer_ptr' x\<rbrace>"
-  unfolding schedContextUpdateConsumed_def valid_ipc_buffer_ptr'_def
-  by wpsimp
-
-lemma schedContextUpdateConsumed_iflive[wp]:
-  "schedContextUpdateConsumed scp \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (wpsimp simp: schedContextUpdateConsumed_def)
-  apply (clarsimp elim!: if_live_then_nonz_capE' simp: obj_at'_def projectKOs ko_wp_at'_def)
-  done
-
-lemma schedContextUpdateConsumed_valid_idle'[wp]:
-  "schedContextUpdateConsumed scp \<lbrace>valid_idle'\<rbrace>"
-  apply (wpsimp simp: schedContextUpdateConsumed_def)
-  apply (clarsimp simp: valid_idle'_def obj_at'_def)
-  done
-
-lemma schedContextUpdateConsumed_state_refs_of:
-  "schedContextUpdateConsumed sc \<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace>"
-  unfolding schedContextUpdateConsumed_def
-  apply wpsimp
-  apply (clarsimp dest!: ko_at_state_refs_ofD' elim!: rsubst[where P=P])
-  apply (rule ext; clarsimp)
-  done
-
-lemma schedContextUpdateConsumed_objs'[wp]:
-  "schedContextUpdateConsumed sc \<lbrace>valid_objs'\<rbrace>"
-  unfolding schedContextUpdateConsumed_def
-  apply wpsimp
-  apply (drule (1) ko_at_valid_objs'_pre)
-  apply (clarsimp simp: valid_obj'_def valid_sched_context'_def valid_sched_context_size'_def)
-  done
-
-lemma schedContextUpdateConsumed_sym_refs_lis_refs_of_replies'[wp]:
-  "schedContextUpdateConsumed scPtr \<lbrace>\<lambda>s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  apply (clarsimp simp: schedContextUpdateConsumed_def)
-  apply wpsimp
-  apply (clarsimp simp: opt_map_def o_def)
-  done
-
-crunch schedContextUpdateConsumed
-  for aligned'[wp]: "pspace_aligned'"
-  and distinct'[wp]:"pspace_distinct'"
-  and bounded'[wp]: "pspace_bounded'"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and it'[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  and no_0_obj'[wp]: no_0_obj'
-  and valid_mdb'[wp]: valid_mdb'
-  and sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  and valid_global_refs'[wp]: valid_global_refs'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and interrupt_state[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and valid_irq_state'[wp]: valid_irq_states'
-  and valid_machine_state'[wp]: valid_machine_state'
-  and valid_queues'[wp]: valid_queues'
-  and ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and ct_not_inQ[wp]: ct_not_inQ
-  and valid_pde_mappings'[wp]: valid_pde_mappings'
-  and valid_queues[wp]: valid_queues
-  and ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and valid_replies' [wp]: valid_replies'
-  and st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' P' t s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-global_interpretation schedContextUpdateConsumed: typ_at_all_props' "schedContextUpdateConsumed scPtr"
-  by typ_at_props'
-
-lemma schedContextUpdateConsumed_if_unsafe_then_cap'[wp]:
-  "schedContextUpdateConsumed scPtr \<lbrace>if_unsafe_then_cap'\<rbrace>"
-  apply (clarsimp simp: schedContextUpdateConsumed_def)
-  apply (wpsimp wp: threadSet_ifunsafe' threadGet_wp)
-  done
-
-lemma schedContextUpdateConsumed_invs'[wp]:
-  "schedContextUpdateConsumed scPtr \<lbrace>invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift cur_tcb_lift
-                    untyped_ranges_zero_lift
-              simp: cteCaps_of_def o_def)
-  done
-
-(* FIXME RT: should other update wp rules for valid_objs/valid_objs' be in this form?
-   The following might be nicer:
-   \<forall>sc'. scs_of' s scp = Some sc' \<longrightarrow> valid_obj' (injectKO sc') s
-         \<longrightarrow> valid_obj' (injectKO (f' sc') s) *)
-lemma updateSchedContext_valid_objs'[wp]:
-  "\<lbrace>valid_objs' and
-    (\<lambda>s. ((\<lambda>sc'. valid_obj' (injectKO sc') s \<longrightarrow> valid_obj' (injectKO (f' sc')) s)
-              |< scs_of' s) scp)\<rbrace>
-   updateSchedContext scp f'
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  apply (wpsimp simp: updateSchedContext_def wp: set_sc'.valid_objs')
-  by (fastforce simp: valid_obj'_def valid_sched_context'_def valid_sched_context_size'_def
-                      obj_at'_def projectKOs scBits_simps objBits_simps opt_map_red opt_pred_def)
-
-lemma valid_tcb'_tcbYieldTo_update:
-  "valid_tcb' tcb s \<Longrightarrow> valid_tcb' (tcbYieldTo_update Map.empty tcb) s"
-  by (simp add: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def )
-
-lemma schedContextCancelYieldTo_valid_objs'[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>valid_objs'\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def)
-  apply (wpsimp wp: threadSet_valid_objs' hoare_vcg_all_lift threadGet_wp
-         | strengthen valid_tcb'_tcbYieldTo_update)+
-  apply normalise_obj_at'
-  apply (rename_tac ko)
-  apply (rule_tac x=ko in exI)
-  apply clarsimp
-  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
-  by (fastforce simp: valid_obj'_def opt_map_def obj_at_simps valid_tcb'_def
-                      valid_sched_context'_def valid_sched_context_size'_def opt_pred_def)
-
-lemma schedContextCancelYieldTo_valid_mdb'[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>valid_mdb'\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def updateSchedContext_def threadSet_def)
-  apply (wpsimp wp: getObject_tcb_wp hoare_drop_imps hoare_vcg_ex_lift threadGet_wp)
-  apply (fastforce simp: obj_at'_def projectKOs tcb_cte_cases_def)
-  done
-
-lemma schedContextCancelYieldTo_sch_act_wf[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def updateSchedContext_def)
-  apply (wpsimp wp: threadSet_sch_act threadGet_wp)
-  apply (fastforce simp: obj_at'_def projectKOs)
-  done
-
-lemma schedContextCancelYieldTo_if_live_then_nonz_cap'[wp]:
-  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s\<rbrace>
-   schedContextCancelYieldTo tptr
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def updateSchedContext_def)
-  apply (wpsimp wp: threadSet_iflive' setSchedContext_iflive' hoare_vcg_imp_lift' hoare_vcg_all_lift
-                    threadGet_wp)
-  by (fastforce elim: if_live_then_nonz_capE'
-                simp: ko_wp_at'_def obj_at'_def live_sc'_def projectKOs)
-
-lemma schedContextCancelYieldTo_if_unsafe_then_cap'[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>if_unsafe_then_cap'\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def updateSchedContext_def)
-  apply (wpsimp wp: threadSet_ifunsafe' threadGet_wp)
-  apply (fastforce simp: obj_at'_def projectKOs)
-  done
-
-lemma schedContextCancelYieldTo_valid_idle'[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>valid_idle'\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def updateSchedContext_def)
-  apply (wpsimp wp: threadSet_idle' setObject_sc_idle' updateObject_default_inv
-                    threadGet_wp hoare_vcg_imp_lift' hoare_vcg_all_lift)
-  apply (fastforce simp: valid_idle'_def obj_at'_def projectKOs idle_tcb'_def)
-  done
-
-lemma schedContextCancelYieldTo_valid_release_queue[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>valid_release_queue\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def updateSchedContext_def)
-  apply (wpsimp wp: threadSet_valid_release_queue threadGet_wp)
-  apply (fastforce simp: obj_at'_def projectKOs)
-  done
-
-lemma schedContextCancelYieldTo_ct_not_inQ[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>ct_not_inQ\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def updateSchedContext_def)
-  apply (wpsimp wp: threadSet_not_inQ threadGet_wp)
-  apply (fastforce simp: obj_at'_def projectKOs)
-  done
-
-lemma schedContextCancelYieldTo_valid_pde_mappings'[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>valid_pde_mappings'\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def setSchedContext_def updateSchedContext_def)
-  apply (wpsimp wp: threadGet_wp)
-  apply (fastforce simp: valid_pde_mappings'_def obj_at'_def projectKOs ps_clear_upd)
-  done
-
-lemma schedContextCancelYieldTo_cur_tcb'[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>cur_tcb'\<rbrace>"
-  apply (wpsimp simp: schedContextCancelYieldTo_def updateSchedContext_def
-                  wp: threadSet_cur threadGet_wp)
-  apply (fastforce simp: obj_at'_def projectKOs)
-  done
-
-lemma schedContextCancelYeldTo_valid_release_queue'[wp]:
-  "schedContextCancelYieldTo t \<lbrace>valid_release_queue'\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def updateSchedContext_def)
-  apply (rule bind_wp[OF _ threadGet_sp])
-  apply (rule hoare_when_cases; (solves \<open>wpsimp\<close>)?)
-  apply (rule_tac Q'="\<lambda>_. valid_release_queue'" in bind_wp_fwd)
-   apply wpsimp
-  apply (wpsimp wp: threadSet_valid_release_queue' setObject_tcb_wp)
-  apply (clarsimp simp: valid_release_queue'_def obj_at'_def)
-  done
-
-crunch schedContextCancelYieldTo
-  for pspace_aligned'[wp]: pspace_aligned'
-  and pspace_distinct'[wp]: pspace_distinct'
-  and pspace_bounded'[wp]: pspace_bounded'
-  and no_0_obj'[wp]: no_0_obj'
-  and ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  and list_refs_of_replies[wp]: "\<lambda>s. sym_refs (list_refs_of_replies' s)"
-  and valid_global_refs'[wp]: valid_global_refs'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and irq_node[wp]: "\<lambda>s. P (irq_node' s)"
-  and typ_at[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and interrupt_state[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and valid_irq_state'[wp]: valid_irq_states'
-  and valid_machine_state'[wp]: valid_machine_state'
-  and valid_queues[wp]: valid_queues
-  and valid_queues'[wp]: valid_queues'
-  and ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and valid_replies' [wp]: valid_replies'
-  and st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' P' t s)"
-  (wp: crunch_wps threadSet_pred_tcb_no_state simp: crunch_simps updateSchedContext_def comp_def)
-
-global_interpretation schedContextCancelYieldTo: typ_at_all_props' "schedContextCancelYieldTo t"
-  by typ_at_props'
-
-lemma schedContextCancelYieldTo_invs':
-  "schedContextCancelYieldTo t \<lbrace>invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def setSchedContext_def valid_dom_schedule'_def)
-  apply (wpsimp wp: valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift
-                    untyped_ranges_zero_lift
-              simp: cteCaps_of_def o_def)
-  apply (fastforce simp: inQ_def valid_queues_def valid_queues_no_bitmap_def)
-  done
-
-crunch schedContextCompleteYieldTo
-  for ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  and tcb_at'[wp]: "\<lambda>s. Q (tcb_at' t s)"
-  (simp: crunch_simps wp: crunch_wps)
-
-crunch setConsumed
-  for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma setConsumed_invs':
-  "setConsumed scp buffer \<lbrace>invs'\<rbrace>"
-  apply (simp add: setConsumed_def cur_tcb'_asrt_def)
-  apply (wpsimp wp: schedContextUpdateConsumed_invs'
-              simp: cur_tcb'_def
-         | wps)+
-  done
-
-lemma schedContextCompleteYieldTo_invs'[wp]:
-  "schedContextCompleteYieldTo thread \<lbrace>invs'\<rbrace>"
-  unfolding schedContextCompleteYieldTo_def
-  by (wpsimp wp: schedContextCancelYieldTo_invs' setConsumed_invs'
-                 hoare_drop_imp hoare_vcg_if_lift2
-           simp: sch_act_simple_def)
-
-lemma setConsumed_corres:
- "corres dc (case_option \<top> in_user_frame buf and sc_at scp
-             and cur_tcb and pspace_aligned and pspace_distinct)
-            (case_option \<top> valid_ipc_buffer_ptr' buf and sc_at' scp)
-            (set_consumed scp buf)
-            (setConsumed scp buf)"
-  apply add_cur_tcb'
-  apply (simp add: set_consumed_def setConsumed_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: cur_tcb'_asrt_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF schedContextUpdateConsumed_corres])
-      apply (rule corres_split[OF getCurThread_corres], simp)
-        apply (rule corres_split[OF setMRs_corres setMessageInfo_corres])
-  by (wpsimp wp: hoare_case_option_wp simp: setTimeArg_def cur_tcb_def cur_tcb'_def | wps)+
-
-lemma get_tcb_yield_to_corres:
-  "corres (=) (pspace_aligned and pspace_distinct and tcb_at t) \<top>
-          (get_tcb_obj_ref tcb_yield_to t) (threadGet tcbYieldTo 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: get_tcb_obj_ref_def getBoundNotification_def)
-  apply (rule corres_guard_imp)
-    apply (rule threadGet_corres)
-    apply (simp add: tcb_relation_def)+
-  done
-
-lemma tcb_yield_to_update_corres:
-  "corres dc (pspace_aligned and pspace_distinct and tcb_at t) \<top>
-          (set_tcb_obj_ref tcb_yield_to_update t yt) (threadSet (tcbYieldTo_update (\<lambda>_. yt)) t)"
-  apply (rule_tac Q="tcb_at' t" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD elim!: tcb_at_cross)
-  apply (rule corres_guard_imp)
-    apply (rule set_tcb_obj_ref_corres; simp add: tcb_relation_def)
-   apply simp+
-  done
-
-lemma sc_relation_tcb_yield_to_update:
-  "sc_relation sc n sc'
-   \<Longrightarrow> sc_relation (sc_yield_from_update Map.empty (sc)) n (scYieldFrom_update Map.empty sc')"
-  by (clarsimp simp: sc_relation_def)
-
-lemma schedContextCancelYieldTo_corres:
-  "corres dc
-          (pspace_aligned and pspace_distinct and valid_objs and tcb_at t)
-          \<top>
-          (sched_context_cancel_yield_to t)
-          (schedContextCancelYieldTo t)" (is "corres _ ?abs_guard _ _ _")
-  apply (rule_tac Q="tcb_at' t" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD elim!: tcb_at_cross)
-  apply (clarsimp simp: sched_context_cancel_yield_to_def schedContextCancelYieldTo_def
-                        updateSchedContext_def comp_def maybeM_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_tcb_yield_to_corres _ gyt_sp threadGet_sp
-                             , where Q="?abs_guard"])
-    defer
-    apply (simp add: obj_at_def is_tcb_def)
-   apply simp
-  apply (case_tac scPtrOpt; clarsimp?)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF update_sc_no_reply_stack_update_corres])
-          apply (simp add: sc_relation_tcb_yield_to_update)
-         apply simp
-        apply (clarsimp simp: objBits_simps')
-       apply simp
-      apply (rule tcb_yield_to_update_corres)
-     apply wpsimp
-    apply wpsimp
-   apply (clarsimp simp: valid_objs_def obj_at_def is_tcb_def)
-   apply (fastforce simp: valid_obj_def valid_tcb_def valid_bound_obj_def pred_tcb_at_def obj_at_def
-                   dest!: bspec
-                   split: option.splits)
-  apply clarsimp
-  done
-
-lemma schedContextCompleteYieldTo_corres:
-  "corres dc (invs and tcb_at thread) (invs' and tcb_at' thread)
-    (complete_yield_to thread) (schedContextCompleteYieldTo thread)"
-  apply add_cur_tcb'
-  apply (simp add: complete_yield_to_def schedContextCompleteYieldTo_def)
-  apply (subst maybeM_when)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF get_tcb_yield_to_corres], simp)
-      apply (rule corres_when2[OF refl])
-      apply (clarsimp, wpfix)
-      apply (rule corres_split[OF lookupIPCBuffer_corres], simp)
-        apply (rule corres_split[OF setConsumed_corres])
-          apply (rule schedContextCancelYieldTo_corres[simplified dc_def])
-         apply wpsimp
-        apply wpsimp
-       apply wpsimp
-      apply wpsimp
-     apply (wpsimp wp: get_tcb_obj_ref_wp)
-    apply (wpsimp wp: threadGet_wp)
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def cur_tcb_def)
-   apply (subgoal_tac "valid_tcb thread tcb s", clarsimp simp: valid_tcb_def)
-   apply (fastforce simp: obj_at'_def valid_tcb_valid_obj elim: valid_objs_ko_at
-                    dest: invs_valid_objs)
-  apply (clarsimp simp: invs'_def valid_pspace'_def cur_tcb'_def
-                        obj_at'_real_def ko_wp_at'_def pred_tcb_at'_def projectKO_tcb)
-  apply (subgoal_tac "valid_tcb' obj s", clarsimp simp: valid_tcb'_def cur_tcb'_def)
-   apply (fastforce simp: obj_at'_real_def ko_wp_at'_def)
-  apply (fastforce simp: valid_objs'_def valid_obj'_def)
-  done
-
-crunch schedContextDonate
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-
-global_interpretation schedContextDonate: typ_at_all_props' "schedContextDonate scPtr tcbPtr"
-  by typ_at_props'
-
-crunch schedContextDonate
-  for aligned'[wp]: "pspace_aligned'"
-  and distinct'[wp]:"pspace_distinct'"
-  and it'[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  and ksCurDomain[wp]:  "\<lambda>s. P (ksCurDomain s)"
-  and ct'[wp]: "\<lambda>s. P (ksCurThread s)"
-  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  and cte_wp_at'[wp]: "cte_wp_at' P p"
-
-crunch schedContextDonate
-  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-
-crunch schedContextDonate, schedContextUnbindAllTCBs, unbindFromSC,
-         schedContextSetInactive, schedContextUnbindYieldFrom, schedContextUnbindReply
-  for st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' P' p s)"
-  (simp: crunch_simps wp: threadSet_pred_tcb_no_state crunch_wps)
-
-lemma setSchedContext_ct_in_state'[wp]:
-  "setSchedContext ptr sc \<lbrace>ct_in_state' P\<rbrace>"
-  by (rule ct_in_state_thread_state_lift'; wpsimp)
-
-crunch setSchedContext
-  for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-  (wp: weak_sch_act_wf_lift)
-
-lemma schedContextDonate_weak_sch_act_wf[wp]:
-  "schedContextDonate scPtr tcbPtr \<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp only: schedContextDonate_def)
-  apply (wpsimp wp: threadSet_weak_sch_act_wf)
-         apply (rule_tac Q'="\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s" in hoare_strengthen_post[rotated], fastforce)
-         apply (wpsimp wp: threadSet_weak_sch_act_wf)
-        apply wpsimp+
-  done
-
-lemma schedContextDonate_valid_objs':
-  "\<lbrace>valid_objs' and tcb_at' tcbPtr\<rbrace>
-   schedContextDonate scPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (clarsimp simp: schedContextDonate_def)
-  apply (rule bind_wp[OF _ get_sc_sp'], rename_tac sc)
-  apply (rule_tac P'="?pre and valid_sched_context' sc and K (valid_sched_context_size' sc) and sc_at' scPtr"
-               in hoare_weaken_pre[rotated])
-   apply (fastforce simp: sc_ko_at_valid_objs_valid_sc' obj_at'_def)
-  apply (rule bind_wp_fwd_skip)
-   apply (rule hoare_when_cases, clarsimp)
-   apply (rule bind_wp_fwd_skip, wpsimp wp: tcbSchedDequeue_valid_objs')
-   apply (rule bind_wp_fwd_skip, wpsimp)
-   apply (rule bind_wp_fwd_skip, wpsimp wp: threadSet_valid_objs')
-    apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
-   apply wpsimp
-  apply (rule_tac Q'="\<lambda>_. ?pre and sc_at' scPtr" in bind_wp_fwd)
-   apply (wpsimp wp: set_sc_valid_objs')
-   apply (clarsimp simp: valid_sched_context'_def valid_sched_context_size'_def
-                         sc_size_bounds_def objBits_def objBitsKO_def)
-  apply (wpsimp wp: threadSet_valid_objs')
-  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
-  done
-
-lemma tcbReleaseRemove_list_refs_of_replies'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>\<lambda>s. P (list_refs_of_replies' s)\<rbrace>"
-  by (wpsimp simp: tcbReleaseRemove_def)
-
-lemma schedContextDonate_list_refs_of_replies' [wp]:
-  "schedContextDonate scPtr tcbPtr \<lbrace>\<lambda>s. P (list_refs_of_replies' s)\<rbrace>"
-  unfolding schedContextDonate_def
-  by (wpsimp simp: comp_def | rule hoare_strengthen_post[where Q'="\<lambda>_ s. P (list_refs_of_replies' s)"])+
-
-lemma schedContextDonate_sch_act_wf [wp]:
-  "schedContextDonate scPtr tcbPtr \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp only: schedContextDonate_def)
-  apply (wpsimp wp: threadSet_sch_act threadSet_wp)
-       apply (rule_tac Q'="\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s" in hoare_strengthen_post[rotated])
-        apply (fastforce simp: sch_act_wf_def ct_in_state'_def tcb_in_cur_domain'_def
-                               pred_tcb_at'_def obj_at'_def projectKO_eq projectKO_tcb
-                        split: if_splits)
-       apply wpsimp+
-  done
-
-lemma schedContextDonate_valid_idle':
-  "\<lbrace>\<lambda>s. valid_idle' s \<and> tcbPtr \<noteq> idle_thread_ptr \<and>
-        obj_at' (\<lambda>sc. scTCB sc \<noteq> Some idle_thread_ptr) scPtr s\<rbrace>
-   schedContextDonate scPtr tcbPtr
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  apply (simp only: schedContextDonate_def)
-  apply (wp threadSet_idle' setSchedContext_valid_idle')
-       apply (rule_tac Q'="\<lambda>_ s. tcbPtr \<noteq> ksIdleThread s" in hoare_strengthen_post; wpsimp)
-      apply (rule_tac Q'="\<lambda>_ s. valid_idle' s \<and> scPtr \<noteq> idle_sc_ptr \<and> tcbPtr \<noteq> ksIdleThread s"
-                   in hoare_strengthen_post; wpsimp)
-         apply (wpsimp wp: threadSet_idle' hoare_drop_imps threadSet_idle')
-        apply (rule_tac Q'="\<lambda>_ s. valid_idle' s \<and> scPtr \<noteq> idle_sc_ptr \<and>
-                                 tcbPtr \<noteq> ksIdleThread s \<and> from \<noteq> ksIdleThread s"
-                     in hoare_strengthen_post)
-         apply wpsimp+
-  apply (auto simp: obj_at'_def projectKO_eq projectKO_sc valid_idle'_def)
-  done
-
-lemma schedContextDonate_bound_tcb_sc_at[wp]:
-  "\<lbrace>\<top>\<rbrace> schedContextDonate scPtr tcbPtr \<lbrace>\<lambda>_. obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr\<rbrace>"
-   unfolding schedContextDonate_def
-   by (wpsimp wp: set_sc'.obj_at')
-
-lemma updateSchedContext_obj_at'[wp]:
-  "\<forall>sc'. objBits sc' = objBits (f' sc'::sched_context) \<Longrightarrow>
-   updateSchedContext scp f' \<lbrace>\<lambda>s. P (sc_at' p s)\<rbrace>"
-  apply (wpsimp simp: updateSchedContext_def wp: set_sc'.set_wp)
-  apply (clarsimp simp: obj_at'_def ps_clear_upd projectKOs objBits_simps)
-  done
-
-(* corres rules for updateRefillHd / updateRefillTl *)
-
-(* using the abstract side size *)
-lemma state_relation_sc_relation:
-  "\<lbrakk>(s, s') \<in> state_relation; sc_at ptr s; sc_at' ptr s'\<rbrakk> \<Longrightarrow>
-   sc_relation (the ((scs_of2 s) ptr)) (obj_bits (the (kheap s ptr)) - min_sched_context_bits) (the ((scs_of' s') ptr))"
-  supply projection_rewrites[simp]
-  apply (clarsimp simp: obj_at_simps is_sc_obj)
-  apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation, rotated])
-  by (clarsimp simp: sc_relation_def scBits_simps opt_map_red)
-
-(* using the concrete side size *)
-lemma state_relation_sc_relation':
-  "\<lbrakk>(s, s') \<in> state_relation; sc_at ptr s; sc_at' ptr s'\<rbrakk> \<Longrightarrow>
-   sc_relation (the ((scs_of2 s) ptr)) (objBits (the (scs_of' s' ptr)) - minSchedContextBits) (the ((scs_of' s') ptr))"
-  supply projection_rewrites[simp]
-  apply (clarsimp simp: obj_at_simps is_sc_obj)
-  apply (drule (1) pspace_relation_absD[OF _ state_relation_pspace_relation, rotated])
-  by (clarsimp simp: sc_relation_def scBits_simps opt_map_red)
-
-lemma state_relation_sc_replies_relation_sc:
-  "\<lbrakk>(s, s') \<in> state_relation; sc_at ptr s; sc_at' ptr s'\<rbrakk>
-   \<Longrightarrow> heap_ls (replyPrevs_of s') (scReplies_of s' ptr) (sc_replies (the ((scs_of2 s) ptr)))"
-  supply projection_rewrites[simp] opt_map_red[simp]
-  apply (clarsimp simp: obj_at_simps is_sc_obj)
-  by (fastforce dest!: sc_replies_relation_prevs_list[OF state_relation_sc_replies_relation])
-
-lemma sc_relation_updateRefillHd:
-  "\<lbrakk>sc_relation sc n sc'; \<forall>refill'. f (refill_map refill') = refill_map (f' refill');
-        sc_valid_refills' sc'\<rbrakk>
-       \<Longrightarrow> sc_relation (sc_refills_update (\<lambda>refills. f (hd refills) # tl refills) sc) n
-            (scRefills_update (\<lambda>_. updateAt (scRefillHead sc') (scRefills sc') f') sc')"
-  apply (prop_tac "wrap_slice (scRefillHead sc') (scRefillCount sc') (scRefillMax sc') (scRefills sc') \<noteq> []")
-   apply (clarsimp intro!: neq_Nil_lengthI)
-  apply (clarsimp simp: sc_relation_def refills_map_def tl_map hd_map)
-  apply (subst hd_Cons_tl[where xs="wrap_slice _ _ _ (updateAt _ _ _)", symmetric])
-   apply (clarsimp intro!: neq_Nil_lengthI)
-  apply simp
-  apply (subst hd_wrap_slice; (simp add: updateAt_index tl_wrap_slice neq_Nil_lengthI)?)+
-  apply (case_tac "Suc (scRefillHead sc') < scRefillMax sc'")
-   apply (prop_tac "wrap_slice (Suc (scRefillHead sc')) (scRefillCount sc' - Suc 0)
-                 (scRefillMax sc') (updateAt (scRefillHead sc') (scRefills sc') f')
-          = wrap_slice (Suc (scRefillHead sc')) (scRefillCount sc' - Suc 0) (scRefillMax sc') (scRefills sc')")
-    apply (subst wrap_slice_updateAt_eq[symmetric]; clarsimp)
-     apply (fastforce simp: neq_Nil_lengthI)+
-  apply (clarsimp simp: not_less le_eq_less_or_eq[where m="scRefillMax sc'" for sc'])
-  done
-
-lemma updateRefillHd_corres:
-  "\<lbrakk>sc_ptr = scPtr; \<forall>refill refill'. refill = refill_map refill' \<longrightarrow> f refill = (refill_map (f' refill'))\<rbrakk>
-   \<Longrightarrow> corres dc
-        (sc_at sc_ptr)
-        (valid_refills' sc_ptr and sc_at' sc_ptr)
-        (update_refill_hd sc_ptr f)
-        (updateRefillHd scPtr f')"
-  supply projection_rewrites[simp]
-  apply (clarsimp simp: update_refill_hd_def updateRefillHd_def)
-  apply (rule corres_guard_imp)
-    apply (rule updateSchedContext_corres_gen[where P=\<top>
-      and P'="valid_refills' sc_ptr"])
-      apply (clarsimp, drule (2) state_relation_sc_relation)
-      apply (fastforce simp: is_sc_obj obj_at_simps opt_map_red opt_pred_def valid_refills'_def
-                      elim!: sc_relation_updateRefillHd)
-     apply (fastforce simp: obj_at_simps is_sc_obj opt_map_red
-                     dest!: state_relation_sc_replies_relation_sc)
-  by (clarsimp simp: objBits_simps)+
-
-lemma sc_relation_updateRefillTl:
-  "\<lbrakk> sc_relation sc n sc'; \<forall>refill'. f (refill_map refill') = refill_map (f' refill');
-        sc_valid_refills' sc'\<rbrakk>
-       \<Longrightarrow> sc_relation
-            (sc_refills_update (\<lambda>refills. butlast refills @ [f (last refills)]) sc) n
-            (scRefills_update (\<lambda>_. updateAt (refillTailIndex sc') (scRefills sc') f') sc')"
-  apply (prop_tac "scRefills sc' \<noteq> []")
-   apply fastforce
-  apply (clarsimp simp: sc_relation_def refills_map_def)
-  apply (simp add: snoc_eq_iff_butlast)
-  apply (prop_tac "wrap_slice (scRefillHead sc') (scRefillCount sc') (scRefillMax sc')
-              (scRefills sc') \<noteq> []")
-   apply (clarsimp intro!: neq_Nil_lengthI)
-  apply (prop_tac "wrap_slice (scRefillHead sc') (scRefillCount sc') (scRefillMax sc')
-              (updateAt (refillTailIndex sc') (scRefills sc') f') \<noteq> []")
-   apply (clarsimp intro!: neq_Nil_lengthI)
-  apply clarsimp
-  apply (prop_tac "wrap_slice (scRefillHead sc') (scRefillCount sc' - Suc 0)
-             (scRefillMax sc')
-             (updateAt (refillTailIndex sc') (scRefills sc') f') = wrap_slice (scRefillHead sc') (scRefillCount sc' - Suc 0)
-             (scRefillMax sc')
-             (scRefills sc')")
-   apply (subst wrap_slice_updateAt_eq[symmetric]; (simp add: refillTailIndex_def Let_def split: if_split_asm)?)
-   apply (intro conjI impI; linarith)
-  apply (clarsimp simp: butlast_map butlast_wrap_slice)
-  apply (clarsimp simp: last_map)
-  apply (subst last_wrap_slice; simp?)+
-  apply (intro conjI impI)
-   apply (subst updateAt_index; simp add: refillTailIndex_def)+
-  done
-
-lemma updateRefillTl_corres:
-  "\<lbrakk>sc_ptr = scPtr;
-    \<forall>refill refill'. refill = refill_map refill' \<longrightarrow> f refill = (refill_map (f' refill'))\<rbrakk>
-   \<Longrightarrow> corres dc
-              (sc_at sc_ptr)
-              (sc_at' scPtr and valid_refills' scPtr)
-              (update_refill_tl sc_ptr f)
-              (updateRefillTl scPtr f')"
-  supply projection_rewrites[simp]
-  apply (clarsimp simp: update_refill_tl_def updateRefillTl_def)
-  apply (rule corres_guard_imp)
-    apply (rule updateSchedContext_corres_gen[where P=\<top> and P'="valid_refills' scPtr"])
-      apply (clarsimp, drule (2) state_relation_sc_relation)
-      apply (clarsimp simp: is_sc_obj obj_at_simps is_active_sc'_def valid_refills'_def)
-      apply (clarsimp simp: sc_relation_updateRefillTl opt_map_red opt_pred_def)
-     apply (fastforce simp: obj_at_simps is_sc_obj opt_map_red
-                     dest!: state_relation_sc_replies_relation_sc)
-  by (clarsimp simp: objBits_simps)+
-
-lemma readRefillReady_no_ofail[wp]:
-  "no_ofail (sc_at' t) (readRefillReady t)"
-  apply (clarsimp simp: readRefillReady_def readSchedContext_def)
-  apply (wpsimp wp: no_ofail_readCurTime)
-  done
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemma get_sc_released_corres:
-  "corres (=) (active_scs_valid and sc_at sc_ptr) (valid_objs' and sc_at' sc_ptr)
-          (get_sc_released sc_ptr) (scReleased sc_ptr)"
-  apply (simp add: get_sc_released_def scReleased_def scActive_def refillReady_def)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (corresKsimp corres: get_sc_corres)
-  apply (rename_tac sc')
-  apply (rule corres_symb_exec_l[rotated 2, OF gets_sp]; (solves wpsimp)?)
-  apply (rule corres_symb_exec_r[rotated, OF gets_the_sp]; (solves wpsimp)?)
-   apply (wpsimp wp: no_ofail_gets_the readRefillReady_no_ofail)
-  apply (clarsimp simp: sc_released_def readRefillReady_def readSchedContext_def
-                 dest!: readObject_misc_ko_at')
-  apply (subgoal_tac "sc_active sc = (0 < scRefillMax sc')")
-   apply (case_tac "sc_active sc"; clarsimp)
-   apply (drule active_scs_validE[where scp=sc_ptr, rotated])
-    apply (clarsimp simp: is_active_sc_def sc_at_ppred_def obj_at_def)
-   apply (drule_tac s'=s' in refill_hd_relation2)
-      apply (fastforce simp: refill_ready_def refill_sufficient_def refill_capacity_def
-                             kernelWCETTicks_def vs_all_heap_simps cfg_valid_refills_def
-                             rr_valid_refills_def sp_valid_refills_def obj_at_def
-                             valid_obj'_def obj_at'_def projectKOs readCurTime_def ogets_def
-                             state_relation_def
-                      dest!: readObject_ko_at'_sc
-                      split: if_splits)+
-  apply (clarsimp simp: refill_ready_def readCurTime_def ogets_def sc_relation_def active_sc_def)
-  done
-
-end
-
-end
diff --git a/proof/refine/ARM/Schedule_R.thy b/proof/refine/ARM/Schedule_R.thy
index d385b0f81c..105b19a1bb 100644
--- a/proof/refine/ARM/Schedule_R.thy
+++ b/proof/refine/ARM/Schedule_R.thy
@@ -5,121 +5,20 @@
  *)
 
 theory Schedule_R
-imports SchedContext_R InterruptAcc_R
+imports VSpace_R
 begin
 
-crunch scReleased, getReprogramTimer, getCurTime, getRefills, getReleaseQueue, refillSufficient,
-         refillReady, isRoundRobin
-  for inv[wp]: P
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 declare hoare_weak_lift_imp[wp_split del]
 
 (* Levity: added (20090713 10:04:12) *)
 declare sts_rel_idle [simp]
 
-crunch refillHeadOverlappingLoop, headInsufficientLoop, setRefillHd
-  for valid_queues[wp]: valid_queues
-  and valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n T p s)"
-  (wp: crunch_wps)
-
-crunch tcbReleaseDequeue
-  for sc_at'_n[wp]: "\<lambda>s. Q (sc_at'_n n p s)"
-  (simp: crunch_simps wp: crunch_wps)
-
-crunch refillUnblockCheck, refillBudgetCheck, ifCondRefillUnblockCheck, refillBudgetCheckRoundRobin
-  for valid_queues[wp]: valid_queues
-  and valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. Q (sc_at'_n n p s)"
-  and pspace_aligned'[wp]: pspace_aligned'
-  and pspace_distinct'[wp]: pspace_distinct'
-  and pspace_bounded'[wp]: pspace_bounded'
-  and no_0_obj'[wp]: no_0_obj'
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  and if_unsafe_then_cap'[wp]: if_unsafe_then_cap'
-  and valid_global_refs'[wp]: valid_global_refs'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and valid_irq_node[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
-  and valid_irq_handlers'[wp]: valid_irq_handlers'
-  and valid_irq_states'[wp]: valid_irq_states'
-  and irqs_masked'[wp]: irqs_masked'
-  and valid_pde_mappings'[wp]: valid_pde_mappings'
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksCurdomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and untyped_ranges_zero'[wp]: untyped_ranges_zero'
-  and cur_tcb'[wp]: cur_tcb'
-  and ct_not_inQ[wp]: ct_not_inQ
-  and valid_dom_schedule'[wp]: valid_dom_schedule'
-  and ksCurSc[wp]: "\<lambda>s. P (ksCurSc s)"
-  (wp: crunch_wps valid_dom_schedule'_lift simp: crunch_simps refillSingle_def)
-
-crunch commitTime, refillNew, refillUpdate
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-end
-
-global_interpretation tcbReleaseDequeue: typ_at_all_props' tcbReleaseDequeue
-  by typ_at_props'
-
-global_interpretation refillPopHead: typ_at_all_props' "refillPopHead scPtr"
-  by typ_at_props'
-
-global_interpretation updateRefillTl: typ_at_all_props' "updateRefillTl scPtr f"
-  by typ_at_props'
-
-global_interpretation handleOverrunLoopBody: typ_at_all_props' "handleOverrunLoopBody usage"
-  by typ_at_props'
-
-global_interpretation handleOverrunLoop: typ_at_all_props' "handleOverrunLoop usage"
-  by typ_at_props'
-
-global_interpretation scheduleUsed: typ_at_all_props' "scheduleUsed scPtr new"
-  by typ_at_props'
-
-global_interpretation updateRefillHd: typ_at_all_props' "updateRefillHd scPtr f"
-  by typ_at_props'
-
-global_interpretation mergeRefills: typ_at_all_props' "mergeRefills scPtr"
-  by typ_at_props'
-
-global_interpretation setRefillHd: typ_at_all_props' "setRefillHd scPtr v"
-  by typ_at_props'
-
-global_interpretation nonOverlappingMergeRefills: typ_at_all_props' "nonOverlappingMergeRefills scPtr"
-  by typ_at_props'
-
-global_interpretation refillBudgetCheck: typ_at_all_props' "refillBudgetCheck usage"
-  by typ_at_props'
-
-global_interpretation refillBudgetCheckRoundRobin: typ_at_all_props' "refillBudgetCheckRoundRobin usage"
-  by typ_at_props'
-
-global_interpretation commitTime: typ_at_all_props' "commitTime"
-   by typ_at_props'
-
-global_interpretation refillNew: typ_at_all_props' "refillNew scPtr maxRefills budget period"
-  by typ_at_props'
-
-global_interpretation refillUpdate: typ_at_all_props' "refillUpdate  scPtr newPeriod newBudget newMaxRefills"
-  by typ_at_props'
-
-global_interpretation updateSchedContext: typ_at_all_props' "updateSchedContext scPtr f"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemma corres_if2:
+ "\<lbrakk> G = G'; G \<Longrightarrow> corres r P P' a c; \<not> G' \<Longrightarrow> corres r Q Q' b d \<rbrakk>
+    \<Longrightarrow> corres r (if G then P else Q) (if G' then P' else Q') (if G then a else b) (if G' then c else d)"
+  by simp
 
 lemma findM_awesome':
   assumes x: "\<And>x xs. suffix (x # xs) xs' \<Longrightarrow>
@@ -146,7 +45,7 @@ proof -
     apply (rule corres_guard_imp)
       apply (rule corres_split[OF x])
          apply assumption
-        apply (rule corres_if3)
+        apply (rule corres_if2)
           apply (case_tac ra, clarsimp+)[1]
          apply (rule corres_trivial, clarsimp)
          apply (case_tac ra, simp_all)[1]
@@ -159,6 +58,9 @@ qed
 
 lemmas findM_awesome = findM_awesome' [OF _ _ _ suffix_order.refl]
 
+(* Levity: added (20090721 10:56:29) *)
+declare objBitsT_koTypeOf [simp]
+
 lemma arch_switchToThread_corres:
   "corres dc (valid_arch_state and valid_objs and valid_asid_map
               and valid_vspace_objs and pspace_aligned and pspace_distinct
@@ -179,8 +81,7 @@ lemma arch_switchToThread_corres:
       apply (rule corres_machine_op[OF corres_rel_imp])
       apply (rule corres_underlying_trivial)
        apply (simp add: ARM.clearExMonitor_def | wp)+
-   apply clarsimp
-  apply (clarsimp simp: valid_pspace'_def)
+  apply clarsimp
   done
 
 lemma schedule_choose_new_thread_sched_act_rct[wp]:
@@ -188,17 +89,7 @@ lemma schedule_choose_new_thread_sched_act_rct[wp]:
   unfolding schedule_choose_new_thread_def
   by wp
 
-lemma obj_at'_tcbQueued_cross:
-  "(s,s') \<in> state_relation \<Longrightarrow> obj_at' tcbQueued t s' \<Longrightarrow> valid_queues' s' \<Longrightarrow>
-    obj_at (\<lambda>ko. \<exists>tcb. ko = TCB tcb \<and> tcb_priority tcb = p \<and> tcb_domain tcb = d) t s \<Longrightarrow>
-    t \<in> set (ready_queues s d p)"
-  apply (clarsimp simp: state_relation_def ready_queues_relation_def valid_queues'_def)
-  apply (subgoal_tac "obj_at' (inQ d p) t s'", simp)
-  apply (clarsimp simp: obj_at'_def inQ_def obj_at_def projectKO_eq projectKO_tcb)
-  apply (frule (2) pspace_relation_tcb_domain_priority)
-  apply clarsimp
-  done
-
+\<comment> \<open>This proof shares many similarities with the proof of @{thm tcbSchedEnqueue_corres}\<close>
 lemma tcbSchedAppend_corres:
   "tcb_ptr = tcbPtr \<Longrightarrow>
    corres dc
@@ -570,14 +461,13 @@ crunch tcbSchedEnqueue
   (wp: threadSet_cur)
 
 lemma tcbSchedEnqueue_invs'[wp]:
-  "\<lbrace>invs' and st_tcb_at' runnable' t\<rbrace>
+  "\<lbrace>invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
    tcbSchedEnqueue t
    \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: valid_irq_node_lift irqs_masked_lift valid_irq_handlers_lift' cur_tcb_lift
-                    untyped_ranges_zero_lift
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
+  apply (wpsimp wp: valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift
+                    untyped_ranges_zero_lift tcbSchedEnqueue_ct_not_inQ
               simp: cteCaps_of_def o_def)
-  apply (auto elim!: st_tcb_ex_cap'')
   done
 
 crunch tcbSchedAppend
@@ -672,43 +562,44 @@ lemma tcbSchedAppend_valid_bitmaps[wp]:
   apply (clarsimp simp: valid_bitmaps_def)
   done
 
-crunch tcbSchedAppend
-  for list_refs_of_replies'[wp]: "\<lambda>s. P (list_refs_of_replies' s)"
-
-lemma tcbSchedAppend_valid_release_queue[wp]:
-  "tcbSchedAppend t \<lbrace>valid_release_queue\<rbrace>"
-  unfolding tcbSchedAppend_def
-  apply (wpsimp simp: valid_release_queue_def Ball_def addToBitmap_def
-                      modifyReadyQueuesL2Bitmap_def getReadyQueuesL2Bitmap_def
-                      modifyReadyQueuesL1Bitmap_def getReadyQueuesL1Bitmap_def
-                  wp: hoare_vcg_all_lift hoare_vcg_imp_lift' threadGet_wp)
-  by (auto simp: obj_at'_def)
-
-crunch addToBitmap
-  for ksReleaseQueue[wp]: "\<lambda>s. P (ksReleaseQueue s)"
-
-lemma tcbSchedAppend_valid_release_queue'[wp]:
-  "tcbSchedAppend t \<lbrace>valid_release_queue'\<rbrace>"
-  unfolding tcbSchedAppend_def threadGet_def
-  apply (wpsimp simp: valid_release_queue'_def
-                  wp: threadSet_valid_release_queue' hoare_vcg_all_lift hoare_vcg_imp_lift'
-                      getObject_tcb_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
 lemma tcbSchedAppend_invs'[wp]:
-  "\<lbrace>invs' and st_tcb_at' runnable' t\<rbrace>
+  "\<lbrace>invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
    tcbSchedAppend t
    \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
-  apply (rule hoare_pre)
-   apply (wp tcbSchedAppend_ct_not_inQ valid_irq_node_lift irqs_masked_lift hoare_vcg_disj_lift
-             valid_irq_handlers_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift2
-             untyped_ranges_zero_lift
-        | simp add: cteCaps_of_def o_def
-        | auto elim!: st_tcb_ex_cap'' valid_objs'_maxDomain valid_objs'_maxPriority split: thread_state.split_asm simp: valid_pspace'_def)+
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
+  apply (wpsimp wp: valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift
+                    untyped_ranges_zero_lift tcbSchedAppend_ct_not_inQ
+                    ct_idle_or_in_cur_domain'_lift2 cur_tcb_lift
+              simp: cteCaps_of_def o_def)
   done
 
+lemma tcbSchedAppend_all_invs_but_ct_not_inQ':
+  "\<lbrace>invs'\<rbrace>
+   tcbSchedAppend t
+   \<lbrace>\<lambda>_. all_invs_but_ct_not_inQ'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
+  apply (wpsimp wp: valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift
+                    untyped_ranges_zero_lift tcbSchedAppend_ct_not_inQ
+                    ct_idle_or_in_cur_domain'_lift2 cur_tcb_lift
+              simp: cteCaps_of_def o_def)
+  done
+
+lemma tcbSchedEnqueue_invs'_not_ResumeCurrentThread:
+  "\<lbrace>invs'
+    and st_tcb_at' runnable' t
+    and (\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread)\<rbrace>
+     tcbSchedEnqueue t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  by wpsimp
+
+lemma tcbSchedAppend_invs'_not_ResumeCurrentThread:
+  "\<lbrace>invs'
+    and st_tcb_at' runnable' t
+    and (\<lambda>s. ksSchedulerAction s \<noteq> ResumeCurrentThread)\<rbrace>
+     tcbSchedAppend t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  by wpsimp
+
 lemma tcb_at'_has_tcbDomain:
  "tcb_at' t s \<Longrightarrow> \<exists>p. obj_at' (\<lambda>tcb. tcbDomain tcb = p) t s"
  by (clarsimp simp add: obj_at'_def)
@@ -762,14 +653,10 @@ lemma tcbSchedDequeue_valid_mdb'[wp]:
 
 lemma tcbSchedDequeue_invs'[wp]:
   "tcbSchedDequeue t \<lbrace>invs'\<rbrace>"
-  unfolding invs'_def
-  apply (rule hoare_pre)
-   apply (wp valid_irq_node_lift irqs_masked_lift
-             valid_irq_handlers_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift2
-             tcbSchedDequeue_valid_queues untyped_ranges_zero_lift
-          | simp add: cteCaps_of_def o_def valid_dom_schedule'_def)+
-  apply (auto simp: valid_pspace'_def obj_at'_def
-              dest: valid_objs'_maxDomain[where t=t] valid_objs'_maxPriority[where t=t])
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
+  apply (wpsimp wp: valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift
+                    untyped_ranges_zero_lift ct_idle_or_in_cur_domain'_lift2 cur_tcb_lift
+              simp: cteCaps_of_def o_def)
   done
 
 lemma ready_qs_runnable_cross:
@@ -817,18 +704,25 @@ 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 (pspace_aligned and pspace_distinct and valid_ready_qs) \<top>
-             (modify (cur_thread_update (\<lambda>_. t))) (setCurThread t)"
-  apply add_ready_qs_runnable
-  apply (unfold setCurThread_def)
-  apply (rule corres_stateAssert_add_assertion[rotated]; clarsimp)
+  "corres dc (valid_idle and valid_queues and valid_etcbs 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 state_relation_pspace_relation)
+   apply (frule state_relation_ready_queues_relation)
+   apply (frule state_relation_idle_thread)
+   apply (frule valid_idle_tcb_at)
+   apply (frule (3) tcb_at_cross)
+   apply (fastforce dest!: in_ready_q_tcbQueued_eq[THEN arg_cong_Not, THEN iffD1]
+                     simp: obj_at'_def projectKOs opt_pred_def opt_map_def)
   apply (rule corres_modify)
   apply (simp add: state_relation_def swp_def)
   done
 
-lemma arch_switch_thread_tcb_at' [wp]:
-  "Arch.switchToThread t \<lbrace>\<lambda>s. P (tcb_at' t s)\<rbrace>"
-  by (unfold ARM_H.switchToThread_def, wp typ_at_lifts)
+lemma arch_switch_thread_tcb_at' [wp]: "\<lbrace>tcb_at' t\<rbrace> Arch.switchToThread t \<lbrace>\<lambda>_. tcb_at' t\<rbrace>"
+  by (unfold ARM_H.switchToThread_def, wp typ_at_lift_tcb')
 
 crunch "switchToThread"
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
@@ -849,8 +743,6 @@ proof -
     by (rule lift_neg_pred_tcb_at' [OF ArchThreadDecls_H_ARM_H_switchToThread_typ_at' pos])
 qed
 
-crunch doMachineOp
-  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s)"
 
 crunch storeWordUser
   for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
@@ -894,18 +786,14 @@ lemma valid_queues_ready_qs_distinct[elim!]:
   "valid_queues s \<Longrightarrow> ready_qs_distinct s"
   by (clarsimp simp: valid_queues_def ready_qs_distinct_def)
 
-crunch arch_switch_to_thread
-  for pspace_aligned[wp]: pspace_aligned
-  and pspace_distinct[wp]: pspace_distinct
-
 lemma switchToThread_corres:
   "corres dc (valid_arch_state and valid_objs and valid_asid_map
-                and valid_vspace_objs and pspace_aligned and pspace_distinct and valid_ready_qs
+                and valid_vspace_objs and pspace_aligned and pspace_distinct
                 and valid_vs_lookup and valid_global_objs
                 and unique_table_refs o caps_of_state
-                and st_tcb_at runnable t)
-             (valid_arch_state' and valid_pspace' and Invariants_H.valid_queues
-                and st_tcb_at' runnable' t and cur_tcb')
+                and st_tcb_at runnable t and valid_etcbs
+                and valid_queues and valid_idle)
+             (no_0_obj' and sym_heap_sched_pointers and valid_objs' and valid_arch_state')
              (switch_to_thread t) (switchToThread t)"
   apply (rule_tac Q'="st_tcb_at' runnable' t" in corres_cross_add_guard)
    apply (fastforce intro!: st_tcb_at_runnable_cross simp: obj_at_def is_tcb_def)
@@ -924,23 +812,14 @@ 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 wp: tcb_sched_dequeue_valid_ready_qs | clarsimp simp: st_tcb_at_tcb_at)+
-    done
-
-  show ?thesis
-    apply -
-    apply (simp add: switch_to_thread_def Thread_H.switchToThread_def)
-    apply add_ready_qs_runnable
-    apply (rule corres_stateAssert_add_assertion)
-     apply (rule corres_symb_exec_l[where Q = "\<lambda> s rv. (?PA and (=) rv) s"])
-        apply (rule corres_symb_exec_l)
-           apply (rule corres_guard_imp[OF mainpart])
-            apply (auto intro: no_fail_pre [OF no_fail_assert] no_fail_pre [OF no_fail_get]
-                         dest: st_tcb_at_tcb_at [THEN get_tcb_at]
-                   | simp add: assert_def
-                   | wp)+
-    done
-qed
+          apply (wpsimp simp: is_tcb_def)+
+     apply (fastforce intro!: st_tcb_at_tcb_at)
+    apply wpsimp
+   apply wpsimp
+   apply (fastforce dest!: st_tcb_at_tcb_at simp: tcb_at_def)
+  apply wpsimp
+  apply (fastforce dest!: st_tcb_at_tcb_at simp: tcb_at_def)
+  done
 
 lemma arch_switchToIdleThread_corres:
   "corres dc (valid_arch_state and valid_objs and valid_asid_map and unique_table_refs \<circ> caps_of_state and
@@ -954,34 +833,26 @@ lemma arch_switchToIdleThread_corres:
   apply (clarsimp simp: valid_idle_def valid_idle'_def pred_tcb_at_def obj_at_def is_tcb obj_at'_def)
   done
 
-crunch switchToIdleThread
-  for ready_qs_runnable[wp]: "\<lambda>s. \<forall>d p. \<forall>t\<in>set (ksReadyQueues s (d, p)).
-                       st_tcb_at' runnable' t s"
-  (simp: crunch_simps)
-
 lemma switchToIdleThread_corres:
-  "corres dc (invs and valid_ready_qs) invs' switch_to_idle_thread switchToIdleThread"
-  apply add_ready_qs_runnable
-  apply add_valid_idle'
+  "corres dc
+     (invs and valid_queues and valid_etcbs)
+     invs_no_cicd'
+     switch_to_idle_thread switchToIdleThread"
   apply (simp add: switch_to_idle_thread_def Thread_H.switchToIdleThread_def)
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply clarsimp
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: valid_idle'_asrt_def)
+  apply add_ready_qs_runnable
+  apply (rule corres_stateAssert_ignore, fastforce)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getIdleThread_corres])
       apply (rule corres_split[OF arch_switchToIdleThread_corres])
-        apply (unfold setCurThread_def)
-        apply (rule corres_stateAssert_add_assertion)
-         apply clarsimp
-         apply (rule corres_modify)
-        apply (simp add: state_relation_def cdt_relation_def)
-        apply (simp only: ready_qs_runnable_def)
-       apply wpsimp+
+        apply clarsimp
+        apply (rule setCurThread_corres)
+       apply wpsimp
+      apply (simp add: state_relation_def cdt_relation_def)
+      apply wpsimp+
    apply (simp add: invs_unique_refs invs_valid_vs_lookup invs_valid_objs invs_valid_asid_map
                     invs_arch_state invs_valid_global_objs invs_psp_aligned invs_distinct
                     invs_valid_idle invs_vspace_objs)
-  apply (simp add: invs'_def valid_pspace'_def ready_qs_runnable_def)
+  apply (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def valid_pspace'_def)
   done
 
 lemma gq_sp: "\<lbrace>P\<rbrace> getQueue d p \<lbrace>\<lambda>rv. P and (\<lambda>s. ksReadyQueues s (d, p) = rv)\<rbrace>"
@@ -996,86 +867,55 @@ lemma sch_act_wf:
 declare gq_wp[wp]
 declare setQueue_obj_at[wp]
 
-lemma setCurThread_invs':
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
-   setCurThread t
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: setCurThread_def)
-  apply wp
-  apply (clarsimp simp add: invs'_def cur_tcb'_def valid_queues_def valid_release_queue_def
-                            valid_release_queue'_def sch_act_wf ct_in_state'_def
-                            state_refs_of'_def ps_clear_def valid_irq_node'_def valid_queues'_def
-                            ct_idle_or_in_cur_domain'_def
-                            bitmapQ_defs valid_queues_no_bitmap_def valid_dom_schedule'_def
-                      cong: option.case_cong)
-  done
-
-lemma valid_queues_not_runnable_not_queued:
-  fixes s
-  assumes  vq: "valid_queues s"
-      and rqr: "\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). st_tcb_at' runnable' t s)"
-      and vq': "valid_queues' s"
-      and  st: "st_tcb_at' (Not \<circ> runnable') t s"
-  shows "obj_at' (Not \<circ> tcbQueued) t s"
-proof (rule ccontr)
-  assume "\<not> obj_at' (Not \<circ> tcbQueued) t s"
-  moreover from st have "typ_at' TCBT t s"
-    by (rule pred_tcb_at' [THEN tcb_at_typ_at' [THEN iffD1]])
-  ultimately have "obj_at' tcbQueued t s"
-    by (clarsimp simp: not_obj_at' comp_def)
-
-  moreover
-  from st [THEN pred_tcb_at', THEN tcb_at'_has_tcbPriority]
-  obtain p where tp: "obj_at' (\<lambda>tcb. tcbPriority tcb = p) t s"
-    by clarsimp
-
-  moreover
-  from st [THEN pred_tcb_at', THEN tcb_at'_has_tcbDomain]
-  obtain d where td: "obj_at' (\<lambda>tcb. tcbDomain tcb = d) t s"
-    by clarsimp
-
-  ultimately
-  have "t \<in> set (ksReadyQueues s (d, p))" using vq'
-    unfolding valid_queues'_def
-    apply -
-    apply (drule_tac x=d in spec)
-    apply (drule_tac x=p in spec)
-    apply (drule_tac x=t in spec)
-    apply (erule impE)
-     apply (fastforce simp add: inQ_def obj_at'_def)
-    apply (assumption)
-    done
+lemma threadSet_timeslice_invs:
+  "\<lbrace>invs' and tcb_at' t\<rbrace> threadSet (tcbTimeSlice_update b) t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  by (wp threadSet_invs_trivial, simp_all add: inQ_def cong: conj_cong)
 
-  with vq rqr have "st_tcb_at' runnable' t s"
-    unfolding Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-    apply -
-    apply clarsimp
+lemma setCurThread_invs_no_cicd':
+  "\<lbrace>invs_no_cicd' and st_tcb_at' activatable' t and obj_at' (\<lambda>x. \<not> tcbQueued x) t and tcb_in_cur_domain' t\<rbrace>
+     setCurThread t
+   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+proof -
+  have ct_not_inQ_ct: "\<And>s t . \<lbrakk> ct_not_inQ s; obj_at' (\<lambda>x. \<not> tcbQueued x) t s\<rbrakk> \<Longrightarrow> ct_not_inQ (s\<lparr> ksCurThread := t \<rparr>)"
+    apply (simp add: ct_not_inQ_def o_def)
     done
-
-  with st show False
-    apply (clarsimp simp: st_tcb_at'_def obj_at'_def)
+  show ?thesis
+    apply (simp add: setCurThread_def)
+    apply wp
+    apply (clarsimp simp add: all_invs_but_ct_idle_or_in_cur_domain'_def invs'_def cur_tcb'_def
+                              valid_state'_def sch_act_wf ct_in_state'_def state_refs_of'_def
+                              ps_clear_def valid_irq_node'_def ct_not_inQ_ct
+                              ct_idle_or_in_cur_domain'_def bitmapQ_defs valid_bitmaps_def
+                        cong: option.case_cong)
     done
 qed
 
-(*
- * The idle thread is not part of any ready queues.
- *)
-lemma idle'_not_tcbQueued':
- assumes   vq:  "Invariants_H.valid_queues s"
-     and  rqr:  "\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). st_tcb_at' runnable' t s)"
-     and  vq':  "valid_queues' s"
-     and idle: "valid_idle' s"
- shows "obj_at' (Not \<circ> tcbQueued) (ksIdleThread s) s"
- proof -
-   from idle have stidle: "st_tcb_at' (Not \<circ> runnable') (ksIdleThread s) s"
-     by (clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def projectKOs idle_tcb'_def)
-
-   with vq rqr vq' show ?thesis
-     by (rule valid_queues_not_runnable_not_queued)
- qed
+(* Don't use this rule when considering the idle thread. The invariant ct_idle_or_in_cur_domain'
+   says that either "tcb_in_cur_domain' t" or "t = ksIdleThread s".
+   Use setCurThread_invs_idle_thread instead. *)
+lemma setCurThread_invs:
+  "\<lbrace>invs' and st_tcb_at' activatable' t and obj_at' (\<lambda>x. \<not> tcbQueued x) t and
+    tcb_in_cur_domain' t\<rbrace> setCurThread t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  by (rule hoare_pre, rule setCurThread_invs_no_cicd')
+     (simp add: invs'_to_invs_no_cicd'_def)
+
+lemma setCurThread_invs_no_cicd'_idle_thread:
+  "\<lbrace>invs_no_cicd' and (\<lambda>s. t = ksIdleThread s) \<rbrace> setCurThread t \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (simp add: setCurThread_def)
+  apply wp
+  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def invs'_def cur_tcb'_def
+                        valid_state'_def valid_idle'_def
+                        sch_act_wf ct_in_state'_def state_refs_of'_def
+                        ps_clear_def valid_irq_node'_def
+                        ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def
+                        valid_queues_def bitmapQ_defs valid_bitmaps_def pred_tcb_at'_def
+                  cong: option.case_cong)
+  apply (clarsimp simp: idle_tcb'_def ct_not_inQ_def ps_clear_def obj_at'_def projectKOs
+                        st_tcb_at'_def idleThreadNotQueued_def)
+  done
 
 lemma clearExMonitor_invs'[wp]:
-  "doMachineOp ARM.clearExMonitor \<lbrace>invs'\<rbrace>"
+  "\<lbrace>invs'\<rbrace> doMachineOp ARM.clearExMonitor \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (wp dmo_invs' no_irq)
    apply (simp add: no_irq_clearExMonitor)
   apply (clarsimp simp: ARM.clearExMonitor_def machine_op_lift_def
@@ -1083,7 +923,7 @@ lemma clearExMonitor_invs'[wp]:
   done
 
 lemma Arch_switchToThread_invs[wp]:
-  "\<lbrace>invs'\<rbrace> Arch.switchToThread t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  "\<lbrace>invs' and tcb_at' t\<rbrace> Arch.switchToThread t \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: ARM_H.switchToThread_def)
   apply (wp; auto)
   done
@@ -1132,8 +972,16 @@ lemma Arch_switchToThread_obj_at[wp]:
 
 declare doMachineOp_obj_at[wp]
 
+lemma clearExMonitor_invs_no_cicd'[wp]:
+  "\<lbrace>invs_no_cicd'\<rbrace> doMachineOp ARM.clearExMonitor \<lbrace>\<lambda>rv. invs_no_cicd'\<rbrace>"
+  apply (wp dmo_invs_no_cicd' no_irq)
+   apply (simp add: no_irq_clearExMonitor)
+  apply (clarsimp simp: ARM.clearExMonitor_def machine_op_lift_def
+                        in_monad select_f_def)
+  done
+
 crunch asUser
- for valid_arch_state'[wp]: "valid_arch_state'"
+  for valid_arch_state'[wp]: "valid_arch_state'"
 (wp: crunch_wps simp: crunch_simps)
 
 crunch asUser
@@ -1170,22 +1018,36 @@ crunch asUser
 
 lemmas asUser_cteCaps_of[wp] = cteCaps_of_ctes_of_lift[OF asUser_ctes_of]
 
-lemma switchToThread_invs'_helper:
-  "\<lbrace>invs' and tcb_at' t\<rbrace>
-   do y \<leftarrow> ARM_H.switchToThread t;
-      y \<leftarrow> tcbSchedDequeue t;
-      setCurThread t
-   od
-   \<lbrace>\<lambda>rv. invs' \<rbrace>"
-  apply (wp setCurThread_invs' tcbSchedDequeue_not_tcbQueued Arch_switchToThread_pred_tcb')
-  apply auto
+lemma Arch_switchToThread_invs_no_cicd':
+  "\<lbrace>invs_no_cicd'\<rbrace> Arch.switchToThread t \<lbrace>\<lambda>rv. invs_no_cicd'\<rbrace>"
+  apply (simp add: ARM_H.switchToThread_def)
+  by (wp|rule setVMRoot_invs_no_cicd')+
+
+
+lemma tcbSchedDequeue_invs_no_cicd'[wp]:
+  "tcbSchedDequeue t \<lbrace>invs_no_cicd'\<rbrace>"
+  unfolding all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def valid_pspace'_def
+  apply (wp tcbSchedDequeue_ct_not_inQ sch_act_wf_lift valid_irq_node_lift irqs_masked_lift
+            valid_irq_handlers_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift2
+            untyped_ranges_zero_lift
+        | simp add: cteCaps_of_def o_def)+
+  apply clarsimp
   done
 
-lemma switchToThread_invs'[wp]:
-  "\<lbrace>invs' and tcb_at' t\<rbrace> switchToThread t \<lbrace>\<lambda>_. invs' \<rbrace>"
+lemma switchToThread_invs_no_cicd':
+  "\<lbrace>invs_no_cicd' and tcb_in_cur_domain' t \<rbrace> ThreadDecls_H.switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
+  apply (simp add: Thread_H.switchToThread_def)
+  apply (wp setCurThread_invs_no_cicd' tcbSchedDequeue_not_tcbQueued
+            Arch_switchToThread_invs_no_cicd' Arch_switchToThread_pred_tcb')
+  apply (auto elim!: pred_tcb'_weakenE)
+  done
+
+lemma switchToThread_invs[wp]:
+  "\<lbrace>invs' and tcb_in_cur_domain' t \<rbrace> switchToThread t \<lbrace>\<lambda>rv. invs' \<rbrace>"
   apply (simp add: Thread_H.switchToThread_def )
-  apply (wp setCurThread_invs' Arch_switchToThread_invs dmo_invs'
-            doMachineOp_obj_at tcbSchedDequeue_not_tcbQueued)
+  apply (wp threadSet_timeslice_invs setCurThread_invs
+             Arch_switchToThread_invs dmo_invs'
+             doMachineOp_obj_at tcbSchedDequeue_not_tcbQueued)
   by (auto elim!: pred_tcb'_weakenE)
 
 lemma setCurThread_ct_in_state:
@@ -1200,10 +1062,13 @@ qed
 
 lemma switchToThread_ct_in_state[wp]:
   "\<lbrace>obj_at' (P \<circ> tcbState) t\<rbrace> switchToThread t \<lbrace>\<lambda>rv. ct_in_state' P\<rbrace>"
-  apply (simp add: Thread_H.switchToThread_def tcbSchedEnqueue_def unless_def)
-  apply (wp setCurThread_ct_in_state Arch_switchToThread_obj_at
+proof -
+  show ?thesis
+    apply (simp add: Thread_H.switchToThread_def tcbSchedEnqueue_def unless_def)
+    apply (wp setCurThread_ct_in_state Arch_switchToThread_obj_at
          | simp add: o_def cong: if_cong)+
-  done
+    done
+qed
 
 lemma setCurThread_obj_at[wp]:
   "\<lbrace>obj_at' P addr\<rbrace> setCurThread t \<lbrace>\<lambda>rv. obj_at' P addr\<rbrace>"
@@ -1212,6 +1077,9 @@ lemma setCurThread_obj_at[wp]:
   apply (fastforce intro: obj_at'_pspaceI)
   done
 
+crunch setQueue
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
+
 lemma dmo_cap_to'[wp]:
   "\<lbrace>ex_nonz_cap_to' p\<rbrace>
      doMachineOp m
@@ -1242,6 +1110,10 @@ lemma iflive_inQ_nonz_cap_strg:
 lemmas iflive_inQ_nonz_cap[elim]
     = mp [OF iflive_inQ_nonz_cap_strg, OF conjI[rotated]]
 
+crunch threadSet
+  for ksRQ[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  (wp: updateObject_default_inv)
+
 declare Cons_eq_tails[simp]
 
 crunch "ThreadDecls_H.switchToThread"
@@ -1252,60 +1124,48 @@ lemma obj_tcb_at':
   "obj_at' (\<lambda>tcb::tcb. P tcb) t s \<Longrightarrow> tcb_at' t s"
   by (clarsimp simp: obj_at'_def)
 
-lemma valid_queues_not_tcbQueued_not_ksQ:
-  fixes s
-  assumes   vq: "valid_queues s"
-      and notq: "obj_at' (Not \<circ> tcbQueued) t s"
-  shows "\<forall>d p. t \<notin> set (ksReadyQueues s (d, p))"
-proof (rule ccontr, simp , erule exE, erule exE)
-  fix d p
-  assume "t \<in> set (ksReadyQueues s (d, p))"
-  with vq have "obj_at' (inQ d p) t s"
-    by (fastforce intro: valid_queues_obj_at'D)
-  hence "obj_at' tcbQueued t s"
-    apply (rule obj_at'_weakenE)
-    apply (simp only: inQ_def)
-    done
-  with notq show "False"
-    by (clarsimp simp: obj_at'_def)
-qed
-
-lemma not_tcbQueued_not_ksQ:
-  fixes s
-  assumes "invs' s"
-      and "obj_at' (Not \<circ> tcbQueued) t s"
-  shows "\<forall>d p. t \<notin> set (ksReadyQueues s (d, p))"
-  apply (insert assms)
-  apply (clarsimp simp add: invs'_def)
-  apply (drule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply clarsimp
-  done
-
-lemma ct_not_ksQ:
-  "\<lbrakk> ct_not_inQ s; valid_queues s; ksSchedulerAction s = ResumeCurrentThread \<rbrakk>
-   \<Longrightarrow> \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)"
-  apply (clarsimp simp: ct_not_inQ_def)
-  apply (frule(1) valid_queues_not_tcbQueued_not_ksQ)
-  apply (fastforce)
+lemma tcb_at_typ_at':
+  "tcb_at' p s = typ_at' TCBT p s"
+  unfolding typ_at'_def
+  apply rule
+  apply (clarsimp simp add: obj_at'_def ko_wp_at'_def projectKOs)
+  apply (clarsimp simp add: obj_at'_def ko_wp_at'_def projectKOs)
+  apply (case_tac ko, simp_all)
   done
 
-lemma scheduleTCB_rct:
-  "\<lbrace>\<lambda>s. (t = ksCurThread s \<longrightarrow> isSchedulable_bool t s)
-        \<and> ksSchedulerAction s = ResumeCurrentThread\<rbrace>
-   scheduleTCB t
-   \<lbrace>\<lambda>_ s. ksSchedulerAction s = ResumeCurrentThread\<rbrace>"
-  unfolding scheduleTCB_def
-  by (wpsimp wp: isSchedulable_wp | rule hoare_pre_cont)+
+crunch getCurThread
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma setThreadState_rct:
-  "\<lbrace>\<lambda>s. (t = ksCurThread s \<longrightarrow> runnable' st
-      \<and> pred_map (\<lambda>tcb. \<not>(tcbInReleaseQueue tcb)) (tcbs_of' s) t
-      \<and> pred_map (\<lambda>scPtr. isScActive scPtr s) (tcbSCs_of s) t)
+  "\<lbrace>\<lambda>s. (runnable' st \<or> ksCurThread s \<noteq> t)
         \<and> ksSchedulerAction s = ResumeCurrentThread\<rbrace>
    setThreadState st t
    \<lbrace>\<lambda>_ s. ksSchedulerAction s = ResumeCurrentThread\<rbrace>"
-  unfolding setThreadState_def
-  by (wpsimp wp: scheduleTCB_rct hoare_vcg_all_lift hoare_vcg_imp_lift' threadSet_isSchedulable_bool)
+  apply (simp add: setThreadState_def)
+  apply (rule hoare_pre_disj')
+   apply (rule bind_wp [OF _
+                 hoare_vcg_conj_lift
+                   [OF threadSet_tcbState_st_tcb_at' [where P=runnable']
+                       threadSet_nosch]])
+   apply (rule bind_wp [OF _
+                 hoare_vcg_conj_lift [OF isRunnable_const isRunnable_inv]])
+   apply (clarsimp simp: when_def)
+   apply (case_tac rv)
+    apply (clarsimp, wp)[1]
+   apply (clarsimp)
+  apply (rule bind_wp [OF _
+                hoare_vcg_conj_lift
+                  [OF threadSet_ct threadSet_nosch]])
+  apply (rule bind_wp [OF _ isRunnable_inv])
+  apply (rule bind_wp [OF _
+                hoare_vcg_conj_lift
+                  [OF gct_wp gct_wp]])
+  apply (rename_tac ct)
+  apply (case_tac "ct\<noteq>t")
+   apply (clarsimp simp: when_def)
+   apply (wp)[1]
+  apply (clarsimp)
+  done
 
 lemma bitmapQ_lookupBitmapPriority_simp: (* neater unfold, actual unfold is really ugly *)
   "\<lbrakk> ksReadyQueuesL1Bitmap s d \<noteq> 0 ;
@@ -1444,39 +1304,29 @@ lemma getReadyQueuesL2Bitmap_inv[wp]:
   unfolding getReadyQueuesL2Bitmap_def by wp
 
 lemma switchToThread_lookupBitmapPriority_wp:
-  "\<lbrace>\<lambda>s. invs' s \<and> bitmapQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) s \<and>
-        t = hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)) \<rbrace>
+  "\<lbrace>\<lambda>s. invs_no_cicd' s \<and> bitmapQ (ksCurDomain s) (lookupBitmapPriority (ksCurDomain s) s) s \<and>
+        t = the (tcbQueueHead (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)))\<rbrace>
    ThreadDecls_H.switchToThread t
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  have switchToThread_pre:
-    "\<And>s p t.\<lbrakk> valid_queues s ; \<forall>d p. \<forall>t \<in> set (ksReadyQueues s (d, p)). st_tcb_at' runnable' t s;
-              bitmapQ (ksCurDomain s) p s ; t = hd (ksReadyQueues s (ksCurDomain s, p)) \<rbrakk>
-            \<Longrightarrow> st_tcb_at' runnable' t s \<and> tcb_in_cur_domain' t s"
-    unfolding valid_queues_def
-    apply (clarsimp dest!: bitmapQ_ksReadyQueuesI)
-    apply (case_tac "ksReadyQueues s (ksCurDomain s, p)", simp)
-    apply (rename_tac t ts)
-    apply (drule_tac t=t and p=p and d="ksCurDomain s" in valid_queues_no_bitmap_objD)
-     apply simp
-    apply (fastforce intro: cons_set_intro
-                      elim: obj_at'_weaken
-                      simp: inQ_def tcb_in_cur_domain'_def)
-    done
-  thus ?thesis
-    apply (simp add: Thread_H.switchToThread_def)
-    apply (rule bind_wp[OF _ stateAssert_sp])
-    apply (wp switchToThread_invs'_helper)
-    apply (fastforce simp: st_tcb_at'_def obj_at_simps invs'_def ready_qs_runnable_def)
-    done
-qed
+  apply (simp add: Thread_H.switchToThread_def)
+  apply (wp setCurThread_invs_no_cicd' tcbSchedDequeue_not_tcbQueued
+            Arch_switchToThread_invs_no_cicd')
+  apply (auto elim!: pred_tcb'_weakenE)
+  apply (prop_tac "valid_bitmapQ s")
+   apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_bitmaps_def)
+  apply (clarsimp simp: ready_queue_relation_def ksReadyQueues_asrt_def valid_bitmapQ_bitmapQ_simp)
+  apply (drule_tac x="ksCurDomain s" in spec)
+  apply (drule_tac x="lookupBitmapPriority (ksCurDomain s) s" in spec)
+  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def)
+  apply (frule (3) obj_at'_tcbQueueHead_ksReadyQueues)
+  apply (clarsimp simp: tcb_in_cur_domain'_def obj_at'_def tcbQueueEmpty_def inQ_def)
+  done
 
-lemma switchToIdleThread_invs':
-  "switchToIdleThread \<lbrace>invs'\<rbrace>"
+lemma switchToIdleThread_invs_no_cicd':
+  "\<lbrace>invs_no_cicd'\<rbrace> switchToIdleThread \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (clarsimp simp: Thread_H.switchToIdleThread_def ARM_H.switchToIdleThread_def)
-  apply (wpsimp wp: setCurThread_invs')
-  apply (clarsimp simp: invs'_def valid_idle'_asrt_def
-                 dest!: valid_idle'_tcb_at')
+  apply (wp setCurThread_invs_no_cicd'_idle_thread setVMRoot_invs_no_cicd')
+  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_idle'_def)
   done
 
 crunch "Arch.switchToIdleThread"
@@ -1491,9 +1341,11 @@ lemma setCurThread_const:
 
 
 
-crunch switchToIdleThread, switchToThread, chooseThread
+crunch switchToIdleThread
   for it[wp]: "\<lambda>s. P (ksIdleThread s)"
-  (wp: crunch_wps)
+crunch switchToThread
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+    (ignore: clearExMonitor)
 
 lemma switchToIdleThread_curr_is_idle:
   "\<lbrace>\<top>\<rbrace> switchToIdleThread \<lbrace>\<lambda>rv s. ksCurThread s = ksIdleThread s\<rbrace>"
@@ -1504,6 +1356,16 @@ lemma switchToIdleThread_curr_is_idle:
   apply (simp)
  done
 
+lemma chooseThread_it[wp]:
+  "\<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> chooseThread \<lbrace>\<lambda>_ s. P (ksIdleThread s)\<rbrace>"
+  supply if_split[split del]
+  by (wpsimp simp: chooseThread_def curDomain_def bitmap_fun_defs)
+
+lemma threadGet_inv [wp]: "\<lbrace>P\<rbrace> threadGet f t \<lbrace>\<lambda>rv. P\<rbrace>"
+  apply (simp add: threadGet_def)
+  apply (wp | simp)+
+  done
+
 lemma corres_split_sched_act:
   "\<lbrakk>sched_act_relation act act';
     corres r P P' f1 g1;
@@ -1525,16 +1387,28 @@ lemma corres_split_sched_act:
     apply (rule corres_guard_imp, force+)+
     done
 
+lemma corres_assert_ret:
+  "corres dc (\<lambda>s. P) \<top> (assert P) (return ())"
+  apply (rule corres_no_failI)
+   apply simp
+  apply (simp add: assert_def return_def fail_def)
+  done
+
+lemma corres_assert_assume_r:
+  "corres dc P Q f (g ())
+  \<Longrightarrow> corres dc P (Q and (\<lambda>s. Q')) f (assert Q' >>= g)"
+  by (force simp: corres_underlying_def assert_def return_def bind_def fail_def)
+
 crunch tcbSchedEnqueue
- for cur[wp]: cur_tcb'
+  for cur[wp]: cur_tcb'
   (simp: unless_def)
 
-lemma is_schedulable_exs_valid[wp]:
-  "active_sc_tcb_at t s \<Longrightarrow> \<lbrace>(=) s\<rbrace> is_schedulable t \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
-  apply (clarsimp simp: is_schedulable_def exs_valid_def Bex_def pred_map_def vs_all_heap_simps
-                 split: option.splits)
-  apply (clarsimp simp: in_monad get_tcb_ko_at obj_at_def get_sched_context_def Option.is_none_def
-                        get_object_def)
+lemma thread_get_exs_valid[wp]:
+  "tcb_at t s \<Longrightarrow> \<lbrace>(=) s\<rbrace> thread_get f t \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
+  apply (clarsimp simp: get_thread_state_def  assert_opt_def fail_def
+             thread_get_def gets_the_def exs_valid_def gets_def
+             get_def bind_def return_def split: option.splits)
+  apply (erule get_tcb_at)
   done
 
 lemma gts_exs_valid[wp]:
@@ -1550,24 +1424,17 @@ lemma guarded_switch_to_corres:
                 and valid_vspace_objs and pspace_aligned and pspace_distinct
                 and valid_vs_lookup and valid_global_objs
                 and unique_table_refs o caps_of_state
-                and schedulable t and valid_ready_qs)
-             (valid_arch_state' and valid_pspace' and Invariants_H.valid_queues
-                and st_tcb_at' runnable' t and cur_tcb')
+                and st_tcb_at runnable t and valid_etcbs and valid_queues and valid_idle)
+             (valid_arch_state' and no_0_obj' and sym_heap_sched_pointers and valid_objs')
              (guarded_switch_to t) (switchToThread t)"
   apply (simp add: guarded_switch_to_def)
   apply (rule corres_guard_imp)
-    apply (rule corres_symb_exec_l'[OF _ thread_get_exs_valid])
-      apply (rule corres_assert_opt_assume_l)
-      apply (rule corres_symb_exec_l'[OF _ is_schedulable_exs_valid])
-        apply (rule corres_assert_assume_l)
-        apply (rule switchToThread_corres)
-       apply assumption
-      apply (wpsimp wp: is_schedulable_wp)
-     apply assumption
-    apply (wpsimp wp: thread_get_wp')
-   apply (clarsimp simp: schedulable_def2 tcb_at_kh_simps pred_map_def vs_all_heap_simps
-                         obj_at_def is_tcb)
-  apply simp
+    apply (rule corres_symb_exec_l'[OF _ gts_exs_valid])
+      apply (rule corres_assert_assume_l)
+      apply (rule switchToThread_corres)
+     apply (force simp: st_tcb_at_tcb_at)
+    apply (wp gts_st_tcb_at)
+   apply (force simp: st_tcb_at_tcb_at projectKOs)+
   done
 
 abbreviation "enumPrio \<equiv> [0.e.maxPriority]"
@@ -1602,144 +1469,30 @@ lemma corres_gets_queues_getReadyQueuesL1Bitmap:
   apply (fastforce simp: bitmapL1_zero_ksReadyQueues list_queue_relation_def tcbQueueEmpty_def)
   done
 
-lemma tcb_at'_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and tcb_at t) (tcb_at' t)"
-  unfolding cross_rel_def state_relation_def
-  apply clarsimp
-  by (erule (3) tcb_at_cross)
-
-lemma sc_at'_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and sc_at t) (sc_at' t)"
-  unfolding cross_rel_def state_relation_def
-  apply clarsimp
-  by (erule (3) sc_at_cross)
-
-lemma ntfn_at'_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and ntfn_at t) (ntfn_at' t)"
-  unfolding cross_rel_def state_relation_def
-  apply clarsimp
-  by (erule (3) ntfn_at_cross)
-
-lemma runnable_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and st_tcb_at runnable t)
-             (\<lambda>s'. pred_map (\<lambda>tcb. runnable' (tcbState tcb)) (tcbs_of' s') t)"
-  apply (rule cross_rel_imp[OF tcb_at'_cross_rel[where t=t]])
-  apply (clarsimp simp: cross_rel_def)
-  apply (subgoal_tac "pspace_relation (kheap s) (ksPSpace s')")
-  apply (clarsimp simp: tcb_at_kh_simps pred_map_def cross_rel_def obj_at'_def)
-  apply (clarsimp simp: vs_all_heap_simps pspace_relation_def)
-  apply (drule_tac x=t in bspec; clarsimp)
-  apply (clarsimp simp: other_obj_relation_def split: option.splits)
-  apply (case_tac "ko"; simp)
-  apply (clarsimp simp: opt_map_def)
-  apply (clarsimp simp: tcb_relation_def thread_state_relation_def)
-  apply (case_tac "tcb_state b"; simp add: runnable_def)
-  apply clarsimp
-  apply clarsimp
-  done
-
-lemma tcbInReleaseQueue_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and tcb_at t and not_in_release_q t)
-             (\<lambda>s'. valid_release_queue' s' \<longrightarrow> pred_map (\<lambda>tcb. \<not> tcbInReleaseQueue tcb) (tcbs_of' s') t)"
-  apply (rule cross_rel_imp[OF tcb_at'_cross_rel[where t=t]])
-  apply (clarsimp simp: cross_rel_def)
-  apply (subgoal_tac "pspace_relation (kheap s) (ksPSpace s')")
-  apply (clarsimp simp: pred_map_def cross_rel_def obj_at'_def obj_at_def is_tcb)
-  apply (clarsimp simp: vs_all_heap_simps pspace_relation_def)
-  apply (drule_tac x=t in bspec; clarsimp)
-  apply (clarsimp simp: other_obj_relation_def split: option.splits)
-  apply (case_tac "koa"; simp)
-  apply (clarsimp simp: opt_map_def)
-  apply (subgoal_tac "obj_at' tcbInReleaseQueue t s'")
-  apply (subgoal_tac "release_queue_relation (release_queue s) (ksReleaseQueue s')")
-  apply (clarsimp simp: release_queue_relation_def not_in_release_q_def valid_release_queue'_def)
-  apply (clarsimp simp: state_relation_def)
-  apply (clarsimp simp: obj_at'_def projectKO_eq Bits_R.projectKO_tcb)
-  apply clarsimp
-  apply clarsimp
-  done
-
-lemma isScActive_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and valid_objs and active_sc_tcb_at t)
-             (\<lambda>s'. pred_map ((\<lambda>scPtr. isScActive scPtr s')) (tcbSCs_of s') t)"
-  apply (rule cross_rel_imp[OF tcb_at'_cross_rel[where t=t]])
-   apply (clarsimp simp: cross_rel_def)
-   apply (subgoal_tac "pspace_relation (kheap s) (ksPSpace s')")
-    apply (clarsimp simp: pred_map_def obj_at'_real_def ko_wp_at'_def vs_all_heap_simps)
-    apply (subgoal_tac "sc_at' ref' s'")
-     apply (clarsimp simp: vs_all_heap_simps pspace_relation_def)
-     apply (drule_tac x=t in bspec, clarsimp)
-     apply (clarsimp simp: other_obj_relation_def split: option.splits)
-     apply (rename_tac s s' scp ko' tcb sc n x)
-     apply (case_tac "ko'"; simp)
-     apply (subgoal_tac "pspace_relation (kheap s) (ksPSpace s')")
-      apply (clarsimp simp: vs_all_heap_simps pspace_relation_def)
-      apply (drule_tac x=scp in bspec, clarsimp)
-      apply (subgoal_tac "valid_sched_context_size n")
-       apply (clarsimp simp: other_obj_relation_def split: option.splits)
-       apply (clarsimp simp: obj_at'_def projectKO_eq Bits_R.projectKO_sc)
-       apply (clarsimp simp: opt_map_def tcb_relation_def)
-       apply (rule_tac x=scp in exI, simp)
-       apply (clarsimp simp: isScActive_def active_sc_def)
-       apply (clarsimp simp: obj_at'_def projectKO_eq Bits_R.projectKO_sc pred_map_def opt_map_def)
-       apply (clarsimp simp: sc_relation_def)
-      apply (rule_tac sc=sc in  valid_objs_valid_sched_context_size, assumption)
-      apply (fastforce)
-     apply clarsimp
-    apply (erule (2) sc_at_cross)
-    apply (clarsimp simp: obj_at_def is_sc_obj_def)
-    apply (rule_tac sc=ya in  valid_objs_valid_sched_context_size, assumption)
-    apply (fastforce)
-   apply clarsimp
-  apply (clarsimp simp: obj_at_kh_kheap_simps pred_map_def vs_all_heap_simps is_tcb)
-  done
-
-lemma isSchedulable_bool_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and valid_objs and schedulable t) (\<lambda>s'. valid_release_queue' s' \<longrightarrow> isSchedulable_bool t s')"
-  apply (rule cross_rel_imp[OF isScActive_cross_rel[where t=t]])
-   apply (rule cross_rel_imp[OF tcbInReleaseQueue_cross_rel[where t=t]])
-    apply (rule cross_rel_imp[OF runnable_cross_rel[where t=t]])
-     apply (clarsimp simp: isSchedulable_bool_def pred_map_conj[simplified pred_conj_def])
-    apply (clarsimp simp: schedulable_def2)+
-  done
-
-lemmas tcb_at'_example = corres_cross[where Q' = "tcb_at' t" for t, OF tcb_at'_cross_rel]
-
 lemma guarded_switch_to_chooseThread_fragment_corres:
   "corres dc
-    (P and schedulable t and invs and valid_ready_qs)
-    (P' and invs' and tcb_at' t)
-          (guarded_switch_to t)
-          (do schedulable \<leftarrow> isSchedulable t;
-              y \<leftarrow> assert schedulable;
-              ThreadDecls_H.switchToThread t
-           od)"
-  apply add_cur_tcb'
-  apply (rule corres_cross'[OF isSchedulable_bool_cross_rel[where t=t], rotated])
-    apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-   apply (clarsimp simp: invs'_def)
-   unfolding guarded_switch_to_def
-   apply simp
-   apply (rule corres_guard_imp)
-     apply (rule corres_symb_exec_l_Ex)
-     apply (rule corres_symb_exec_l_Ex)
-     apply (rule corres_split[OF isSchedulable_corres])
-       apply (rule corres_assert_assume_l)
-       apply (rule corres_assert_assume_r)
-       apply (rule switchToThread_corres)
-      apply (wpsimp wp: is_schedulable_wp)
-     apply (wpsimp wp: isSchedulable_wp)
-    apply (prop_tac "st_tcb_at runnable t s \<and> bound_sc_tcb_at bound t s")
-     apply (clarsimp simp: schedulable_def2 tcb_at_kh_simps pred_map_def vs_all_heap_simps)
-    apply (clarsimp simp: st_tcb_at_tcb_at invs_def valid_state_def valid_pspace_def valid_sched_def
+    (P and st_tcb_at runnable t and invs and valid_sched)
+    (P' and invs_no_cicd')
+    (guarded_switch_to t)
+    (do runnable \<leftarrow> isRunnable t;
+        y \<leftarrow> assert runnable;
+        ThreadDecls_H.switchToThread t
+     od)"
+  apply (rule_tac Q'="st_tcb_at' runnable' t" in corres_cross_add_guard)
+   apply (fastforce intro!: st_tcb_at_runnable_cross simp: obj_at_def is_tcb_def)
+  unfolding guarded_switch_to_def isRunnable_def
+  apply simp
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF getThreadState_corres])
+      apply (rule corres_assert_assume_l)
+      apply (rule corres_assert_assume_r)
+      apply (rule switchToThread_corres)
+     apply (wp gts_st_tcb_at)+
+   apply (clarsimp simp: st_tcb_at_tcb_at invs_def valid_state_def valid_pspace_def valid_sched_def
                           invs_valid_vs_lookup invs_unique_refs)
-    apply (clarsimp simp: thread_get_def in_monad pred_tcb_at_def obj_at_def get_tcb_ko_at)
-   apply (prop_tac "st_tcb_at' runnable' t s")
-    apply (clarsimp simp: pred_tcb_at'_def isSchedulable_bool_def pred_map_def obj_at'_def
-                          projectKO_eq
-                   elim!: opt_mapE)
-   apply fastforce
-  by (auto simp: invs'_def)
+  apply (auto elim!: pred_tcb'_weakenE split: thread_state.splits
+              simp: pred_tcb_at' runnable'_def all_invs_but_ct_idle_or_in_cur_domain'_def)
+  done
 
 lemma Max_prio_helper:
   "ready_queues_relation s s'
@@ -1760,28 +1513,31 @@ lemma Max_prio_helper:
 lemma bitmap_lookup_queue_is_max_non_empty:
   "\<lbrakk> valid_bitmaps s'; (s, s') \<in> state_relation; invs s;
      ksReadyQueuesL1Bitmap s' (ksCurDomain s') \<noteq> 0 \<rbrakk>
-   \<Longrightarrow> ksReadyQueues s' (ksCurDomain s', lookupBitmapPriority (ksCurDomain s') s') =
-        max_non_empty_queue (ready_queues s (cur_domain s))"
-  unfolding valid_queues_def
-  by (clarsimp simp add: max_non_empty_queue_def lookupBitmapPriority_Max_eqI
-                         state_relation_def ready_queues_relation_def)
+   \<Longrightarrow> the (tcbQueueHead (ksReadyQueues s' (ksCurDomain s', lookupBitmapPriority (ksCurDomain s') s')))
+       = hd (max_non_empty_queue (ready_queues s (cur_domain s)))"
+  apply (clarsimp simp: max_non_empty_queue_def valid_bitmaps_def lookupBitmapPriority_Max_eqI)
+  apply (frule curdomain_relation)
+  apply (drule state_relation_ready_queues_relation)
+  apply (simp add: Max_prio_helper)
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def
+                        list_queue_relation_def)
+  apply (frule (2) bitmapL1_zero_ksReadyQueues[THEN arg_cong_Not, THEN iffD1])
+  apply clarsimp
+  apply (cut_tac P="\<lambda>x. \<not> tcbQueueEmpty (ksReadyQueues s' (ksCurDomain s', x))"
+              in setcomp_Max_has_prop)
+   apply fastforce
+  apply (clarsimp simp: ready_queues_relation_def Let_def list_queue_relation_def tcbQueueEmpty_def)
+  apply (drule_tac x="ksCurDomain s'" in spec)
+  apply (drule_tac x="Max {prio. \<not> tcbQueueEmpty (ksReadyQueues s' (ksCurDomain s', prio))}"
+                in spec)
+  using heap_path_head tcbQueueEmpty_def
+  by fastforce
 
 lemma ksReadyQueuesL1Bitmap_return_wp:
   "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s d) s \<rbrace> getReadyQueuesL1Bitmap d \<lbrace>\<lambda>rv s. P rv s\<rbrace>"
   unfolding getReadyQueuesL1Bitmap_def
   by wp
 
-lemma ksReadyQueuesL1Bitmap_st_tcb_at':
-  "\<lbrakk> ksReadyQueuesL1Bitmap s (ksCurDomain s) \<noteq> 0; valid_queues s;
-    (\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). st_tcb_at' runnable' t s))\<rbrakk>
-   \<Longrightarrow> st_tcb_at' runnable' (hd (ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s))) s"
-  apply (drule bitmapQ_from_bitmap_lookup; clarsimp simp: valid_queues_def)
-  apply (clarsimp simp add: valid_bitmapQ_bitmapQ_simp)
-  apply (case_tac "ksReadyQueues s (ksCurDomain s, lookupBitmapPriority (ksCurDomain s) s)")
-   apply simp
-  apply (fastforce intro: cons_set_intro)
-  done
-
 lemma curDomain_or_return_0:
   "\<lbrakk> \<lbrace>P\<rbrace> curDomain \<lbrace>\<lambda>rv s. Q rv s \<rbrace>; \<And>s. P s \<Longrightarrow> ksCurDomain s \<le> maxDomain \<rbrakk>
    \<Longrightarrow> \<lbrace>P\<rbrace> if 1 < numDomains then curDomain else return 0 \<lbrace>\<lambda>rv s. Q rv s \<rbrace>"
@@ -1789,59 +1545,74 @@ lemma curDomain_or_return_0:
   apply (simp add: valid_def curDomain_def simpler_gets_def return_def maxDomain_def)
   done
 
+lemma invs_no_cicd_ksCurDomain_maxDomain':
+  "invs_no_cicd' s \<Longrightarrow> ksCurDomain s \<le> maxDomain"
+  unfolding invs_no_cicd'_def by simp
+
 lemma chooseThread_corres:
-  "corres dc (invs and valid_ready_qs and ready_or_release) invs'
-     choose_thread chooseThread" (is "corres _ ?PREI ?PREH _ _")
-  apply add_ready_qs_runnable
-  unfolding choose_thread_def chooseThread_def
-  apply (rule corres_stateAssert_add_assertion[rotated])
-   apply (clarsimp simp: ready_qs_runnable_def)
-  apply (simp only: return_bind Let_def K_bind_def)
-  apply (subst if_swap[where P="_ \<noteq> 0"]) (* put switchToIdleThread on first branch*)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF curDomain_corres'])
-      apply clarsimp
-      apply (rule corres_split[OF corres_gets_queues_getReadyQueuesL1Bitmap])
-        apply (erule corres_if2[OF sym])
-         apply (rule switchToIdleThread_corres)
-        apply (rule corres_symb_exec_r)
-           apply (rule corres_symb_exec_r)
-              apply (rule_tac
-                       P="\<lambda>s. ?PREI s \<and> queues = ready_queues s (cur_domain s) \<and>
-                              schedulable (hd (max_non_empty_queue queues)) s" and
-                       P'="\<lambda>s. (?PREH s ) \<and> st_tcb_at' runnable' (hd queue) s \<and>
-                               l1 = ksReadyQueuesL1Bitmap s (ksCurDomain s) \<and>
-                               l1 \<noteq> 0 \<and>
-                               queue = ksReadyQueues s (ksCurDomain s,
-                                         lookupBitmapPriority (ksCurDomain s) s)" and
-                       F="hd queue = hd (max_non_empty_queue queues)" in corres_req)
-               apply (fastforce simp: bitmap_lookup_queue_is_max_non_empty invs'_def)
-              apply clarsimp
-              apply (rule corres_guard_imp)
-                apply (rule_tac P=\<top> and P'=\<top> in guarded_switch_to_chooseThread_fragment_corres)
-               apply (wp | clarsimp simp: getQueue_def getReadyQueuesL2Bitmap_def)+
-      apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift ksReadyQueuesL1Bitmap_return_wp)
-     apply (wpsimp wp: curDomain_or_return_0)+
-    apply (fastforce simp: invs_ksCurDomain_maxDomain')
-   apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_ready_qs_def max_non_empty_queue_def)
-   apply (erule_tac x="cur_domain s" in allE)
-   apply (erule_tac x="Max {prio. ready_queues s (cur_domain s) prio \<noteq> []}" in allE)
-   apply (case_tac "ready_queues s (cur_domain s) (Max {prio. ready_queues s (cur_domain s) prio \<noteq> []})")
-    apply (clarsimp)
-    apply (subgoal_tac
-             "ready_queues s (cur_domain s) (Max {prio. ready_queues s (cur_domain s) prio \<noteq> []}) \<noteq> []")
-     apply (fastforce elim!: setcomp_Max_has_prop)
-    apply (fastforce elim!: setcomp_Max_has_prop)
-   apply (clarsimp simp: tcb_at_kh_simps schedulable_def2 released_sc_tcb_at_def)
-   apply (subgoal_tac "in_ready_q a s", fastforce simp: ready_or_release_def)
-   apply (clarsimp simp: in_ready_q_def)
-    apply (rule_tac x="cur_domain s" in exI)
-    apply (rule_tac x="Max {prio. ready_queues s (cur_domain s) prio \<noteq> []}" in exI)
+  "corres dc (invs and valid_sched) invs_no_cicd' choose_thread chooseThread"
+  (is "corres _ ?PREI ?PREH _ _")
+proof -
+
+  (* if we only have one domain, we are in it *)
+  have one_domain_case:
+    "\<And>s. \<lbrakk> invs_no_cicd' s; numDomains \<le> 1 \<rbrakk> \<Longrightarrow> ksCurDomain s = 0"
+    by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def maxDomain_def)
+
+  show ?thesis
+    supply if_split[split del]
+    apply (clarsimp simp: choose_thread_def chooseThread_def)
+    apply add_ready_qs_runnable
+    apply (rule corres_stateAssert_add_assertion[rotated])
+     apply (fastforce intro: ksReadyQueues_asrt_cross)
+    apply (rule corres_stateAssert_add_assertion[rotated])
+     apply fastforce
+    apply (simp only: return_bind Let_def)
+    apply (subst if_swap[where P="_ \<noteq> 0"]) (* put switchToIdleThread on first branch*)
+    apply (rule corres_guard_imp)
+      apply (rule corres_split[OF curDomain_corres'])
+        apply clarsimp
+        apply (rule corres_split[OF corres_gets_queues_getReadyQueuesL1Bitmap])
+          apply (erule corres_if2[OF sym])
+           apply (rule switchToIdleThread_corres)
+          apply (rule corres_symb_exec_r)
+             apply (rule corres_symb_exec_r)
+                apply (rule_tac P="\<lambda>s. ?PREI s \<and> queues = ready_queues s (cur_domain s)
+                                       \<and> st_tcb_at runnable (hd (max_non_empty_queue queues)) s"
+                            and P'="\<lambda>s. ?PREH s \<and> l1 = ksReadyQueuesL1Bitmap s (ksCurDomain s)
+                                        \<and> l1 \<noteq> 0
+                                        \<and> queue = ksReadyQueues s (ksCurDomain s,
+                                                                   lookupBitmapPriority (ksCurDomain s) s)"
+                            and F="the (tcbQueueHead queue) = hd (max_non_empty_queue queues)"
+                             in corres_req)
+                 apply (fastforce simp: bitmap_lookup_queue_is_max_non_empty
+                                        all_invs_but_ct_idle_or_in_cur_domain'_def)
+                apply clarsimp
+                apply (rule corres_guard_imp)
+                  apply (rule_tac P=\<top> and P'=\<top> in guarded_switch_to_chooseThread_fragment_corres)
+                 apply (wpsimp simp: getQueue_def getReadyQueuesL2Bitmap_def)+
+        apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift ksReadyQueuesL1Bitmap_return_wp)
+       apply (wpsimp wp: curDomain_or_return_0 simp: curDomain_def)+
+     apply (clarsimp simp: valid_sched_def max_non_empty_queue_def valid_queues_def split: if_splits)
+     apply (erule_tac x="cur_domain s" in allE)
+     apply (erule_tac x="Max {prio. ready_queues s (cur_domain s) prio \<noteq> []}" in allE)
+     apply (case_tac "ready_queues s (cur_domain s)
+                                     (Max {prio. ready_queues s (cur_domain s) prio
+                      \<noteq> []})")
+      apply (clarsimp)
+      apply (subgoal_tac "ready_queues s (cur_domain s)
+                                         (Max {prio. ready_queues s (cur_domain s) prio \<noteq> []})
+                          \<noteq> []")
+       apply fastforce
+      apply (fastforce elim!: setcomp_Max_has_prop)
+     apply fastforce
     apply clarsimp
-  apply (simp add: invs_ksCurDomain_maxDomain')
-  apply (clarsimp simp: ready_qs_runnable_def)
-  apply (fastforce intro: ksReadyQueuesL1Bitmap_st_tcb_at')
-  done
+    apply (frule invs_no_cicd_ksCurDomain_maxDomain')
+    apply (prop_tac "valid_bitmaps s")
+     apply (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def)
+    apply (fastforce dest: one_domain_case split: if_splits)
+    done
+qed
 
 lemma thread_get_comm: "do x \<leftarrow> thread_get f p; y \<leftarrow> gets g; k x y od =
            do y \<leftarrow> gets g; x \<leftarrow> thread_get f p; k x y od"
@@ -1861,49 +1632,38 @@ 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 \<mu>s_in_ms_equiv:
-  "\<mu>s_in_ms = usInMs"
-  by (simp add: usInMs_def \<mu>s_in_ms_def)
-
-lemma us_to_ticks_equiv:
-  "us_to_ticks = usToTicks"
-  by (simp add: usToTicks_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 (clarsimp simp: next_domain_def nextDomain_def reset_work_units_equiv modify_modify)
+  apply (simp add: next_domain_def nextDomain_def)
   apply (rule corres_modify)
-  apply (simp add: state_relation_def Let_def dschLength_def dschDomain_def cdt_relation_def
-                   \<mu>s_in_ms_equiv us_to_ticks_equiv)
+  apply (simp add: state_relation_def Let_def dschLength_def dschDomain_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 (fastforce simp: valid_blocked_defs)
+  apply (simp add:valid_blocked_2_def)
   done
 
-lemma nextDomain_invs':
-  "nextDomain \<lbrace>invs'\<rbrace>"
-  apply (simp add: nextDomain_def Let_def dschLength_def)
+lemma nextDomain_invs_no_cicd':
+  "\<lbrace> invs' and (\<lambda>s. ksSchedulerAction s = ChooseNewThread)\<rbrace> nextDomain \<lbrace> \<lambda>_. invs_no_cicd' \<rbrace>"
+  apply (simp add: nextDomain_def Let_def dschLength_def dschDomain_def)
   apply wp
-  apply (clarsimp simp: invs'_def valid_machine_state'_def dschDomain_def valid_dom_schedule'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_machine_state'_def
+                        ct_not_inQ_def cur_tcb'_def ct_idle_or_in_cur_domain'_def dschDomain_def
+                        all_invs_but_ct_idle_or_in_cur_domain'_def)
   done
 
 lemma scheduleChooseNewThread_fragment_corres:
-  "corres dc (invs and valid_ready_qs and ready_or_release
-              and (\<lambda>s. scheduler_action s = choose_new_thread))
-             (invs' and (\<lambda>s. ksSchedulerAction s = ChooseNewThread))
+  "corres dc (invs and valid_sched and (\<lambda>s. scheduler_action s = choose_new_thread)) (invs' and (\<lambda>s. ksSchedulerAction s = ChooseNewThread))
      (do _ \<leftarrow> when (domainTime = 0) next_domain;
          choose_thread
       od)
@@ -1913,18 +1673,18 @@ lemma scheduleChooseNewThread_fragment_corres:
   apply (subst bind_dummy_ret_val)
   apply (subst bind_dummy_ret_val)
   apply (rule corres_guard_imp)
-    apply (rule corres_split[OF corres_when])
-        apply simp
+    apply (rule corres_split)
+       apply (rule corres_when, simp)
        apply (rule nextDomain_corres)
       apply simp
       apply (rule chooseThread_corres)
-     apply (wp nextDomain_invs')+
-   apply (clarsimp simp: valid_sched_def invs'_def)+
+     apply (wp nextDomain_invs_no_cicd')+
+   apply (clarsimp simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def)+
   done
 
 lemma scheduleSwitchThreadFastfail_corres:
   "\<lbrakk> ct \<noteq> it \<longrightarrow> (tp = tp' \<and> cp = cp') ; ct = ct' ; it = it' \<rbrakk> \<Longrightarrow>
-   corres ((=)) (tcb_at ct) (tcb_at' ct)
+   corres ((=)) (is_etcb_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)
@@ -1963,23 +1723,26 @@ 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
+  for inv[wp]: P
 crunch curDomain
- for inv[wp]: P
+  for inv[wp]: P
+crunch schedule_switch_thread_fastfail
+  for inv[wp]: P
 crunch scheduleSwitchThreadFastfail
- for inv[wp]: P
+  for inv[wp]: P
 
 lemma setSchedulerAction_invs': (* not in wp set, clobbered by ssa_wp *)
-  "\<lbrace>\<lambda>s. invs' s \<rbrace> setSchedulerAction ChooseNewThread \<lbrace>\<lambda>_. invs' \<rbrace>"
-  by (wpsimp simp: invs'_def cur_tcb'_def valid_irq_node'_def ct_not_inQ_def
-                   valid_queues_def valid_release_queue_def valid_release_queue'_def
-                   valid_queues_no_bitmap_def valid_queues'_def ct_idle_or_in_cur_domain'_def
-                   valid_dom_schedule'_def)
+  "setSchedulerAction ChooseNewThread \<lbrace>invs' \<rbrace>"
+  by (wpsimp simp: invs'_def cur_tcb'_def valid_state'_def valid_irq_node'_def ct_not_inQ_def
+                   ct_idle_or_in_cur_domain'_def)
 
 lemma scheduleChooseNewThread_corres:
   "corres dc
-    (\<lambda>s. invs s \<and> valid_ready_qs s \<and> ready_or_release s \<and> scheduler_action s = choose_new_thread)
+    (\<lambda>s. invs s \<and> valid_sched s \<and> scheduler_action s = choose_new_thread)
     (\<lambda>s. invs' s \<and> ksSchedulerAction s = ChooseNewThread)
            schedule_choose_new_thread scheduleChooseNewThread"
   unfolding schedule_choose_new_thread_def scheduleChooseNewThread_def
@@ -1989,17 +1752,239 @@ lemma scheduleChooseNewThread_corres:
         apply (rule setSchedulerAction_corres)
         apply (wp | simp)+
     apply (wp | simp add: getDomainTime_def)+
+   apply auto
+  done
+
+crunch guarded_switch_to
+  for static_inv[wp]: "\<lambda>_. P"
+
+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)
+  apply (rule conjI; clarsimp)
+  apply (rule corres_guard_imp, rule ethreadget_corres; simp add: x)
+  apply (clarsimp simp: threadGet_def)
+  apply (rule corres_noop)
+  apply wpsimp+
+  done
+
+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)
   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)
+  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)
+  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)
+  done
+
+crunch set_scheduler_action
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  (wp: crunch_wps simp: in_correct_ready_q_def ready_qs_distinct_def)
+
+crunch reschedule_required
+  for in_correct_ready_q[wp]: in_correct_ready_q
+  and ready_qs_distinct[wp]: ready_qs_distinct
+  (ignore: tcb_sched_action wp: crunch_wps ignore_del: reschedule_required)
+
+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 tcbSchedEnqueue_invs'[wp del]
+  supply tcbSchedEnqueue_invs'_not_ResumeCurrentThread[wp del]
+  supply setSchedulerAction_direct[wp]
+  supply if_split[split del]
+
+  apply (clarsimp simp: Schedule_A.schedule_def Thread_H.schedule_def)
+  apply (subst thread_get_test)
+  apply (subst thread_get_comm)
+  apply (subst schact_bind_inside)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF getCurThread_corres[THEN corres_rel_imp[where r="\<lambda>x y. y = x"],simplified]])
+      apply (rule corres_split[OF getSchedulerAction_corres])
+        apply (rule corres_split_sched_act,assumption)
+          apply (rule_tac P="tcb_at ct" in corres_symb_exec_l')
+            apply (rule_tac corres_symb_exec_l)
+               apply simp
+               apply (rule corres_assert_ret)
+              apply ((wpsimp wp: thread_get_wp' gets_exs_valid)+)
+         prefer 2
+         (* choose thread *)
+         apply clarsimp
+         apply (rule corres_split[OF thread_get_isRunnable_corres])
+           apply (rule corres_split)
+              apply (rule corres_when, simp)
+              apply (rule tcbSchedEnqueue_corres, simp)
+             apply (rule scheduleChooseNewThread_corres, simp)
+            apply (wp thread_get_wp' tcbSchedEnqueue_invs' hoare_vcg_conj_lift hoare_drop_imps
+                   | clarsimp)+
+        (* switch to thread *)
+        apply (rule corres_split[OF thread_get_isRunnable_corres],
+                rename_tac was_running wasRunning)
+          apply (rule corres_split)
+             apply (rule corres_when, simp)
+             apply (rule tcbSchedEnqueue_corres, simp)
+            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 (rename_tac tp tp')
+                apply (rule corres_split)
+                   apply (rule ethread_get_when_corres[where r="(=)"])
+                   apply (clarsimp simp: etcb_relation_def)
+                  apply (rename_tac cp cp')
+                  apply (rule corres_split)
+                     apply (rule scheduleSwitchThreadFastfail_corres; simp)
+                    apply (rule corres_split[OF curDomain_corres])
+                      apply (rule corres_split[OF isHighestPrio_corres]; simp only:)
+                        apply (rule corres_if, simp)
+                         apply (rule corres_split[OF tcbSchedEnqueue_corres], simp)
+                           apply (simp, fold dc_def)
+                           apply (rule corres_split)
+                              apply (rule setSchedulerAction_corres; simp)
+                             apply (rule scheduleChooseNewThread_corres)
+                            apply (wp | simp)+
+                            apply (simp add: valid_sched_def)
+                            apply wp
+                            apply (rule hoare_vcg_conj_lift)
+                             apply (rule_tac t=t in set_scheduler_action_cnt_valid_blocked')
+                            apply (wpsimp wp: setSchedulerAction_invs')+
+                          apply (wp tcb_sched_action_enqueue_valid_blocked hoare_vcg_all_lift enqueue_thread_queued)
+                         apply (wp tcbSchedEnqueue_invs'_not_ResumeCurrentThread)
+                        apply (rule corres_if, fastforce)
+                         apply (rule corres_split[OF tcbSchedAppend_corres], simp)
+                           apply (simp, fold dc_def)
+                           apply (rule corres_split)
+                              apply (rule setSchedulerAction_corres; simp)
+                             apply (rule scheduleChooseNewThread_corres)
+                            apply (wp | simp)+
+                            apply (simp add: valid_sched_def)
+                            apply wp
+                            apply (rule hoare_vcg_conj_lift)
+                             apply (rule_tac t=t in set_scheduler_action_cnt_valid_blocked')
+                            apply (wpsimp wp: setSchedulerAction_invs')+
+                          apply (wp tcb_sched_action_append_valid_blocked hoare_vcg_all_lift append_thread_queued)
+                         apply (wp tcbSchedAppend_invs'_not_ResumeCurrentThread)
+
+                        apply (rule corres_split[OF guarded_switch_to_corres], simp)
+                          apply (rule setSchedulerAction_corres[simplified dc_def])
+                          apply (wp | simp)+
+
+                      (* isHighestPrio *)
+                      apply (clarsimp simp: if_apply_def2)
+                      apply ((wp (once) hoare_drop_imp)+)[1]
+
+                     apply (simp add: if_apply_def2)
+                     apply ((wp (once) hoare_drop_imp)+)[1]
+                    apply wpsimp+
+
+           apply (clarsimp simp: conj_ac cong: conj_cong)
+           apply wp
+           apply (rule_tac Q'="\<lambda>_ s. valid_blocked_except t s \<and> scheduler_action s = switch_thread t"
+                    in hoare_post_imp, fastforce)
+           apply (wp add: tcb_sched_action_enqueue_valid_blocked_except
+                          tcbSchedEnqueue_invs'_not_ResumeCurrentThread thread_get_wp
+                     del: gets_wp
+                  | strengthen valid_objs'_valid_tcbs')+
+       apply (clarsimp simp: conj_ac if_apply_def2 cong: imp_cong conj_cong)
+       apply (wp gets_wp)+
+
+   (* abstract final subgoal *)
+   apply clarsimp
+
+   subgoal for s
+     apply (clarsimp split: Deterministic_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)
+      apply (fastforce simp: invs_def
+                            valid_sched_def valid_sched_action_def is_activatable_def
+                            st_tcb_at_def obj_at_def valid_state_def only_idle_def
+                            )
+     apply (rule conjI, clarsimp)
+      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]]
+                               valid_blocked_except_def valid_blocked_def)
+        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
+                              valid_sched_def  st_tcb_at_def obj_at_def valid_state_def
+                              weak_valid_sched_action_def not_cur_thread_def)+
+     done
+
+  (* haskell final subgoal *)
+  apply (clarsimp simp: if_apply_def2 invs'_def valid_state'_def valid_sched_def
+                  cong: imp_cong  split: scheduler_action.splits)
+  apply (fastforce simp: cur_tcb'_def valid_pspace'_def)
+  done
+
+lemma ssa_all_invs_but_ct_not_inQ':
+  "\<lbrace>all_invs_but_ct_not_inQ' and sch_act_wf sa and
+   (\<lambda>s. sa = ResumeCurrentThread \<longrightarrow> ksCurThread s = ksIdleThread s \<or> tcb_in_cur_domain' (ksCurThread s) s)\<rbrace>
+   setSchedulerAction sa \<lbrace>\<lambda>rv. all_invs_but_ct_not_inQ'\<rbrace>"
+proof -
+  show ?thesis
+    apply (simp add: setSchedulerAction_def)
+    apply wp
+    apply (clarsimp simp add: invs'_def valid_state'_def cur_tcb'_def
+                              state_refs_of'_def ps_clear_def valid_irq_node'_def
+                              tcb_in_cur_domain'_def ct_idle_or_in_cur_domain'_def bitmapQ_defs
+                        cong: option.case_cong)
+    done
+qed
+
 lemma ssa_ct_not_inQ:
   "\<lbrace>\<lambda>s. sa = ResumeCurrentThread \<longrightarrow> obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>
    setSchedulerAction sa \<lbrace>\<lambda>rv. ct_not_inQ\<rbrace>"
   by (simp add: setSchedulerAction_def ct_not_inQ_def, wp, clarsimp)
 
+lemma ssa_all_invs_but_ct_not_inQ''[simplified]:
+  "\<lbrace>\<lambda>s. (all_invs_but_ct_not_inQ' s \<and> sch_act_wf sa s)
+    \<and> (sa = ResumeCurrentThread \<longrightarrow> ksCurThread s = ksIdleThread s \<or> tcb_in_cur_domain' (ksCurThread s) s)
+    \<and> (sa = ResumeCurrentThread \<longrightarrow> obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s)\<rbrace>
+   setSchedulerAction sa \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp only: all_invs_but_not_ct_inQ_check' [symmetric])
+  apply (rule hoare_elim_pred_conj)
+  apply (wp hoare_vcg_conj_lift [OF ssa_all_invs_but_ct_not_inQ' ssa_ct_not_inQ])
+  apply (clarsimp)
+  done
+
 lemma ssa_invs':
-  "setSchedulerAction sa \<lbrace>invs'\<rbrace>"
-  apply (wp ssa_ct_not_inQ)
-  apply (clarsimp simp: invs'_def valid_irq_node'_def valid_dom_schedule'_def)
+  "\<lbrace>invs' and sch_act_wf sa and
+    (\<lambda>s. sa = ResumeCurrentThread \<longrightarrow> ksCurThread s = ksIdleThread s \<or> tcb_in_cur_domain' (ksCurThread s) s) and
+    (\<lambda>s. sa = ResumeCurrentThread \<longrightarrow> obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s)\<rbrace>
+   setSchedulerAction sa \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (wp ssa_all_invs_but_ct_not_inQ'')
+  apply (clarsimp simp add: invs'_def valid_state'_def)
   done
 
 lemma getDomainTime_wp[wp]: "\<lbrace>\<lambda>s. P (ksDomainTime s) s \<rbrace> getDomainTime \<lbrace> P \<rbrace>"
@@ -2007,12 +1992,12 @@ lemma getDomainTime_wp[wp]: "\<lbrace>\<lambda>s. P (ksDomainTime s) s \<rbrace>
   by wp
 
 lemma switchToThread_ct_not_queued_2:
-  "\<lbrace>invs' and tcb_at' t\<rbrace> switchToThread t \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>"
+  "\<lbrace>invs_no_cicd' and tcb_at' t\<rbrace> switchToThread t \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>"
   (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
   apply (simp add: Thread_H.switchToThread_def)
-  apply wp
+  apply (wp)
     apply (simp add: ARM_H.switchToThread_def setCurThread_def)
-    apply (wpsimp wp: tcbSchedDequeue_not_tcbQueued hoare_drop_imps)+
+    apply (wp tcbSchedDequeue_not_tcbQueued hoare_drop_imp | simp )+
   done
 
 lemma setCurThread_obj_at':
@@ -2025,982 +2010,177 @@ proof -
     done
 qed
 
-lemma switchToIdleThread_ct_not_queued:
-  "\<lbrace> invs' \<rbrace> switchToIdleThread \<lbrace>\<lambda>_ s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<rbrace>"
+lemma switchToIdleThread_ct_not_queued_no_cicd':
+  "\<lbrace>invs_no_cicd'\<rbrace> switchToIdleThread \<lbrace>\<lambda>_ s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<rbrace>"
   apply (simp add: Thread_H.switchToIdleThread_def)
   apply (wp setCurThread_obj_at')
-  apply (intro impI)
-  apply (rule idle'_not_tcbQueued')
-     apply (simp add: ready_qs_runnable_def invs'_def valid_idle'_asrt_def)+
+  apply (clarsimp simp: ready_qs_runnable_def)
+  apply (drule_tac x="ksIdleThread s" in spec)
+  apply (clarsimp simp: invs_no_cicd'_def valid_idle'_def st_tcb_at'_def idle_tcb'_def obj_at'_def)
   done
 
 lemma switchToIdleThread_activatable_2[wp]:
-  "\<lbrace>invs'\<rbrace> switchToIdleThread \<lbrace>\<lambda>_. ct_in_state' activatable'\<rbrace>"
+  "\<lbrace>invs_no_cicd'\<rbrace> switchToIdleThread \<lbrace>\<lambda>rv. ct_in_state' activatable'\<rbrace>"
   apply (simp add: Thread_H.switchToIdleThread_def
                    ARM_H.switchToIdleThread_def)
   apply (wp setCurThread_ct_in_state)
-  apply (clarsimp simp: invs'_def valid_idle'_def valid_idle'_asrt_def
+  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def valid_idle'_def
                         pred_tcb_at'_def obj_at'_def idle_tcb'_def)
   done
 
 lemma switchToThread_tcb_in_cur_domain':
   "\<lbrace>tcb_in_cur_domain' thread\<rbrace>
    ThreadDecls_H.switchToThread thread
-   \<lbrace>\<lambda>_ s. tcb_in_cur_domain' (ksCurThread s) s\<rbrace>"
+   \<lbrace>\<lambda>y s. tcb_in_cur_domain' (ksCurThread s) s\<rbrace>"
   apply (simp add: Thread_H.switchToThread_def setCurThread_def)
-  apply (wpsimp wp: tcbSchedDequeue_not_tcbQueued tcbSchedDequeue_tcbDomain
-                    hoare_drop_imps)
+  apply (wpsimp wp: tcbSchedDequeue_not_tcbQueued hoare_drop_imps)
   done
 
-lemma chooseThread_invs'_posts: (* generic version *)
-  "\<lbrace> invs' \<rbrace> chooseThread
+lemma chooseThread_invs_no_cicd'_posts: (* generic version *)
+  "\<lbrace> invs_no_cicd' \<rbrace> chooseThread
    \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<and>
            ct_in_state' activatable' s \<and>
            (ksCurThread s = ksIdleThread s \<or> tcb_in_cur_domain' (ksCurThread s) s) \<rbrace>"
-  unfolding chooseThread_def Let_def
-  apply (simp only: return_bind, simp split del: if_split)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[where Q'="\<lambda>rv s. invs' s \<and> rv = ksCurDomain s \<and> ready_qs_runnable s"])
-   apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> curdom = ksCurDomain s \<and>
-                             rv = ksReadyQueuesL1Bitmap s curdom \<and> ready_qs_runnable s"
-                in bind_wp)
-    apply (rename_tac l1)
-    apply (case_tac "l1 = 0")
-     (* switch to idle thread *)
-     apply simp
-     apply (rule hoare_pre)
-      apply (wp (once) switchToIdleThread_ct_not_queued)
-      apply (wp (once))
-      apply ((wp hoare_disjI1 switchToIdleThread_curr_is_idle)+)[1]
-       apply simp
+    (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
+proof -
+  note switchToThread_invs[wp del]
+  note switchToThread_invs_no_cicd'[wp del]
+  note switchToThread_lookupBitmapPriority_wp[wp]
+  note assert_wp[wp del]
+  note if_split[split del]
+
+  (* if we only have one domain, we are in it *)
+  have one_domain_case:
+    "\<And>s. \<lbrakk> invs_no_cicd' s; numDomains \<le> 1 \<rbrakk> \<Longrightarrow> ksCurDomain s = 0"
+    by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def maxDomain_def)
+
+  show ?thesis
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule bind_wp[OF _ stateAssert_sp])+
+    apply (simp only: return_bind, simp)
+    apply (rule bind_wp[where Q'="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
+     apply (rule_tac Q'="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
+                                rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                                ksReadyQueues_asrt s \<and> ready_qs_runnable s" in bind_wp)
+      apply (rename_tac l1)
+      apply (case_tac "l1 = 0")
+       (* switch to idle thread *)
+       apply simp
+       apply (rule hoare_pre)
+        apply (wp (once) switchToIdleThread_ct_not_queued_no_cicd')
+        apply (wp (once))
+        apply ((wp hoare_disjI1 switchToIdleThread_curr_is_idle)+)[1]
+       apply simp
       (* we have a thread to switch to *)
-    apply (clarsimp simp: bitmap_fun_defs)
-    apply (wp assert_inv switchToThread_ct_not_queued_2 assert_inv hoare_disjI2
-              switchToThread_tcb_in_cur_domain' isSchedulable_wp)
-    apply clarsimp
-    apply (clarsimp simp: valid_queues_def lookupBitmapPriority_def[symmetric]
-                          ready_qs_runnable_def invs'_def)
-    apply (drule (3) lookupBitmapPriority_obj_at')
-    apply normalise_obj_at'
-    apply (fastforce simp: tcb_in_cur_domain'_def inQ_def elim: obj_at'_weaken)
-   apply (wpsimp simp: bitmap_fun_defs)
-  apply (wpsimp wp: curDomain_or_return_0[simplified] simp: invs_ksCurDomain_maxDomain')
-  done
+      apply (clarsimp simp: bitmap_fun_defs)
+      apply (wp assert_inv switchToThread_ct_not_queued_2 assert_inv hoare_disjI2
+                switchToThread_tcb_in_cur_domain')
+      apply (clarsimp simp:  all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def
+                             valid_bitmaps_def)
+      apply (frule (6) lookupBitmapPriority_obj_at')
+      apply (clarsimp simp: tcb_in_cur_domain'_def obj_at'_def tcbQueueEmpty_def inQ_def)
+     apply (wpsimp simp: bitmap_fun_defs curDomain_def one_domain_case)+
+    done
+qed
 
 lemma chooseThread_activatable_2:
-  "\<lbrace>invs'\<rbrace> chooseThread \<lbrace>\<lambda>_. ct_in_state' activatable'\<rbrace>"
+  "\<lbrace>invs_no_cicd'\<rbrace> chooseThread \<lbrace>\<lambda>rv. ct_in_state' activatable'\<rbrace>"
   apply (rule hoare_pre, rule hoare_strengthen_post)
-    apply (rule chooseThread_invs'_posts)
+    apply (rule chooseThread_invs_no_cicd'_posts)
    apply simp+
   done
 
 lemma chooseThread_ct_not_queued_2:
-  "\<lbrace> invs' \<rbrace> chooseThread \<lbrace>\<lambda>_ s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>"
+  "\<lbrace> invs_no_cicd'\<rbrace> chooseThread \<lbrace>\<lambda>rv s. obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s\<rbrace>"
     (is "\<lbrace>_\<rbrace> _ \<lbrace>\<lambda>_. ?POST\<rbrace>")
   apply (rule hoare_pre, rule hoare_strengthen_post)
-    apply (rule chooseThread_invs'_posts)
+    apply (rule chooseThread_invs_no_cicd'_posts)
    apply simp+
   done
 
-lemma chooseThread_invs'':
-  "chooseThread \<lbrace>invs'\<rbrace>"
-  unfolding chooseThread_def Let_def
-  apply (simp only: return_bind, simp split del: if_split)
-  apply (rule bind_wp[OF _ stateAssert_sp])
-  apply (rule bind_wp[where Q'="\<lambda>rv s. invs' s \<and> rv = ksCurDomain s \<and> ready_qs_runnable s"])
-   apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> curdom = ksCurDomain s \<and>
-                             rv = ksReadyQueuesL1Bitmap s curdom \<and> ready_qs_runnable s"
-                in bind_wp)
-    apply (rename_tac l1)
-    apply (case_tac "l1 = 0")
-     (* switch to idle thread *)
-     apply (simp, wp switchToIdleThread_invs', simp)
-    (* we have a thread to switch to *)
-    apply (clarsimp simp: bitmap_fun_defs)
-    apply (wp assert_inv isSchedulable_wp)
-    apply (clarsimp simp: valid_queues_def invs'_def)
-   apply (wpsimp simp: bitmap_fun_defs)
-  apply (wpsimp wp: curDomain_or_return_0[simplified] simp: invs_ksCurDomain_maxDomain')
-  done
+lemma chooseThread_invs_no_cicd':
+  "\<lbrace> invs_no_cicd' \<rbrace> chooseThread \<lbrace>\<lambda>rv. invs' \<rbrace>"
+proof -
+  note switchToThread_invs[wp del]
+  note switchToThread_invs_no_cicd'[wp del]
+  note switchToThread_lookupBitmapPriority_wp[wp]
+  note assert_wp[wp del]
+  note if_split[split del]
+
+  (* if we only have one domain, we are in it *)
+  have one_domain_case:
+    "\<And>s. \<lbrakk> invs_no_cicd' s; numDomains \<le> 1 \<rbrakk> \<Longrightarrow> ksCurDomain s = 0"
+    by (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def maxDomain_def)
+
+  (* NOTE: do *not* unfold numDomains in the rest of the proof,
+           it should work for any number *)
+
+  (* FIXME this is almost identical to the chooseThread_invs_no_cicd'_posts proof, can generalise? *)
+  show ?thesis
+    apply (clarsimp simp: chooseThread_def Let_def curDomain_def)
+    apply (rule bind_wp[OF _ stateAssert_sp])+
+    apply (simp only: return_bind, simp)
+    apply (rule bind_wp[where Q'="\<lambda>rv s. invs_no_cicd' s \<and> rv = ksCurDomain s
+                                              \<and> ksReadyQueues_asrt s \<and> ready_qs_runnable s"])
+     apply (rule_tac Q'="\<lambda>rv s. invs_no_cicd' s \<and> curdom = ksCurDomain s \<and>
+                                rv = ksReadyQueuesL1Bitmap s curdom \<and>
+                                ksReadyQueues_asrt s \<and> ready_qs_runnable s" in bind_wp)
+      apply (rename_tac l1)
+      apply (case_tac "l1 = 0")
+       (* switch to idle thread *)
+       apply (simp, wp switchToIdleThread_invs_no_cicd', simp)
+      (* we have a thread to switch to *)
+      apply (clarsimp simp: bitmap_fun_defs)
+      apply (wp assert_inv)
+      apply (clarsimp simp:  all_invs_but_ct_idle_or_in_cur_domain'_def valid_pspace'_def
+                             valid_bitmaps_def)
+      apply (frule (6) lookupBitmapPriority_obj_at')
+      apply (clarsimp simp: tcb_in_cur_domain'_def obj_at'_def tcbQueueEmpty_def inQ_def)
+      apply (fastforce elim: bitmapQ_from_bitmap_lookup simp: lookupBitmapPriority_def)
+     apply (wpsimp simp: bitmap_fun_defs curDomain_def one_domain_case)+
+    done
+qed
 
 lemma chooseThread_in_cur_domain':
-  "\<lbrace> invs' \<rbrace> chooseThread \<lbrace>\<lambda>rv s. ksCurThread s = ksIdleThread s \<or> tcb_in_cur_domain' (ksCurThread s) s\<rbrace>"
+  "\<lbrace> invs_no_cicd' \<rbrace> chooseThread \<lbrace>\<lambda>rv s. ksCurThread s = ksIdleThread s \<or> tcb_in_cur_domain' (ksCurThread s) s\<rbrace>"
   apply (rule hoare_pre, rule hoare_strengthen_post)
-    apply (rule chooseThread_invs'_posts, simp_all)
+    apply (rule chooseThread_invs_no_cicd'_posts, simp_all)
   done
 
 lemma scheduleChooseNewThread_invs':
-  "scheduleChooseNewThread \<lbrace>invs'\<rbrace>"
+  "\<lbrace> invs' and (\<lambda>s. ksSchedulerAction s = ChooseNewThread) \<rbrace>
+   scheduleChooseNewThread
+   \<lbrace> \<lambda>_ s. invs' s \<rbrace>"
   unfolding scheduleChooseNewThread_def
-  apply (wpsimp wp: ssa_invs' chooseThread_invs'' chooseThread_ct_not_queued_2
-                    chooseThread_activatable_2 chooseThread_invs''
-                    chooseThread_in_cur_domain' nextDomain_invs' chooseThread_ct_not_queued_2)
-  done
-
-lemma setReprogramTimer_invs'[wp]:
-  "setReprogramTimer v \<lbrace>invs'\<rbrace>"
-  unfolding setReprogramTimer_def
-  apply wpsimp
-  by (clarsimp simp: invs'_def valid_machine_state'_def cur_tcb'_def
-                     ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def ct_not_inQ_def
-                     valid_dom_schedule'_def)
-
-lemma machine_op_lift_underlying_memory_invar:
-  "(x, b) \<in> fst (machine_op_lift a m) \<Longrightarrow> underlying_memory b = underlying_memory m"
-  by (clarsimp simp: in_monad machine_op_lift_def machine_rest_lift_def select_f_def)
-
-lemma setNextInterrupt_invs'[wp]:
-  "setNextInterrupt \<lbrace>invs'\<rbrace>"
-  unfolding setNextInterrupt_def
-  apply (wpsimp wp: dmo_invs' ARM.setDeadline_irq_masks threadGet_wp getReleaseQueue_wp)
-  apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-  by (auto simp: in_monad setDeadline_def machine_op_lift_underlying_memory_invar)
-
-lemma setCurSc_invs'[wp]:
-  "setCurSc v \<lbrace>invs'\<rbrace>"
-  unfolding setCurSc_def
-  apply wpsimp
-  apply (clarsimp simp: invs'_def valid_machine_state'_def cur_tcb'_def
-                        ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def ct_not_inQ_def
-                        valid_queues_def valid_queues_no_bitmap_def valid_bitmapQ_def bitmapQ_def
-                        bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def valid_irq_node'_def
-                        valid_queues'_def valid_release_queue_def valid_release_queue'_def
-                        valid_dom_schedule'_def)
-  done
-
-lemma setConsumedTime_invs'[wp]:
-  "setConsumedTime v \<lbrace>invs'\<rbrace>"
-  unfolding setConsumedTime_def
-  apply wpsimp
-  apply (clarsimp simp: invs'_def valid_machine_state'_def cur_tcb'_def
-                        ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def ct_not_inQ_def
-                        valid_queues_def valid_queues_no_bitmap_def valid_bitmapQ_def bitmapQ_def
-                        bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def valid_irq_node'_def
-                        valid_queues'_def valid_release_queue_def valid_release_queue'_def
-                        valid_dom_schedule'_def)
-  done
-
-lemma setDomainTime_invs'[wp]:
-  "setDomainTime v \<lbrace>invs'\<rbrace>"
-  unfolding setDomainTime_def
-  apply wpsimp
-  done
-
-lemma valid_idle'_ko_at_idle_sc_is_idle':
-  "\<lbrakk>valid_idle' s; ko_at' ko scPtr s\<rbrakk> \<Longrightarrow> (scPtr = idle_sc_ptr \<longrightarrow> idle_sc' ko)"
-  apply (clarsimp simp: valid_idle'_def obj_at'_real_def ko_wp_at'_def)
-  done
-
-lemma refillTailIndex_bounded:
-  "valid_sched_context' ko s \<Longrightarrow> 0 < scRefillMax ko \<longrightarrow> refillTailIndex ko < scRefillMax ko"
-  apply (clarsimp simp: valid_sched_context'_def refillTailIndex_def Let_def split: if_split)
-  by linarith
-
-lemma refillAddTail_valid_objs'[wp]:
-  "refillAddTail scPtr t \<lbrace>valid_objs'\<rbrace>"
-  apply (simp add: refillAddTail_def)
-  apply (wpsimp wp: set_sc_valid_objs' getRefillNext_wp getRefillSize_wp
-              simp: updateSchedContext_def)
-  apply (frule (1) sc_ko_at_valid_objs_valid_sc', clarsimp)
-  apply (clarsimp simp: valid_obj'_def obj_at'_def projectKOs opt_map_red opt_pred_def)
-  apply (intro conjI)
-   apply (frule refillTailIndex_bounded)
-   apply (clarsimp simp: valid_sched_context'_def)
-  apply (frule refillTailIndex_bounded)
-  apply (clarsimp simp: valid_sched_context_size'_def objBits_simps valid_sched_context'_def)
-  done
-
-lemma refillAddTail_invs'[wp]:
-  "refillAddTail scPtr t \<lbrace>invs'\<rbrace>"
-  apply (simp add: refillAddTail_def)
-  apply (wpsimp wp: setSchedContext_invs' getRefillNext_wp getRefillSize_wp
-              simp: updateSchedContext_def)
-  apply (frule (1) invs'_ko_at_valid_sched_context', clarsimp)
-  apply (drule ko_at'_inj, assumption, clarsimp)+
-  apply (intro conjI)
-    apply (fastforce dest: live_sc'_ko_ex_nonz_cap_to')
-   apply (frule refillTailIndex_bounded)
-   apply (clarsimp simp: valid_sched_context'_def)
-  apply (frule refillTailIndex_bounded)
-  apply (clarsimp simp: valid_sched_context_size'_def objBits_def objBitsKO_def valid_sched_context'_def)
-  done
-
-lemma refillBudgetCheckRoundRobin_invs'[wp]:
-  "\<lbrace>invs' and (\<lambda>s. active_sc_at' (ksCurSc s) s)\<rbrace>
-   refillBudgetCheckRoundRobin consumed
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  supply if_split [split del]
-  apply (simp add: refillBudgetCheckRoundRobin_def updateRefillTl_def updateRefillHd_def)
-  apply (wpsimp simp:  wp: updateSchedContext_refills_invs')
-    apply (rule_tac Q'="\<lambda>_. invs' and active_sc_at' scPtr" in hoare_strengthen_post[rotated])
-     apply clarsimp
-     apply (frule (1) invs'_ko_at_valid_sched_context', clarsimp)
-     apply (clarsimp simp: valid_sched_context'_def active_sc_at'_def obj_at'_real_def
-                           ko_wp_at'_def valid_sched_context_size'_def objBits_def objBitsKO_def)
-    apply (wpsimp wp: updateSchedContext_refills_invs' getCurTime_wp updateSchedContext_active_sc_at')
-   apply (wpsimp wp: )
-  apply clarsimp
-  apply (frule invs'_ko_at_valid_sched_context', simp, clarsimp)
-  apply (clarsimp simp: valid_sched_context'_def active_sc_at'_def obj_at'_real_def ko_wp_at'_def
-                        valid_sched_context_size'_def objBits_def objBitsKO_def)
-  done
-
-lemma updateRefillTl_valid_objs'[wp]:
-  "updateRefillTl scPtr f \<lbrace>valid_objs'\<rbrace>"
-  apply (clarsimp simp: updateRefillTl_def updateSchedContext_def)
-  apply (wpsimp wp: set_sc_valid_objs')
-  apply (fastforce dest: sc_ko_at_valid_objs_valid_sc'
-                   simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
-  done
-
-crunch scheduleUsed
-  for valid_objs'[wp]: valid_objs'
-  (simp: refillFull_def refillEmpty_def)
-
-lemma updateRefillTl_invs'[wp]:
-  "updateRefillTl scPtr f \<lbrace>invs'\<rbrace>"
-  apply (clarsimp simp: updateRefillTl_def)
-  apply (wpsimp wp: updateSchedContext_invs')
-  apply (intro conjI)
-   apply (fastforce dest: invs_iflive'
-                    elim: if_live_then_nonz_capE'
-                    simp: valid_idle'_def obj_at'_def ko_wp_at'_def live_sc'_def projectKOs)
-  apply (fastforce dest: sc_ko_at_valid_objs_valid_sc'
-                   simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
-  done
-
-lemma updateRefillTl_if_live_then_nonz_cap'[wp]:
-  "updateRefillTl scPtr f \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: updateRefillTl_def updateSchedContext_def)
-  apply (wpsimp wp: setSchedContext_iflive')
-  apply (fastforce elim: if_live_then_nonz_capE'
-                   simp: valid_idle'_def obj_at'_def ko_wp_at'_def live_sc'_def projectKOs)
-  done
-
-lemma scheduleUsed_if_live_then_nonz_cap'[wp]:
-  "scheduleUsed scPtr refill \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (wpsimp simp: scheduleUsed_def refillAddTail_def updateSchedContext_def
-                  wp: getRefillSize_wp refillFull_wp refillEmpty_wp getRefillNext_wp)
-  apply (fastforce intro: if_live_then_nonz_capE'
-                    simp: ko_wp_at'_def obj_at'_real_def projectKO_sc live_sc'_def)
-  done
-
-lemma updateSchedContext_valid_idle':
-  "\<lbrace>valid_idle' and (\<lambda>s. \<forall>sc. idle_sc' sc \<longrightarrow> idle_sc' (f sc))\<rbrace>
-   updateSchedContext scPtr f
-   \<lbrace>\<lambda>_. valid_idle'\<rbrace>"
-  apply (clarsimp simp: updateSchedContext_def)
-  apply wpsimp
-  apply (fastforce simp: valid_idle'_def obj_at'_def)
-  done
-
-crunch scheduleUsed, updateRefillHd, refillPopHead
-  for valid_idle'[wp]: valid_idle'
-  (wp: updateSchedContext_valid_idle')
-
-lemma scheduleUsed_invs'[wp]:
-  "scheduleUsed scPtr refill \<lbrace>invs'\<rbrace>"
-  apply (simp add: scheduleUsed_def)
-  apply (wpsimp wp: refillFull_wp refillEmpty_wp)
-  done
-
-lemma refillPopHead_valid_objs'[wp]:
-  "\<lbrace>valid_objs' and obj_at' (\<lambda>sc'. 1 < scRefillCount sc') scPtr \<rbrace>
-   refillPopHead scPtr
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  apply (clarsimp simp: refillPopHead_def updateSchedContext_def getRefillNext_def)
-  apply (wpsimp wp: set_sc_valid_objs')
-  apply (frule (1) sc_ko_at_valid_objs_valid_sc')
-  apply (clarsimp simp: readRefillNext_def readSchedContext_def)
-  by (fastforce simp: obj_at'_def projectKOs scBits_simps refillNextIndex_def
-                      valid_sched_context'_def valid_sched_context_size'_def objBits_simps'
-               dest!: readObject_misc_ko_at')
-
-lemma refillPopHead_invs'[wp]:
-  "\<lbrace>invs' and obj_at' (\<lambda>sc'. 1 < scRefillCount sc') scPtr\<rbrace>
-   refillPopHead scPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: refillPopHead_def)
-  apply (wpsimp wp: updateSchedContext_invs' getRefillNext_wp)
-  apply (intro conjI; intro allI impI)
-   apply (clarsimp simp: obj_at'_def)
-   apply (rule if_live_then_nonz_capE')
-    apply (erule invs_iflive')
-   apply (clarsimp simp: ko_wp_at'_def obj_at'_def projectKO_eq projectKO_sc live_sc'_def)
-  apply (fastforce dest!: invs'_ko_at_valid_sched_context'
-                    simp: valid_sched_context'_def valid_sched_context_size'_def
-                          refillNextIndex_def obj_at_simps)
-  done
-
-lemma refillPopHead_active_sc_at'[wp]:
-  "refillPopHead scPtr \<lbrace>active_sc_at' scPtr'\<rbrace>"
-  apply (simp add: refillPopHead_def)
-  apply (wpsimp wp: updateSchedContext_active_sc_at' getRefillNext_wp)
-  done
-
-lemma refillAddTail_active_sc_at'[wp]:
-  "refillAddTail scPtr refill \<lbrace>active_sc_at' scPtr'\<rbrace>"
-  apply (simp add: refillAddTail_def getRefillSize_def refillTailIndex_def)
-  apply (wpsimp wp: updateSchedContext_active_sc_at' hoare_drop_imps getRefillNext_wp)
-  done
-
-lemma updateRefillTl_active_sc_at'[wp]:
-  "updateRefillTl scPtr f \<lbrace>active_sc_at' scPtr'\<rbrace>"
-  apply (simp add: updateRefillTl_def)
-  apply (wpsimp wp: updateSchedContext_active_sc_at' hoare_drop_imps getRefillNext_wp)
-  done
-
-crunch scheduleUsed
-  for active_sc_at'[wp]: "active_sc_at' scPtr"
-  (wp: crunch_wps)
-
-crunch refillPopHead
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' scPtr"
-
-lemma updateRefillHd_invs':
-  "\<lbrace>invs' and active_sc_at' scPtr\<rbrace> updateRefillHd scPtr f \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: updateRefillHd_def)
-  apply (wpsimp wp: updateSchedContext_invs')
-  apply (intro conjI; intro allI impI)
-   apply (fastforce dest: live_sc'_ko_ex_nonz_cap_to')
-  apply (frule invs'_ko_at_valid_sched_context', simp, clarsimp)
-  apply (clarsimp simp: valid_sched_context'_def active_sc_at'_def obj_at'_real_def ko_wp_at'_def
-                        valid_sched_context_size'_def objBits_def objBitsKO_def)
-  done
-
-lemma updateRefillHd_active_sc_at'[wp]:
-  "updateRefillHd scPtr f \<lbrace>active_sc_at' scPr\<rbrace>"
-  apply (clarsimp simp: updateRefillHd_def)
-  apply (wpsimp wp: updateSchedContext_active_sc_at')
-  done
-
-lemma updateRefillHd_active_sc_at'_ksCurSc[wp]:
-  "updateRefillHd scPtr f \<lbrace>\<lambda>s. active_sc_at' (ksCurSc s) s\<rbrace>"
-  apply (rule_tac f=ksCurSc in hoare_lift_Pf)
-   apply wpsimp
-  apply (clarsimp simp: updateRefillHd_def updateSchedContext_def)
-  apply wpsimp
-  done
-
-lemma setRefillHd_active_sc_at'[wp]:
-  "setRefillHd scPtr f \<lbrace>active_sc_at' scPr\<rbrace>"
-  apply (clarsimp simp: setRefillHd_def)
-  apply (wpsimp wp: updateSchedContext_active_sc_at')
-  done
-
-lemma setReprogramTimer_obj_at'[wp]:
-  "setReprogramTimer b \<lbrace>\<lambda>s. Q (obj_at' P t s)\<rbrace>"
-  unfolding active_sc_at'_def
-  by (wpsimp simp: setReprogramTimer_def)
-
-lemma setReprogramTimer_active_sc_at'[wp]:
-  "setReprogramTimer b \<lbrace>active_sc_at' scPtr\<rbrace>"
-  unfolding active_sc_at'_def
-  by wpsimp
-
-crunch refillBudgetCheck, refillUnblockCheck
-  for valid_queues[wp]: valid_queues
-  and valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n T p s)"
-  and active_sc_at'[wp]: "active_sc_at' scPtr"
-  (wp: crunch_wps)
-
-lemma mergeRefills_valid_objs':
-  "\<lbrace>\<lambda>s. valid_objs' s \<and> sc_at' scPtr s \<and> ((\<lambda>sc. 1 < scRefillCount sc) |< scs_of' s) scPtr\<rbrace>
-   mergeRefills scPtr
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  apply (clarsimp simp: mergeRefills_def updateRefillHd_def)
-  apply (rule_tac Q'="\<lambda>_ s. valid_objs' s \<and> sc_at' scPtr s" in bind_wp_fwd)
-   apply wpsimp
-   apply (clarsimp simp: obj_at_simps opt_map_red opt_pred_def)
-  apply (wpsimp wp: set_sc_valid_objs' simp: updateSchedContext_def)
-  apply (clarsimp simp: valid_sched_context'_def obj_at_simps valid_obj'_def
-                        valid_sched_context_size'_def opt_map_red opt_pred_def
-                 dest!: sc_ko_at_valid_objs_valid_sc')
-  done
-
-lemma no_ofail_refillHeadOverlapping:
-  "no_ofail (sc_at' scp) (refillHeadOverlapping scp)"
-  unfolding refillHeadOverlapping_def oreturn_def obind_def oliftM_def no_ofail_def
-            readRefillSize_def readRefillNext_def
-  by (clarsimp dest!: no_ofailD[OF no_ofail_readSchedContext])
-
-lemma refillHeadOverlapping_implies_count_greater_than_one:
-  "\<lbrakk>the (refillHeadOverlapping scPtr s); sc_at' scPtr s\<rbrakk>
-   \<Longrightarrow> ((\<lambda>sc. 1 < scRefillCount sc) |< scs_of' s) scPtr"
-  apply (clarsimp simp: refillHeadOverlapping_def readSchedContext_def oliftM_def
-                        readRefillNext_def readRefillSize_def obind_def omonad_defs
-                 split: option.splits dest!: readObject_misc_ko_at')
-   apply (fastforce dest: no_ofail_sc_at'_readObject[unfolded no_ofail_def, rule_format])
-  apply (clarsimp simp: obj_at_simps opt_map_red opt_pred_def MIN_REFILLS_def)
-  done
-
-lemma refillHeadOverlappingLoop_valid_objs':
-  "\<lbrace>\<lambda>s. valid_objs' s \<and> sc_at' scPtr s\<rbrace>
-   refillHeadOverlappingLoop scPtr
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (clarsimp simp: refillHeadOverlappingLoop_def)
-  apply (wpsimp wp: valid_whileLoop[where I="\<lambda>_. ?pre"] mergeRefills_valid_objs')
-    apply (clarsimp simp: runReaderT_def)
-    apply (prop_tac "((\<lambda>sc. 1 < scRefillCount sc) |< scs_of' s) scPtr")
-     apply (fastforce elim: refillHeadOverlapping_implies_count_greater_than_one
-                      simp: obj_at_simps opt_map_red)
-    apply simp+
-  done
-
-lemma updateRefillHd_valid_objs':
-  "\<lbrace>\<lambda>s. valid_objs' s \<and> sc_at' scPtr s\<rbrace>
-   updateRefillHd scPtr f
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  apply (clarsimp simp: updateRefillHd_def)
-  apply (wpsimp wp: set_sc_valid_objs' simp: updateSchedContext_def)
-  apply (clarsimp simp: is_active_sc'_def valid_sched_context'_def obj_at_simps valid_obj'_def
-                        valid_sched_context_size'_def opt_map_red opt_pred_def active_sc_at'_rewrite
-                 dest!: sc_ko_at_valid_objs_valid_sc')
-  done
-
-lemma setRefillHd_valid_objs':
-  "\<lbrace>\<lambda>s. valid_objs' s \<and> sc_at' scPtr s\<rbrace>
-   setRefillHd scPtr f
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  apply (wpsimp simp: setRefillHd_def
-                  wp: updateRefillHd_valid_objs')
-  done
-
-lemma refillUnblockCheck_valid_objs'[wp]:
-  "refillUnblockCheck scPtr \<lbrace>valid_objs'\<rbrace>"
-  apply (clarsimp simp: refillUnblockCheck_def isRoundRobin_def refillReady_def)
-  apply (wpsimp wp: updateRefillHd_valid_objs' refillHeadOverlappingLoop_valid_objs' scActive_wp)
-  done
-
-lemma refillUnblockCheck_valid_mdb'[wp]:
-  "refillUnblockCheck scPtr \<lbrace>valid_mdb'\<rbrace>"
-  apply (clarsimp simp: refillUnblockCheck_def valid_mdb'_def)
-  apply (wpsimp wp: scActive_wp)
-  done
-
-lemma refillUnblockCheck_valid_machine_state'[wp]:
-  "refillUnblockCheck scPtr \<lbrace>valid_machine_state'\<rbrace>"
-  apply (clarsimp simp: refillUnblockCheck_def refillReady_def isRoundRobin_def
-                        refillHeadOverlappingLoop_def mergeRefills_def updateRefillHd_def
-                        refillPopHead_def updateSchedContext_def setReprogramTimer_def
-                        valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
-  apply (wpsimp wp: whileLoop_valid_inv hoare_vcg_all_lift hoare_vcg_disj_lift scActive_wp
-                    hoare_drop_imps getRefillNext_wp)
-  apply fastforce
-  done
-
-lemma refillUnblockCheck_list_refs_of_replies'[wp]:
-  "refillUnblockCheck scPtr \<lbrace>\<lambda>s. P (list_refs_of_replies' s)\<rbrace>"
-  apply (clarsimp simp: refillUnblockCheck_def valid_mdb'_def refillHeadOverlappingLoop_def
-                        mergeRefills_def updateRefillHd_def refillPopHead_def updateSchedContext_def
-                        setReprogramTimer_def refillReady_def isRoundRobin_def)
-  apply (wpsimp wp: whileLoop_valid_inv hoare_drop_imps scActive_wp getRefillNext_wp
-              simp: o_def)
-  done
-
-lemma refillPopHead_if_live_then_nonz_cap'[wp]:
-  "refillPopHead scPtr \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: refillPopHead_def updateSchedContext_def getRefillNext_def)
-  apply wpsimp
-  apply (fastforce intro: if_live_then_nonz_capE'
-                    simp: ko_wp_at'_def obj_at'_real_def projectKO_sc live_sc'_def)
-  done
-
-lemma mergeRefills_if_live_then_nonz_cap'[wp]:
-  "mergeRefills scPtr \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: mergeRefills_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp simp: updateRefillHd_def updateSchedContext_def)
-  apply (fastforce intro: if_live_then_nonz_capE'
-                    simp: ko_wp_at'_def obj_at'_real_def projectKO_sc live_sc'_def)
-  done
-
-lemma nonOverlappingMergeRefills_if_live_then_nonz_cap'[wp]:
-  "nonOverlappingMergeRefills scPtr \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: nonOverlappingMergeRefills_def updateRefillHd_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)+
-  by (wpsimp simp: updateSchedContext_def,
-      fastforce intro: if_live_then_nonz_capE'
-                 simp: ko_wp_at'_def obj_at'_real_def projectKO_sc live_sc'_def)+
-
-crunch refillHeadOverlappingLoop, headInsufficientLoop
-  for if_live_then_nonz_cap'[wp]: if_live_then_nonz_cap'
-  (wp: crunch_wps)
-
-lemma updateRefillHd_if_live_then_nonz_cap'[wp]:
-  "updateRefillHd scPtr f \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: updateRefillHd_def updateSchedContext_def)
-  apply wpsimp
-  apply (fastforce intro: if_live_then_nonz_capE'
-                    simp: ko_wp_at'_def obj_at'_real_def projectKO_sc live_sc'_def)
-  done
-
-lemma setRefillHd_if_live_then_nonz_cap'[wp]:
-  "setRefillHd scPtr f \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (wpsimp simp: setRefillHd_def)
-  done
-
-crunch handleOverrunLoop
-  for if_live_then_nonz_cap'[wp]: if_live_then_nonz_cap'
-  (wp: crunch_wps)
-
-lemma refillUnblockCheck_if_live_then_nonz_cap'[wp]:
-  "refillUnblockCheck scPtr \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: refillUnblockCheck_def setReprogramTimer_def refillReady_def
-                        isRoundRobin_def)
-  apply (wpsimp wp: scActive_wp)
-  done
-
-lemma mergeRefills_valid_idle'[wp]:
-  "mergeRefills scPtr \<lbrace>valid_idle'\<rbrace>"
-  apply (clarsimp simp: mergeRefills_def updateRefillHd_def updateSchedContext_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp simp: valid_idle'_def obj_at'_def)
-  done
-
-lemma nonOverlappingMergeRefills_valid_idle'[wp]:
-  "nonOverlappingMergeRefills scPtr \<lbrace>valid_idle'\<rbrace>"
-  apply (clarsimp simp: nonOverlappingMergeRefills_def updateRefillHd_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)+
-  apply (clarsimp simp: updateSchedContext_def,
-         rule bind_wp[OF _ get_sc_sp'],
-         wpsimp simp: valid_idle'_def obj_at'_def)+
-  done
-
-crunch refillHeadOverlappingLoop, headInsufficientLoop, handleOverrunLoop
-  for valid_idle'[wp]: valid_idle'
-  (wp: crunch_wps)
-
-lemma refillUnblockCheck_valid_idle'[wp]:
-  "refillUnblockCheck scPtr \<lbrace>valid_idle'\<rbrace>"
-  apply (clarsimp simp: refillUnblockCheck_def isRoundRobin_def refillReady_def
-                        setReprogramTimer_def updateRefillHd_def updateSchedContext_def)
-  apply (wpsimp wp: scActive_wp)
-  apply (clarsimp simp: valid_idle'_def obj_at'_def)
-  done
-
-crunch refillHeadOverlappingLoop, headInsufficientLoop, handleOverrunLoop
-  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  (wp: crunch_wps)
-
-lemma refillUnblockCheck_ct_idle_or_in_cur_domain'[wp]:
-  "refillUnblockCheck scPtr \<lbrace>ct_idle_or_in_cur_domain'\<rbrace>"
-  apply (clarsimp simp: refillUnblockCheck_def isRoundRobin_def refillReady_def
-                        setReprogramTimer_def updateRefillHd_def)
-  apply (wpsimp wp: scActive_wp)
-  done
-
-crunch refillUnblockCheck, refillBudgetCheck
-  for reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and pred_tcb_at'[wp]: "pred_tcb_at' proj P p"
-  and valid_replies'[wp]: valid_replies'
-  (wp: crunch_wps valid_replies'_lift)
-
-lemma refillUnblockCheck_invs':
-  "refillUnblockCheck scPtr \<lbrace>invs'\<rbrace>"
-  apply (clarsimp simp: invs'_def valid_pspace'_def pred_conj_def)
-  apply wpsimp
-  done
-
-crunch ifCondRefillUnblockCheck
-  for invs'[wp]: invs'
-  (wp: hoare_vcg_if_lift2 crunch_wps simp: crunch_simps)
-
-lemma nonOverlappingMergeRefills_valid_objs':
-  "\<lbrace>\<lambda>s. valid_objs' s \<and> sc_at' scPtr s\<rbrace>
-   nonOverlappingMergeRefills scPtr
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  apply (clarsimp simp: nonOverlappingMergeRefills_def updateRefillHd_def)
-  apply (rule bind_wp[OF _ get_sc_sp'])
-  apply (rule_tac bind_wp[OF _ assert_sp])
-  apply (rule_tac Q'="\<lambda>_ s. valid_objs' s \<and> sc_at' scPtr s" in bind_wp_fwd)
-   apply wpsimp
-   apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def)
-  apply (wpsimp wp: set_sc_valid_objs' simp: updateSchedContext_def)
-    apply (rule_tac Q'="\<lambda>_. valid_objs' and sc_at' scPtr" in hoare_strengthen_post[rotated])
-     apply (clarsimp simp: valid_sched_context'_def obj_at_simps valid_obj'_def
-                           valid_sched_context_size'_def opt_map_red opt_pred_def
-                    dest!: sc_ko_at_valid_objs_valid_sc')
-    apply (wpsimp wp: set_sc_valid_objs' setSchedContext_active_sc_at' simp: updateSchedContext_def)+
-  apply (fastforce simp: valid_sched_context'_def obj_at_simps valid_obj'_def
-                         valid_sched_context_size'_def opt_map_red opt_pred_def
-                  dest!: sc_ko_at_valid_objs_valid_sc')
-  done
-
-crunch refillHeadOverlappingLoop, headInsufficientLoop, handleOverrunLoop
-  for active_sc_at'[wp]: "active_sc_at' scPtr"
-  and ksCurSc[wp]: "\<lambda>s. P (ksCurSc s)"
-  (wp: crunch_wps)
-
-lemma headInsufficientLoop_valid_objs':
-  "\<lbrace>\<lambda>s. valid_objs' s \<and> sc_at' scPtr s\<rbrace>
-   headInsufficientLoop scPtr
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (clarsimp simp: headInsufficientLoop_def)
-  apply (wpsimp wp: valid_whileLoop[where I="\<lambda>_. ?pre"] nonOverlappingMergeRefills_valid_objs')
-  done
-
-lemma handleOverrunLoop_valid_objs':
-  "\<lbrace>\<lambda>s. valid_objs' s \<and> active_sc_at' (ksCurSc s) s\<rbrace>
-   handleOverrunLoop usage
-   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (clarsimp simp: handleOverrunLoop_def)
-  apply (wpsimp wp: valid_whileLoop[where I="\<lambda>_. ?pre"])
-    apply (intro hoare_vcg_conj_lift_pre_fix)
-     apply (clarsimp simp: handleOverrunLoopBody_def)
-     apply (wpsimp wp: updateRefillHd_valid_objs' simp: refillSingle_def)
-     apply (frule (1) sc_ko_at_valid_objs_valid_sc')
-     apply (fastforce simp: valid_sched_context'_def active_sc_at'_def obj_at_simps refillTailIndex_def Let_def
-                     split: if_split_asm)
-    apply (rule_tac f=ksCurSc in hoare_lift_Pf3)
-     apply wpsimp+
-  done
-
-lemma refillBudgetCheck_valid_objs':
-  "refillBudgetCheck usage \<lbrace>valid_objs'\<rbrace>"
-  apply (clarsimp simp: refillBudgetCheck_def isRoundRobin_def refillReady_def getCurSc_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp[OF _ scActive_sp])
-  apply (rule bind_wp[OF _ assert_sp])
-  apply (wpsimp wp: headInsufficientLoop_valid_objs' handleOverrunLoop_valid_objs'
-                    hoare_vcg_all_lift updateRefillHd_valid_objs' hoare_vcg_if_lift2 hoare_drop_imps)
-  apply (clarsimp simp: active_sc_at'_def obj_at'_def)
-  done
-
-lemma refillBudgetCheck_valid_mdb'[wp]:
-  "refillBudgetCheck usage \<lbrace>valid_mdb'\<rbrace>"
-  apply (clarsimp simp: handleOverrunLoop_def valid_mdb'_def)
-  apply (wpsimp wp: scActive_wp)
-  done
-
-lemma handleOverrunLoop_list_refs_of_replies'[wp]:
-  "handleOverrunLoop usage \<lbrace>\<lambda>s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  apply (clarsimp simp: handleOverrunLoop_def)
-  apply (wpsimp wp: whileLoop_valid_inv hoare_drop_imps getRefillNext_wp
-                    getRefillSize_wp refillFull_wp refillEmpty_wp
-              simp: o_def handleOverrunLoopBody_def refillPopHead_def updateSchedContext_def
-                    scheduleUsed_def refillAddTail_def  updateRefillHd_def setRefillTl_def
-                    updateRefillTl_def refillSingle_def)
-  done
-
-lemma refillBudgetCheck_list_refs_of_replies'[wp]:
-  "refillBudgetCheck usage \<lbrace>\<lambda>s. sym_refs (list_refs_of_replies' s)\<rbrace>"
-  apply (clarsimp simp: refillBudgetCheck_def refillPopHead_def updateSchedContext_def
-                        setReprogramTimer_def refillReady_def isRoundRobin_def
-                        headInsufficientLoop_def nonOverlappingMergeRefills_def)
-  apply (rule bind_wp_fwd_skip, solves wpsimp)+
-  apply (wpsimp wp: whileLoop_valid_inv hoare_drop_imps refillFull_wp refillEmpty_wp getRefillNext_wp
-                     getRefillSize_wp hoare_vcg_all_lift hoare_vcg_if_lift2
-              simp: o_def scheduleUsed_def refillAddTail_def setRefillHd_def updateRefillHd_def
-                    setRefillTl_def updateRefillTl_def updateSchedContext_def)
-  done
-
-lemma refillBudgetCheck_if_live_then_nonz_cap'[wp]:
-  "refillBudgetCheck uage \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (wpsimp simp: refillBudgetCheck_def setReprogramTimer_def refillReady_def
-                      isRoundRobin_def
-                  wp: hoare_drop_imps)
-  done
-
-lemma refillBudgetCheck_valid_idle'[wp]:
-  "refillBudgetCheck usage \<lbrace>valid_idle'\<rbrace>"
-  apply (clarsimp simp: refillBudgetCheck_def isRoundRobin_def refillReady_def
-                        setReprogramTimer_def updateRefillHd_def setRefillHd_def)
-  apply (rule bind_wp_fwd_skip, solves wpsimp)+
-  apply (wpsimp wp: updateSchedContext_valid_idle')
-  done
-
-lemma handleOverrunLoop_valid_machine_state'[wp]:
-  "handleOverrunLoop usage \<lbrace>valid_machine_state'\<rbrace>"
-  apply (clarsimp simp: handleOverrunLoop_def)
-  apply (wpsimp wp: whileLoop_valid_inv hoare_drop_imps getRefillNext_wp
-                    getRefillSize_wp refillFull_wp refillEmpty_wp
-              simp: handleOverrunLoopBody_def refillPopHead_def updateSchedContext_def
-                    scheduleUsed_def refillAddTail_def  updateRefillHd_def setRefillTl_def
-                    updateRefillTl_def refillSingle_def)
-  done
-
-lemma refillBudgetCheck_valid_machine_state'[wp]:
-  "refillBudgetCheck usage \<lbrace>valid_machine_state'\<rbrace>"
-  apply (clarsimp simp: refillBudgetCheck_def refillPopHead_def updateSchedContext_def
-                        setReprogramTimer_def refillReady_def isRoundRobin_def
-                        headInsufficientLoop_def nonOverlappingMergeRefills_def)
-  apply (rule bind_wp_fwd_skip, solves wpsimp)+
-  apply (wpsimp wp: whileLoop_valid_inv hoare_vcg_all_lift hoare_vcg_disj_lift scActive_wp hoare_drop_imps
-                    refillFull_wp refillEmpty_wp getRefillNext_wp  getRefillSize_wp
-              simp: scheduleUsed_def refillAddTail_def setRefillTl_def updateRefillTl_def
-                    setRefillHd_def updateRefillHd_def updateSchedContext_def)
-  done
-
-lemma refillBudgetCheck_ct_idle_or_in_cur_domain'[wp]:
-  "refillBudgetCheck usage \<lbrace>ct_idle_or_in_cur_domain'\<rbrace>"
-  apply (clarsimp simp: refillBudgetCheck_def isRoundRobin_def refillReady_def
-                        setReprogramTimer_def updateRefillHd_def)
-  apply (wpsimp wp: getRefillSize_wp refillFull_wp refillEmpty_wp hoare_vcg_all_lift hoare_drop_imps
-                    hoare_vcg_if_lift2
-              simp: scheduleUsed_def refillAddTail_def setRefillTl_def updateRefillTl_def
-                    updateRefillHd_def setRefillHd_def)
-  done
-
-lemma refillBudgetCheck_invs'[wp]:
-  "refillBudgetCheck usage \<lbrace>invs'\<rbrace>"
-  apply (clarsimp simp: invs'_def valid_pspace'_def pred_conj_def)
-  apply (wpsimp wp: refillBudgetCheck_valid_objs')
-  done
-
-lemma commitTime_invs':
-  "commitTime \<lbrace>invs'\<rbrace>"
-  apply (simp add: commitTime_def)
-  apply wpsimp
-       apply (wpsimp wp: updateSchedContext_invs'_indep)
-      apply (clarsimp simp: valid_sched_context'_def valid_sched_context_size'_def objBits_def sc_size_bounds_def objBitsKO_def live_sc'_def)
-      apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post)
-       apply (wpsimp wp: isRoundRobin_wp)
-      apply (wpsimp wp: getConsumedTime_wp getCurSc_wp)+
-  by (clarsimp simp: active_sc_at'_def obj_at'_real_def ko_wp_at'_def)
-
-lemma switchSchedContext_invs':
-  "switchSchedContext \<lbrace>invs'\<rbrace>"
-  apply (simp add: switchSchedContext_def)
-  apply (wpsimp wp: commitTime_invs' getReprogramTimer_wp refillUnblockCheck_invs' threadGet_wp simp: getCurSc_def)
-  apply (fastforce simp: obj_at'_def projectKO_eq projectKO_opt_tcb)
-  done
-
-lemma isSchedulable_bool_runnableE:
-  "isSchedulable_bool t s \<Longrightarrow> tcb_at' t s \<Longrightarrow> st_tcb_at' runnable' t s"
-  unfolding isSchedulable_bool_def
-  by (clarsimp simp: pred_tcb_at'_def obj_at'_def pred_map_def projectKO_eq projectKO_opt_tcb
-              elim!: opt_mapE)
-
-lemma rescheduleRequired_invs'[wp]:
-  "rescheduleRequired \<lbrace>invs'\<rbrace>"
-  unfolding rescheduleRequired_def
-  apply (wpsimp wp: ssa_invs' isSchedulable_wp)
-  apply (clarsimp simp: invs'_def isSchedulable_bool_def vs_all_heap_simps
-                        st_tcb_at'_def obj_at_simps pred_map_simps
-                 elim!: opt_mapE)
-  done
-
-lemma rescheduleRequired_ksSchedulerAction[wp]:
-  "\<lbrace>\<lambda>_. P ChooseNewThread\<rbrace> rescheduleRequired \<lbrace>\<lambda>_ s. P (ksSchedulerAction s)\<rbrace>"
-  unfolding rescheduleRequired_def by (wpsimp wp: isSchedulable_wp)
-
-lemma inReleaseQueue_wp:
-  "\<lbrace>\<lambda>s. \<forall>ko. ko_at' ko tcb_ptr s \<longrightarrow> P (tcbInReleaseQueue ko) s\<rbrace>
-   inReleaseQueue tcb_ptr
-   \<lbrace>P\<rbrace>"
-  unfolding inReleaseQueue_def threadGet_getObject
-  apply (wpsimp wp: getObject_tcb_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma possibleSwitchTo_weak_sch_act[wp]:
-  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s \<and> st_tcb_at' runnable' t s\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding possibleSwitchTo_def
-  apply (wpsimp wp: inReleaseQueue_wp threadGet_wp rescheduleRequired_weak_sch_act_wf)
-  by (auto simp: obj_at'_def weak_sch_act_wf_def tcb_in_cur_domain'_def
-                 projectKO_eq ps_clear_domE)
-
-crunch possibleSwitchTo
-  for valid_pspace'[wp]: valid_pspace'
-  and valid_queues[wp]: valid_queues
-  and valid_tcbs'[wp]: valid_tcbs'
-  and cap_to'[wp]: "ex_nonz_cap_to' p"
-  and ifunsafe'[wp]: "if_unsafe_then_cap'"
-  and global_refs'[wp]: valid_global_refs'
-  and valid_machine_state'[wp]: valid_machine_state'
-  and cur[wp]: cur_tcb'
-  and valid_queues'[wp]: valid_queues'
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  and refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
-  and replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
-  and idle'[wp]: "valid_idle'"
-  and valid_arch'[wp]: valid_arch_state'
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and irq_states' [wp]: valid_irq_states'
-  and pde_mappings' [wp]: valid_pde_mappings'
-  and pspace_domain_valid[wp]: "pspace_domain_valid"
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  and valid_objs'[wp]: valid_objs'
-  and ksArchState[wp]: "\<lambda>s. P (ksArchState s)"
-  and ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
-  and valid_irq_handlers'[wp]: valid_irq_handlers'
-  (wp: crunch_wps cur_tcb_lift valid_irq_handlers_lift'' simp: crunch_simps)
-
-lemmas possibleSwitchTo_typ_ats[wp] = typ_at_lifts[OF possibleSwitchTo_typ_at']
-
-lemma possibleSwitchTo_sch_act[wp]:
-  "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and> st_tcb_at' runnable' t s\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (wpsimp simp: possibleSwitchTo_def wp: inReleaseQueue_wp threadGet_wp)
-  by (fastforce simp: obj_at'_def tcb_in_cur_domain'_def)
-
-lemma possibleSwitchTo_iflive'[wp]:
-  "\<lbrace>if_live_then_nonz_cap' and ex_nonz_cap_to' t
-      and (\<lambda>s. \<forall>t. ksSchedulerAction s = SwitchToThread t
-                   \<longrightarrow> st_tcb_at' runnable' t s)\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  by (wpsimp simp: possibleSwitchTo_def inReleaseQueue_def
-               wp: hoare_vcg_if_lift2 hoare_drop_imps)
-
-lemma possibleSwitchTo_ct_idle_or_in_cur_domain'[wp]:
-  "possibleSwitchTo t \<lbrace>ct_idle_or_in_cur_domain'\<rbrace>"
-  apply (wpsimp simp: possibleSwitchTo_def
-                  wp: threadGet_wp inReleaseQueue_wp)
-  apply (fastforce simp: obj_at'_def ct_idle_or_in_cur_domain'_def)
-  done
-
-lemma possibleSwitchTo_utr[wp]:
-  "possibleSwitchTo t \<lbrace>untyped_ranges_zero'\<rbrace>"
-  by (wpsimp simp: cteCaps_of_def o_def wp: untyped_ranges_zero_lift)
-
-lemma possibleSwitchTo_invs'[wp]:
-  "\<lbrace>invs' and st_tcb_at' runnable' tptr\<rbrace>
-   possibleSwitchTo tptr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: possibleSwitchTo_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift threadGet_wp inReleaseQueue_wp ssa_invs')
-  apply (clarsimp simp: invs'_def pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma possibleSwitchTo_sch_act_not_other:
-  "\<lbrace>\<lambda>s. sch_act_not t' s \<and> t' \<noteq> t\<rbrace>
-   possibleSwitchTo t
-   \<lbrace>\<lambda>_. sch_act_not t'\<rbrace>"
-  apply (clarsimp simp: possibleSwitchTo_def)
-  apply (wpsimp wp: threadGet_wp inReleaseQueue_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma setReleaseQueue_tcb_at'[wp]:
- "setReleaseQueue qs \<lbrace>typ_at' T tcbPtr\<rbrace>"
-  unfolding setReleaseQueue_def
-  by wpsimp
-
-lemma setReleaseQueue_ksReleaseQueue[wp]:
-  "\<lbrace>\<lambda>_. P qs\<rbrace> setReleaseQueue qs \<lbrace>\<lambda>_ s. P (ksReleaseQueue s)\<rbrace>"
-  by (wpsimp simp: setReleaseQueue_def)
-
-lemma setReleaseQueue_pred_tcb_at'[wp]:
- "setReleaseQueue qs \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
-  by (wpsimp simp: setReleaseQueue_def)
-
-crunch setReprogramTimer, possibleSwitchTo
-  for ksReleaseQueue[wp]: "\<lambda>s. P (ksReleaseQueue s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma tcbReleaseDequeue_distinct_release_queue[wp]:
-  "tcbReleaseDequeue \<lbrace>distinct_release_queue\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  by (wpsimp simp: distinct_tl)
-
-lemma getReleaseQueue_sp:
-  "\<lbrace>Q\<rbrace> getReleaseQueue \<lbrace>\<lambda>r. (\<lambda>s. r = ksReleaseQueue s) and Q\<rbrace>"
-  unfolding getReleaseQueue_def
-  by wpsimp
-
-lemma releaseQNonEmptyAndReady_implies_releaseQNonEmpty:
-  "the (releaseQNonEmptyAndReady s) \<Longrightarrow> ksReleaseQueue s \<noteq> []"
-  by (clarsimp simp: releaseQNonEmptyAndReady_def readTCBRefillReady_def readReleaseQueue_def
-                     obind_def omonad_defs)
-
-lemma awaken_invs':
-  "awaken \<lbrace>invs'\<rbrace>"
-  apply (clarsimp simp: awaken_def awakenBody_def)
-  apply (rule_tac I="\<lambda>_. invs'" in valid_whileLoop; simp add: runReaderT_def)
-  apply (rule bind_wp[OF _ getReleaseQueue_sp])
-  apply (rule bind_wp[OF _ assert_sp])
-  apply wpsimp
-   apply (rule hoare_drop_imps)
-   apply (rule tcbReleaseDequeue_invs')
-  apply (fastforce intro!: releaseQNonEmptyAndReady_implies_releaseQNonEmpty)
-  done
-
-crunch tcbReleaseDequeue
-  for st_tcb_at'[wp]: "\<lambda>s. Q (st_tcb_at' P p s)"
-  and valid_replies' [wp]: valid_replies'
-  (wp: crunch_wps threadSet_pred_tcb_no_state valid_replies'_lift)
-
-lemma awaken_sch_act_wf[wp]:
-  "awaken \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (clarsimp simp: awaken_def awakenBody_def)
-  apply (rule_tac I="\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s" in valid_whileLoop; simp add: runReaderT_def)
-  apply (rule bind_wp[OF _ getReleaseQueue_sp])
-  apply (rule bind_wp[OF _ assert_sp])
-  apply wpsimp
-   apply (rule hoare_drop_imp)
-   apply wpsimp
-  apply (fastforce intro!: releaseQNonEmptyAndReady_implies_releaseQNonEmpty)
+  apply (wpsimp wp: ssa_invs' chooseThread_invs_no_cicd' chooseThread_ct_not_queued_2
+                    chooseThread_activatable_2 chooseThread_invs_no_cicd'
+                    chooseThread_in_cur_domain' nextDomain_invs_no_cicd' chooseThread_ct_not_queued_2)
+  apply (clarsimp simp: invs'_to_invs_no_cicd'_def)
   done
 
-crunch awaken
-  for cur_tcb'[wp]: cur_tcb'
-  (wp: crunch_wps)
-
-crunch checkDomainTime
-  for invs'[wp]: invs'
-  and sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  and cur_tcb'[wp]: cur_tcb'
-  (simp: crunch_simps wp: crunch_wps)
-
 lemma schedule_invs':
-  "schedule \<lbrace>invs'\<rbrace>"
-  supply if_split [split del]
-  apply (simp add: schedule_def scAndTimer_def cur_tcb'_asrt_def)
-  apply (intro bind_wp[OF _ stateAssert_sp])
-  apply (clarsimp simp: sch_act_wf_asrt_def)
+  "\<lbrace>invs'\<rbrace> ThreadDecls_H.schedule \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  supply ssa_wp[wp del]
+  apply (simp add: schedule_def)
   apply (rule_tac bind_wp, rename_tac t)
-   apply (rule_tac P'="invs' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and cur_tcb'" in hoare_weaken_pre)
-    apply (rule bind_wp_fwd_skip, wpsimp)
-    apply (rule_tac bind_wp[OF _ getCurThread_sp])
-    apply (rule_tac bind_wp[OF _ isSchedulable_sp])
-    apply (rule_tac bind_wp[OF _ getSchedulerAction_sp])
-    apply (rule bind_wp)
-     apply (wpsimp wp: switchSchedContext_invs')
-    apply (wpsimp wp: scheduleChooseNewThread_invs' isSchedulable_wp setSchedulerAction_invs'
-                      ssa_invs' hoare_vcg_disj_lift)
-           apply (wpsimp simp: isHighestPrio_def')
-          apply (wpsimp wp: curDomain_wp)
-         apply (wpsimp simp: scheduleSwitchThreadFastfail_def)
-        apply (rename_tac tPtr x idleThread targetPrio)
-        apply (rule_tac Q'="\<lambda>_. invs' and st_tcb_at' runnable' tPtr and cur_tcb'"
-                     in hoare_strengthen_post[rotated])
-         apply (prop_tac "st_tcb_at' runnable' tPtr s \<Longrightarrow> obj_at' (\<lambda>a. activatable' (tcbState a)) tPtr s")
-          apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-         apply fastforce
-        apply (wpsimp wp: threadGet_wp hoare_drop_imp hoare_vcg_ex_lift)
-       apply (rename_tac tPtr x idleThread)
-       apply (rule_tac Q'="\<lambda>_. invs' and st_tcb_at' runnable' tPtr and cur_tcb'"
-                    in hoare_strengthen_post[rotated])
-        apply (subst obj_at_ko_at'_eq[symmetric], simp)
-       apply (wpsimp wp: threadGet_wp hoare_drop_imp hoare_vcg_ex_lift)
-      apply (rename_tac tPtr x)
-      apply (rule_tac Q'="\<lambda>_. invs' and st_tcb_at' runnable' tPtr and cur_tcb'"
-                   in hoare_strengthen_post[rotated])
-       apply (subst obj_at_ko_at'_eq[symmetric], simp)
-      apply (wpsimp wp: tcbSchedEnqueue_invs' isSchedulable_wp)+
-    apply (fastforce split: if_split dest: isSchedulable_bool_runnableE simp: cur_tcb'_def)
-   apply assumption
-  apply (wpsimp wp: awaken_invs')
+   apply (wp, wpc)
+      \<comment> \<open>action = ResumeCurrentThread\<close>
+      apply (wp)[1]
+     \<comment> \<open>action = ChooseNewThread\<close>
+     apply (wp scheduleChooseNewThread_invs')
+    \<comment> \<open>action = SwitchToThread candidate\<close>
+    apply (wpsimp wp: scheduleChooseNewThread_invs' ssa_invs'
+                      chooseThread_invs_no_cicd' setSchedulerAction_invs' setSchedulerAction_direct
+                      switchToThread_tcb_in_cur_domain' switchToThread_ct_not_queued_2
+           | wp hoare_disjI2[where Q'="\<lambda>_ s. tcb_in_cur_domain' (ksCurThread s) s"]
+           | wp hoare_drop_imp[where f="isHighestPrio d p" for d p]
+           | simp only: obj_at'_activatable_st_tcb_at'[simplified comp_def]
+           | strengthen invs'_invs_no_cicd
+           | wp hoare_vcg_imp_lift)+
+  apply (frule invs_sch_act_wf')
+  apply (auto simp: invs_sch_act_wf' obj_at'_activatable_st_tcb_at'
+                     st_tcb_at'_runnable_is_activatable)
   done
 
 lemma setCurThread_nosch:
@@ -3038,17 +2218,12 @@ lemma chooseThread_nosch:
   apply (simp only: return_bind, simp)
   apply (wp findM_inv | simp)+
   apply (case_tac queue)
-  apply (wp stt_nosch isSchedulable_wp | simp add: curDomain_def bitmap_fun_defs)+
+  apply (wp stt_nosch | simp add: curDomain_def bitmap_fun_defs)+
   done
 
-crunch switchSchedContext, setNextInterrupt
-  for ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  (wp: crunch_wps hoare_vcg_all_lift simp: crunch_simps)
-
 lemma schedule_sch:
   "\<lbrace>\<top>\<rbrace> schedule \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread\<rbrace>"
-  unfolding schedule_def scAndTimer_def
-  by (wpsimp wp: setSchedulerAction_direct simp: getReprogramTimer_def scheduleChooseNewThread_def)
+  by (wp setSchedulerAction_direct | wpc| simp add: schedule_def scheduleChooseNewThread_def)+
 
 lemma schedule_sch_act_simple:
   "\<lbrace>\<top>\<rbrace> schedule \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
@@ -3072,33 +2247,32 @@ lemma scheduleChooseNewThread_ct_activatable'[wp]:
    \<lbrace>\<lambda>_. ct_in_state' activatable'\<rbrace>"
   unfolding scheduleChooseNewThread_def
   by (wpsimp simp: ct_in_state'_def
-                wp: ssa_invs' nextDomain_invs'
+                wp: ssa_invs' nextDomain_invs_no_cicd'
                     chooseThread_activatable_2[simplified ct_in_state'_def]
-         | (rule hoare_lift_Pf[where f=ksCurThread], solves wp))+
-
-lemma st_tcb_at_activatable_coerce_concrete:
-  assumes t: "st_tcb_at activatable t s"
-  assumes sr: "(s, s') \<in> state_relation"
-  assumes tcb: "tcb_at' t s'"
-  shows "st_tcb_at' activatable' t s'"
-  using t
-  apply -
-  apply (rule ccontr)
-  apply (drule pred_tcb_at'_Not[THEN iffD2, OF conjI, OF tcb])
-  apply (drule st_tcb_at_coerce_abstract[OF _ sr])
-  apply (clarsimp simp: st_tcb_def2)
-  apply (case_tac "tcb_state tcb"; simp)
-  done
+         | (rule hoare_lift_Pf[where f=ksCurThread], solves wp)
+         | strengthen invs'_invs_no_cicd)+
 
-lemma ct_in_state'_activatable_coerce_concrete:
-  "\<lbrakk>ct_in_state activatable s; (s, s') \<in> state_relation; cur_tcb' s'\<rbrakk>
-    \<Longrightarrow> ct_in_state' activatable' s'"
-   unfolding ct_in_state'_def cur_tcb'_def ct_in_state_def
-   apply (rule st_tcb_at_activatable_coerce_concrete[rotated], simp, simp)
-   apply (frule curthread_relation, simp)
-   done
+lemma schedule_ct_activatable'[wp]:
+  "\<lbrace>invs'\<rbrace> ThreadDecls_H.schedule \<lbrace>\<lambda>_. ct_in_state' activatable'\<rbrace>"
+  supply ssa_wp[wp del]
+  apply (simp add: schedule_def)
+  apply (rule_tac bind_wp, rename_tac t)
+   apply (wp, wpc)
+      \<comment> \<open>action = ResumeCurrentThread\<close>
+      apply (wp)[1]
+     \<comment> \<open>action = ChooseNewThread\<close>
+     apply wpsimp
+    \<comment> \<open>action = SwitchToThread\<close>
+    apply (wpsimp wp: ssa_invs' setSchedulerAction_direct ssa_ct
+           | wp hoare_drop_imp[where f="isHighestPrio d p" for d p]
+           | simp only: obj_at'_activatable_st_tcb_at'[simplified comp_def]
+           | strengthen invs'_invs_no_cicd
+           | wp hoare_vcg_imp_lift)+
+  apply (fastforce dest: invs_sch_act_wf' elim: pred_tcb'_weakenE
+                   simp: sch_act_wf obj_at'_activatable_st_tcb_at')
+  done
 
-lemma threadSet_sch_act_sane[wp]:
+lemma threadSet_sch_act_sane:
   "\<lbrace>sch_act_sane\<rbrace> threadSet f t \<lbrace>\<lambda>_. sch_act_sane\<rbrace>"
   by (wp sch_act_sane_lift)
 
@@ -3106,2633 +2280,51 @@ lemma rescheduleRequired_sch_act_sane[wp]:
   "\<lbrace>\<top>\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. sch_act_sane\<rbrace>"
   apply (simp add: rescheduleRequired_def sch_act_sane_def
                    setSchedulerAction_def)
-  by (wp isSchedulable_wp | wpc | clarsimp)+
+  by (wp | wpc | clarsimp)+
 
 crunch setThreadState, setBoundNotification
- for sch_act_sane[wp]: "sch_act_sane"
+  for sch_act_sane: "sch_act_sane"
   (simp: crunch_simps wp: crunch_wps)
 
-lemma weak_sch_act_wf_at_cross:
-  assumes sr: "(s,s') \<in> state_relation"
-  assumes aligned: "pspace_aligned s"
-  assumes distinct: "pspace_distinct s"
-  assumes t: "valid_sched_action s"
-  shows "weak_sch_act_wf (ksSchedulerAction s') s'"
-  using assms
-  apply (clarsimp simp: valid_sched_action_def weak_valid_sched_action_def weak_sch_act_wf_def)
-  apply (frule state_relation_sched_act_relation)
-  apply (rename_tac t)
-  apply (drule_tac x=t in spec)
-  apply (prop_tac "scheduler_action s = switch_thread t")
-   apply (metis sched_act_relation.simps Structures_A.scheduler_action.exhaust
-                scheduler_action.simps)
-  apply (intro conjI impI)
-   apply (rule st_tcb_at_runnable_cross; fastforce?)
-   apply (clarsimp simp: vs_all_heap_simps pred_tcb_at_def obj_at_def)
-  apply (clarsimp simp: switch_in_cur_domain_def in_cur_domain_def etcb_at_def vs_all_heap_simps)
-  apply (prop_tac "tcb_at t s")
-   apply (clarsimp simp: obj_at_def is_tcb_def)
-  apply (frule state_relation_pspace_relation)
-  apply (frule (3) tcb_at_cross)
-  apply (clarsimp simp: tcb_in_cur_domain'_def obj_at'_def projectKOs)
-  apply (frule curdomain_relation)
-  apply (frule (2) pspace_relation_tcb_domain_priority)
-  apply simp
-  done
-
 lemma possibleSwitchTo_corres:
-  "t = t' \<Longrightarrow>
-   corres dc
-    (valid_sched_action and tcb_at t and pspace_aligned and pspace_distinct
-     and valid_tcbs and active_scs_valid)
-    (valid_queues and valid_queues' and valid_release_queue_iff and valid_tcbs')
-      (possible_switch_to t)
-      (possibleSwitchTo t')"
-  supply dc_simp [simp del]
-  apply (rule corres_cross_add_guard[where Q="tcb_at' t"])
-   apply (fastforce intro: tcb_at_cross)
+  "corres dc
+     (valid_etcbs and 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')
+     (possible_switch_to t) (possibleSwitchTo t)"
+  apply (rule_tac Q'=pspace_aligned' in corres_cross_add_guard)
+   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)
   apply (simp add: possible_switch_to_def possibleSwitchTo_def cong: if_cong)
   apply (rule corres_guard_imp)
-    apply (simp add: get_tcb_obj_ref_def)
-    apply (rule corres_split)
-       apply (rule threadGet_corres[where r="(=)"])
-       apply (clarsimp simp: tcb_relation_def)
-      apply (rule corres_split[OF inReleaseQueue_corres], simp)
-        apply (rule corres_when[rotated])
-         apply (rule corres_split[OF curDomain_corres], simp)
-           apply (rule corres_split)
-              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)
-               apply (rule corres_if[rotated], simp)
-                 apply (rule corres_split[OF rescheduleRequired_corres])
-                   apply (rule tcbSchedEnqueue_corres)
-                  apply wp+
-                apply (rule setSchedulerAction_corres, simp)
-               apply (rename_tac rv rv')
-               apply (case_tac rv; simp)
-              apply (wpsimp simp: if_apply_def2 valid_sched_action_def
-                              wp: hoare_drop_imp inReleaseQueue_inv)+
-  done
-
-lemma ct_active_cross:
-  "\<lbrakk> (s,s') \<in> state_relation; pspace_aligned s; pspace_distinct s; ct_active s \<rbrakk>
-     \<Longrightarrow> ct_active' s'"
-  by (clarsimp simp: state_relation_def ct_in_state_def ct_in_state'_def
-                     st_tcb_at_runnable_cross runnable_eq_active runnable_eq_active'[symmetric])
-
-\<comment> \<open>Strengthen the consequent as necessary, there's more that can be derived from the assumptions\<close>
-lemma ct_released_cross_weak:
-  "\<lbrakk> (s,s') \<in> state_relation; pspace_aligned s; pspace_distinct s; ct_released s; cur_tcb' s' \<rbrakk>
-     \<Longrightarrow> bound_sc_tcb_at' bound (ksCurThread s') s'"
-  apply (clarsimp simp: vs_all_heap_simps obj_at_kh_kheap_simps)
-  apply (clarsimp simp: state_relation_def pspace_relation_def )
-  apply (erule_tac x="ksCurThread s'" in ballE)
-   apply (auto simp: vs_all_heap_simps other_obj_relation_def tcb_relation_def
-                          cur_tcb'_def pred_tcb_at'_def obj_at'_def projectKOs
-                   split: kernel_object.splits)
-  done
-
-lemma setReprogramTimer_corres[corres]:
-  "corres dc \<top> \<top> (modify (reprogram_timer_update (\<lambda>_. b))) (setReprogramTimer b)"
-  apply (unfold setReprogramTimer_def)
-  apply (rule corres_modify)
-  apply (simp add: state_relation_def swp_def)
-  done
-
-lemma getCurTime_corres[corres]:
-  "corres (=) \<top> \<top> (gets cur_time) (getCurTime)"
-  apply (clarsimp simp: getCurTime_def state_relation_def)
-  done
-
-lemma readRefillReady_simp:
-  "readRefillReady scp s
-   = (case readSchedContext scp s
-        of None \<Rightarrow> None
-         | Some sc' \<Rightarrow> Some (rTime (refillHd sc') \<le> (ksCurTime s) + kernelWCETTicks))"
-  by (clarsimp simp: readRefillReady_def readCurTime_def readSchedContext_SomeD asks_def obind_def)
-
-lemma refillReady_corres:
-  "corres (=)
-     (sc_at sc_ptr and
-        (\<lambda>s. ((\<lambda>sc. sc_refills sc \<noteq> []) |< scs_of2 s) sc_ptr))
-     (sc_at' sc_ptr and valid_refills' sc_ptr)
-        (get_sc_refill_ready sc_ptr)
-        (refillReady sc_ptr)"
-  supply getSchedContext_wp[wp del] set_sc'.get_wp[wp del] projection_rewrites[simp]
-  apply (clarsimp simp: refill_ready_def refillReady_def get_sc_refill_ready_def)
-  apply (rule gets_the_corres)
-    apply (wpsimp wp: no_ofail_read_sc_refill_ready)
-    apply (clarsimp simp: is_sc_obj obj_at_def)
-   apply wpsimp
-  apply (clarsimp simp: obj_at_def is_sc_obj dest!: no_ofailD[OF readRefillReady_no_ofail]
-                 intro: no_ofailD[OF no_ofail_read_sc_refill_ready])
-  apply (insert no_ofailD[OF no_ofail_read_sc_refill_ready, rule_format])
-  apply (drule_tac x=s and y=sc_ptr in meta_spec2)
-  apply (prop_tac "\<exists>sc n. kheap s sc_ptr = Some (kernel_object.SchedContext sc n)")
-   apply (clarsimp simp: sc_at_pred_n_def obj_at_def)
-  apply clarsimp
-  apply (clarsimp simp: read_sc_refill_ready_simp readRefillReady_simp readSchedContext_def
-                        read_sched_context_def
-                 split: option.splits dest!: readObject_misc_ko_at')
-  apply (rename_tac n sc' sc)
-  apply (frule state_relation_sc_relation; (clarsimp simp: obj_at'_def obj_at_def projectKOs is_sc_obj))
-     apply fastforce+
-  apply (fastforce simp: kernelWCETTicks_def refill_ready_def state_relation_def refill_map_def
-                         obj_at_def opt_map_red opt_pred_def valid_refills'_def
-                  dest!: refill_hd_relation)
-  done
-
-lemma readTCBRefillReady_no_ofail:
-  "no_ofail (\<lambda>s'. obj_at' (\<lambda>tcb. \<exists>sc. tcbSchedContext tcb = Some sc \<and> sc_at' sc s') t s')
-            (readTCBRefillReady t)"
-  unfolding readTCBRefillReady_def
-  apply (wpsimp wp: ovalid_threadRead)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma readTCBRefillReady_simp:
-  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_objs s;
-    active_sc_tcb_at t s; active_scs_valid s; valid_objs' s'\<rbrakk>
-   \<Longrightarrow> read_tcb_refill_ready t s = readTCBRefillReady t s'"
-  apply (frule (1) active_scs_valid_tcb_at)
-  apply (clarsimp simp: obj_at_kh_kheap_simps vs_all_heap_simps)
-  apply (rename_tac scp tcb sc n)
-  apply (prop_tac "tcb_at' t s' \<and> sc_at' scp s'")
-   apply (fastforce dest!: state_relationD intro!: sc_at_cross tcb_at_cross
-                     simp: obj_at_def is_tcb is_sc_obj
-                     elim: valid_sched_context_size_objsI)
-  apply clarsimp
-  apply (prop_tac "bound (read_tcb_refill_ready t s)")
-   apply (clarsimp intro!: no_ofailD[OF no_ofail_read_tcb_refill_ready]
-                     simp: pred_tcb_at_def obj_at_def)
-  apply (frule state_relation_pspace_relation)
-  apply (clarsimp simp: pspace_relation_def)
-  apply (drule_tac x=t in bspec, blast)
-  apply (drule_tac x="(t, other_obj_relation)" in bspec, clarsimp)
-  apply (clarsimp simp: other_obj_relation_def tcb_relation_def obj_at'_def projectKOs)
-  apply (prop_tac "bound (readTCBRefillReady t s')")
-   apply (clarsimp intro!: no_ofailD[OF readTCBRefillReady_no_ofail])
-   apply (clarsimp simp: obj_at'_def projectKOs)
-   apply (rule_tac x=scp in exI; clarsimp)
-  apply clarsimp
-  apply (clarsimp simp: read_tcb_refill_ready_def readTCBRefillReady_def oassert_opt_def
-                        readRefillReady_simp read_sc_refill_ready_simp refill_ready'_def obj_at'_def
-                        projectKOs
-                 dest!: read_tcb_obj_ref_SomeD read_sched_context_SomeD readSchedContext_SomeD
-                        threadRead_SomeD
-                 split: option.split_asm)
-  apply (rename_tac sc' sc_ptr tcbPtr)
-  apply (prop_tac "valid_sched_context' sc' s' \<and> valid_sched_context_size' sc'")
-   apply (frule_tac k=sc' and p=sc_ptr in sc_ko_at_valid_objs_valid_sc'[rotated])
-    apply (clarsimp simp: obj_at'_def projectKOs)
-   apply simp
-  apply (frule state_relation_pspace_relation)
-  apply (prop_tac "sc_relation sc n sc'")
-   apply (clarsimp simp: pspace_relation_def)
-   apply (drule_tac x=sc_ptr in bspec, blast)
-   apply (fastforce simp: obj_at'_def projectKOs split: if_splits)
-  apply (frule refill_hd_relation2)
-    apply (clarsimp simp: valid_refills_tcb_at_def valid_refills_def rr_valid_refills_def
-                          pred_tcb_at_def obj_at_def vs_all_heap_simps
-                   split: if_splits)
-   apply (fastforce dest!: sc_ko_at_valid_objs_valid_sc'
-                     simp: obj_at'_def projectKOs)
-  apply (clarsimp simp: kernelWCETTicks_def state_relation_def)
-  done
-
-lemma getReleaseQueue_corres[corres]:
-  "corres (=) \<top> \<top> (gets release_queue) (getReleaseQueue)"
-  unfolding getReleaseQueue_def
-  apply (rule corres_gets_trivial)
-  by (clarsimp simp: state_relation_def release_queue_relation_def)
-
-lemma releaseQNonEmptyAndReady_simp:
-  "releaseQNonEmptyAndReady s
-    = (if ksReleaseQueue s = []
-          then Some False
-          else readTCBRefillReady (head (ksReleaseQueue s)) s)"
-  by (clarsimp simp: releaseQNonEmptyAndReady_def readReleaseQueue_def asks_def obind_def)
-
-lemma releaseQNonEmptyAndReady_eq:
-  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s;
-     valid_objs s; valid_release_q s;
-     active_scs_valid s; valid_objs' s'\<rbrakk>
-   \<Longrightarrow> read_release_q_non_empty_and_ready s = releaseQNonEmptyAndReady s'"
-  apply (clarsimp simp: read_release_q_non_empty_and_ready_simp releaseQNonEmptyAndReady_simp)
-  apply (fastforce simp: state_relation_def release_queue_relation_def
-                 intro!: readTCBRefillReady_simp valid_release_q_active_sc)
-  done
-
-lemma ksReleaseQueue_length_well_founded:
-  "wf {((r :: unit, s :: kernel_state), (r', s')). length (ksReleaseQueue s)
-                                                    < length (ksReleaseQueue s')}"
-  apply (insert wf_inv_image[where r="{(m, n). m < n}"
-                               and f="\<lambda>(r :: unit, s :: kernel_state). length (ksReleaseQueue s)"])
-  apply (clarsimp simp: inv_image_def)
-  apply (prop_tac "wf {(m, n). m < n}")
-   apply (fastforce intro: wf)
-  apply (drule meta_mp)
-   apply simp
-  apply (prop_tac "{(x :: unit \<times> global.kernel_state, y ::  unit \<times> global.kernel_state).
-                     (case x of (r, s) \<Rightarrow> length (ksReleaseQueue s))
-                      < (case y of (r, s) \<Rightarrow> length (ksReleaseQueue s))}
-                   = {((r, s), r', s'). length (ksReleaseQueue s) < length (ksReleaseQueue s')}")
-   apply fastforce
-  apply fastforce
-  done
-
-lemma tcbReleaseDequeue_ksReleaseQueue_length_helper:
-  "\<lbrace>\<lambda>s'. ksReleaseQueue s' \<noteq> [] \<and> s' = s\<rbrace>
-   tcbReleaseDequeue
-   \<lbrace>\<lambda>r' s'. length (ksReleaseQueue s') < length (ksReleaseQueue s)\<rbrace>"
-  apply (wpsimp simp: tcbReleaseDequeue_def getReleaseQueue_def setReleaseQueue_def)
-  done
-
-lemma tcbReleaseDequeue_ksReleaseQueue_length:
-  "\<lbrace>\<lambda>s'. the (releaseQNonEmptyAndReady s') \<and> s' = s\<rbrace>
-   tcbReleaseDequeue
-   \<lbrace>\<lambda>r' s'. length (ksReleaseQueue s') < length (ksReleaseQueue s)\<rbrace>"
-  apply (wpsimp wp: tcbReleaseDequeue_ksReleaseQueue_length_helper)
-  apply (fastforce dest: releaseQNonEmptyAndReady_implies_releaseQNonEmpty)
-  done
-
-lemma awakenBody_ksReleaseQueue_length:
-  "\<lbrace>\<lambda>s'. the (releaseQNonEmptyAndReady s') \<and> s' = s\<rbrace>
-   awakenBody
-   \<lbrace>\<lambda>r' s'. length (ksReleaseQueue s') < length (ksReleaseQueue s)\<rbrace>"
-  apply (clarsimp simp: awakenBody_def)
-  apply (wpsimp wp: tcbReleaseDequeue_ksReleaseQueue_length hoare_drop_imps)
-  done
-
-lemma awaken_terminates:
-  "whileLoop_terminates (\<lambda>_ s'. (the (releaseQNonEmptyAndReady s'))) (\<lambda>_. awakenBody) r' s'"
-  apply (rule_tac R="{((r', s'), (r, s)). length (ksReleaseQueue s') < length (ksReleaseQueue s)}"
-               in whileLoop_terminates_inv)
-    apply simp
-   apply clarsimp
-   apply (rule awakenBody_ksReleaseQueue_length)
-  apply (rule ksReleaseQueue_length_well_founded)
-  done
-
-lemma reprogram_timer_update_release_queue_update_monad_commute:
-  "monad_commute \<top> (modify (reprogram_timer_update (\<lambda>_. b))) (modify (release_queue_update q))"
-  apply (clarsimp simp: monad_commute_def modify_def get_def put_def bind_def return_def)
-  done
-
-lemma release_queue_modify_tl:
-  "\<lbrakk>(s, s') \<in> state_relation; valid_release_q s; release_queue s \<noteq> []\<rbrakk>
-   \<Longrightarrow> (s\<lparr>release_queue := filter ((\<noteq>) (hd (release_queue s))) (release_queue s)\<rparr>,
-        s'\<lparr>ksReleaseQueue := tl (release_queue s)\<rparr>) \<in> state_relation"
-  apply (clarsimp simp: state_relation_def cdt_relation_def)
-  apply (clarsimp simp: release_queue_relation_def)
-  apply (prop_tac "ksReleaseQueue s' \<noteq> []", fastforce)
-  apply (rule filter_hd_equals_tl)
-   apply (prop_tac "distinct (release_queue s)")
-    apply (clarsimp simp: valid_release_q_def)
-   apply simp+
-  done
-
-lemma ksReleaseQueue_runnable'_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and valid_release_q)
-             (\<lambda>s'. \<forall>t \<in> set (ksReleaseQueue s'). st_tcb_at' runnable' t s')"
-  apply (clarsimp simp: cross_rel_def)
-  apply (clarsimp simp: valid_release_q_def release_queue_relation_def)
-  apply (frule state_relation_release_queue_relation)
-  apply (clarsimp simp: release_queue_relation_def)
-  apply (prop_tac "st_tcb_at runnable t s")
-   apply (fastforce simp: obj_at_kh_kheap_simps)
-  apply (fastforce intro: sts_rel_runnable
-                   dest!: st_tcb_at_coerce_concrete
-                    simp: st_tcb_at'_def obj_at'_def)
-  done
-
-lemma tcbReleaseDequeue_corres:
-  "corres (=) (pspace_aligned and pspace_distinct and valid_release_q and (\<lambda>s. release_queue s \<noteq> []))
-              \<top>
-              tcb_release_dequeue
-              tcbReleaseDequeue"
-   (is "corres _ _ ?conc _ _")
-  apply (rule corres_cross[where Q'="\<lambda>s'. \<forall>t \<in> set (ksReleaseQueue s'). st_tcb_at' runnable' t s'"
-                           , OF ksReleaseQueue_runnable'_cross_rel], blast)
-  apply (clarsimp simp: tcb_release_dequeue_def tcb_release_remove_def tcbReleaseDequeue_def
-                        setReleaseQueue_def tcb_sched_dequeue_def)
-  apply (rule corres_symb_exec_l[rotated 2, OF gets_sp]; (solves wpsimp)?)
-  apply (rename_tac rq)
-  apply (simp add: bind_assoc)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getReleaseQueue_sp])
-   apply (corresKsimp corres: getReleaseQueue_corres)
-
-  apply clarsimp
-  apply (rename_tac rq')
-  apply (rule_tac F="rq' \<noteq> [] \<and> rq' = rq" in corres_req)
-   apply (clarsimp simp: state_relation_def release_queue_relation_def)
-  apply clarsimp
-
-  apply (subst monad_commute_simple'[OF reprogram_timer_update_release_queue_update_monad_commute])
-  apply (rule corres_guard_imp)
-    apply (rule corres_split)
-       apply (rule_tac P="valid_release_q and (\<lambda>s. release_queue s \<noteq> [] \<and> release_queue s = rq)"
-                   and P'="\<lambda>s'. ksReleaseQueue s' \<noteq> []"
-                    in corres_inst)
-       apply (rule corres_modify)
-       apply (fastforce intro: release_queue_modify_tl)
-      apply wpsimp
-      apply (rule corres_add_noop_lhs)
-      apply (rule corres_split[OF threadSet_corres_noop])
-              apply (clarsimp simp: tcb_relation_def)+
-        apply (rule corres_split[OF setReprogramTimer_corres])
-          apply wpsimp+
-  apply (fastforce simp: st_tcb_at'_def)
-  done
-
-lemma tcbInReleaseQueue_update_valid_tcbs'[wp]:
-  "threadSet (tcbInReleaseQueue_update f) tcbPtr \<lbrace>valid_tcbs'\<rbrace>"
-  apply (wpsimp wp: threadSet_valid_tcbs')
-  done
-
-lemma tcbReleaseDequeue_valid_tcbs'[wp]:
-  "tcbReleaseDequeue \<lbrace>valid_tcbs'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseDequeue_def setReleaseQueue_def setReprogramTimer_def)
-  apply ((rule bind_wp_fwd_skip, wpsimp simp: valid_tcbs'_def) | wpsimp)+
-  done
-
-lemma ksReleaseQueue_distinct_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and valid_release_q)
-             (\<lambda>s'. distinct (ksReleaseQueue s'))"
-  apply (clarsimp simp: cross_rel_def)
-  apply (fastforce dest: state_relation_release_queue_relation
-                 intro!: tcb_at_cross
-                   simp: valid_release_q_def release_queue_relation_def vs_all_heap_simps
-                         obj_at_def is_tcb_def)
-  done
-
-lemma ksReleaseQueue_nonempty_cross_rel:
-  "cross_rel (pspace_aligned and pspace_distinct and (\<lambda>s. release_queue s \<noteq> []))
-             (\<lambda>s'. ksReleaseQueue s' \<noteq> [])"
-  apply (clarsimp simp: cross_rel_def)
-   apply (fastforce dest: state_relation_release_queue_relation
-                  intro!: tcb_at_cross
-                    simp: valid_release_q_def release_queue_relation_def vs_all_heap_simps
-                          obj_at_def is_tcb_def)
-  done
-
-lemma isRunnable_no_fail[wp]:
-  "no_fail (tcb_at' tcbPtr) (isRunnable tcbPtr)"
-  apply (wpsimp simp: isRunnable_def)
-  done
-
-lemma awakenBody_corres:
-  "corres dc ((pspace_aligned and pspace_distinct and valid_objs and valid_sched_action
-               and valid_tcbs and valid_release_q and active_scs_valid)
-              and (\<lambda>s. release_queue s \<noteq> []))
-             (valid_objs' and valid_queues and valid_queues' and valid_release_queue_iff)
-             awaken_body
-             awakenBody"
-  (is "corres _ (?pred and _) ?conc _ _")
-  apply (rule corres_cross[where Q'="\<lambda>s'. distinct (ksReleaseQueue s')"
-                           , OF ksReleaseQueue_distinct_cross_rel], blast)
-  apply (rule corres_cross[where Q'="\<lambda>s'. ksReleaseQueue s' \<noteq> []"
-                           , OF ksReleaseQueue_nonempty_cross_rel], blast)
-  apply (rule corres_cross[where Q'="\<lambda>s'. \<forall>t \<in> set (ksReleaseQueue s'). st_tcb_at' runnable' t s'"
-                           , OF ksReleaseQueue_runnable'_cross_rel], blast)
-
-  apply (clarsimp simp: awaken_body_def awakenBody_def)
-  apply (rule corres_symb_exec_r[rotated, OF getReleaseQueue_sp])
-    apply (wpsimp wp: gets_sp simp: getReleaseQueue_def)
-   apply (wpsimp wp: gets_exs_valid
-               simp: getReleaseQueue_def)
-  apply (rule corres_symb_exec_r[rotated, OF assert_inv]; (solves wpsimp)?)
-  apply (rule_tac Q="\<lambda>rv. ?pred and tcb_at rv"
-              and Q'="\<lambda>rv. ?conc and st_tcb_at' runnable' rv"
-               in corres_underlying_split[rotated 2])
-     apply (wpsimp simp: tcb_release_dequeue_def)
-     apply (force simp: valid_release_q_def vs_all_heap_simps obj_at_def is_tcb_def)
-    apply wpsimp
-   apply (corresKsimp corres: tcbReleaseDequeue_corres)
-  apply (rule corres_symb_exec_r[OF _ isRunnable_sp, rotated]; (solves wpsimp)?)
-  apply (rule corres_symb_exec_r[OF _ assert_sp, rotated]; (solves wpsimp)?)
-   apply wpsimp
-   apply (clarsimp simp: st_tcb_at'_def obj_at'_def projectKOs objBitsKO_def)
-   apply (case_tac "tcbState tcb'"; clarsimp)
-  apply (corresKsimp corres: possibleSwitchTo_corres)
-  done
-
-lemma tcbReleaseDequeue_no_fail:
-  "no_fail (\<lambda>s'. (\<forall>tcbPtr \<in> set (ksReleaseQueue s'). tcb_at' tcbPtr s') \<and> ksReleaseQueue s' \<noteq> [])
-           tcbReleaseDequeue"
-  apply (wpsimp simp: tcbReleaseDequeue_def getReleaseQueue_def setReleaseQueue_def
-                      setReprogramTimer_def)
-  done
-
-lemma addToBitmap_no_fail[wp]:
-  "no_fail \<top> (addToBitmap tdom tprio)"
-  apply (wpsimp simp: bitmap_fun_defs)
-  done
-
-lemma tcbSchedEnqueue_no_fail[wp]:
-  "no_fail (tcb_at' tcbPtr) (tcbSchedEnqueue tcbPtr)"
-  apply (clarsimp simp: tcbSchedEnqueue_def)
-  apply (wpsimp wp: hoare_vcg_if_lift2 hoare_drop_imps)
-  done
-
-lemma inReleaseQueue_no_fail[wp]:
-  "no_fail (tcb_at' tcbPtr) (inReleaseQueue tcbPtr)"
-  apply (wpsimp simp: inReleaseQueue_def)
-  done
-
-lemma isSchedulable_no_fail:
-  "no_fail (tcb_at' tcbPtr and valid_objs') (isSchedulable tcbPtr)"
-  apply (clarsimp simp: isSchedulable_def isRunnable_def inReleaseQueue_def)
-  apply (wpsimp wp: no_fail_bind hoare_vcg_imp_lift' hoare_vcg_conj_lift getTCB_wp)
-  apply (fastforce dest: tcb_ko_at_valid_objs_valid_tcb'
-                   simp: valid_tcb'_def)
-  done
-
-lemma rescheduleRequired_no_fail:
-  "no_fail (\<lambda>s'. weak_sch_act_wf (ksSchedulerAction s') s' \<and> valid_objs' s') rescheduleRequired"
-  apply (clarsimp simp: rescheduleRequired_def getSchedulerAction_def isSchedulable_def
-                        setSchedulerAction_def)
-  apply (wpsimp wp: isSchedulable_no_fail hoare_vcg_if_lift2 hoare_drop_imps)
-  apply (clarsimp simp: weak_sch_act_wf_def)
-  done
-
-lemma possibleSwitchTo_no_fail:
-  "no_fail (\<lambda>s'. weak_sch_act_wf (ksSchedulerAction s') s' \<and> valid_objs' s' \<and> tcb_at' tcbPtr s')
-           (possibleSwitchTo tcbPtr)"
-  apply (clarsimp simp: possibleSwitchTo_def inReleaseQueue_def curDomain_def getSchedulerAction_def
-                        setSchedulerAction_def)
-  apply (wpsimp wp: rescheduleRequired_no_fail threadGet_wp simp: setSchedulerAction_def)
-  apply (fastforce simp: obj_at'_def projectKOs objBitsKO_def)
-  done
-
-lemma tcbReleaseDequeue_weak_sch_act_wf[wp]:
-  "tcbReleaseDequeue \<lbrace>\<lambda>s'. weak_sch_act_wf (ksSchedulerAction s') s'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseDequeue_def setReleaseQueue_def setReprogramTimer_def)
-  apply (wpsimp wp: threadSet_wp)
-  apply (fastforce simp: weak_sch_act_wf_def st_tcb_at'_def obj_at'_def projectKOs objBitsKO_def
-                         tcb_in_cur_domain'_def ps_clear_def)
-  done
-
-lemma tcbReleaseQueue_tcb_at'_rv:
-  "\<lbrace>\<lambda>s'. ksReleaseQueue s' \<noteq> [] \<and> tcb_at' (hd (ksReleaseQueue s')) s'\<rbrace>
-   tcbReleaseDequeue
-   \<lbrace>\<lambda>rv. tcb_at' rv\<rbrace>"
-  apply (wpsimp simp: tcbReleaseDequeue_def setReleaseQueue_def)
-  done
-
-lemma awakenBody_no_fail:
-  "no_fail (\<lambda>s'. weak_sch_act_wf (ksSchedulerAction s') s' \<and> valid_objs' s'
-                 \<and> (\<forall>tcbPtr \<in> set (ksReleaseQueue s'). st_tcb_at' runnable' tcbPtr s')
-                 \<and> ksReleaseQueue s' \<noteq> [] \<and> distinct (ksReleaseQueue s'))
-           awakenBody"
-  apply (clarsimp simp: awakenBody_def setReprogramTimer_def)
-  apply (wpsimp wp: possibleSwitchTo_no_fail tcbReleaseDequeue_no_fail tcbReleaseQueue_tcb_at'_rv
-                    hoare_drop_imps
-              simp: getReleaseQueue_def)
-  apply fastforce
-  done
-
-lemma tcbReleaseDequeue_dequeue_inv:
-  "tcbReleaseDequeue \<lbrace>\<lambda>s. tcbPtr \<notin> set (ksReleaseQueue s)\<rbrace>"
-  apply (clarsimp simp: tcbReleaseDequeue_def)
-  apply wpsimp
-  apply (case_tac "ksReleaseQueue s = []"; simp add: list.set_sel(2))
-  done
-
-lemma awaken_corres:
-  "corres dc (pspace_aligned and pspace_distinct and valid_objs and valid_release_q
-              and valid_sched_action and valid_tcbs and active_scs_valid)
-             (\<lambda>s'. weak_sch_act_wf (ksSchedulerAction s') s' \<and> valid_objs' s' \<and> valid_queues s'
-                   \<and> valid_queues' s' \<and> valid_release_queue_iff s')
-             Schedule_A.awaken
-             awaken"
-  apply (rule corres_cross[where Q'="\<lambda>s'. \<forall>t \<in> set (ksReleaseQueue s'). st_tcb_at' runnable' t s'"
-                           , OF ksReleaseQueue_runnable'_cross_rel], blast)
-  apply (rule corres_cross[where Q'="\<lambda>s'. distinct (ksReleaseQueue s')"
-                           , OF ksReleaseQueue_distinct_cross_rel], blast)
-  apply (clarsimp simp: awaken_def Schedule_A.awaken_def runReaderT_def)
-  apply (rule corres_whileLoop; simp)
-       apply (simp add: releaseQNonEmptyAndReady_eq)
-      apply (rule corres_guard_imp)
-        apply (rule awakenBody_corres)
-       apply (fastforce simp: read_release_q_non_empty_and_ready_simp)
-      apply simp
-     apply (clarsimp simp: pred_conj_def)
-     apply (intro hoare_vcg_conj_lift_pre_fix
-            ; (solves \<open>wpsimp simp: Schedule_A.awaken_body_def tcb_release_dequeue_def\<close>)?)
-     apply (wpsimp wp: awaken_body_valid_sched_action)
-     apply (frule valid_release_q_read_release_q_non_empty_and_ready_bound)
-     apply (fastforce dest: read_release_q_non_empty_and_ready_True_simp)
-    apply (wpsimp simp: awakenBody_def runReaderT_def
-                    wp: hoare_vcg_ball_lift2 tcbReleaseDequeue_dequeue_inv hoare_drop_imps)
-    apply (fastforce dest: releaseQNonEmptyAndReady_implies_releaseQNonEmpty)
-   apply (fastforce intro: no_fail_pre awakenBody_no_fail
-                     dest: releaseQNonEmptyAndReady_implies_releaseQNonEmpty)
-  apply (fastforce intro!: awaken_terminates)
-  done
-
-lemma setDeadline_corres:
-  "dl = dl' \<Longrightarrow> corres_underlying Id False True dc \<top> \<top> (setDeadline dl) (setDeadline dl')"
-  by (simp, rule corres_underlying_trivial_gen; wpsimp simp: setDeadline_def)
-
-(* This is not particularly insightful, it just shortens setNextInterrupt_corres *)
-lemma setNextInterrupt_corres_helper:
-  "\<lbrakk>valid_objs' s'; (s, s') \<in> state_relation; active_sc_tcb_at t s;
-    valid_objs s; pspace_aligned s; pspace_distinct s\<rbrakk>
-    \<Longrightarrow> \<exists>tcb. ko_at' tcb t s' \<and> sc_at' (the (tcbSchedContext tcb)) s' \<and>
-        (\<forall>ko. ko_at' ko (the (tcbSchedContext tcb)) s' \<longrightarrow> sc_valid_refills' ko)"
-  apply (subgoal_tac "\<exists>tcb'. ko_at' (tcb'  :: tcb) t s'", clarsimp)
-   apply (clarsimp simp: pred_map_def vs_all_heap_simps)
-   apply (rename_tac tcb' scp tcb sc n)
-   apply (frule_tac pspace_relation_absD, erule state_relation_pspace_relation)
-   apply (clarsimp simp: other_obj_relation_def)
-   apply (subgoal_tac "z = KOTCB tcb'", clarsimp)
-    apply (rule_tac x=tcb' in exI, simp)
-    apply (prop_tac "tcbSchedContext tcb' = Some scp", clarsimp simp: tcb_relation_def, simp)
-    apply (subgoal_tac "sc_at' scp s'", clarsimp)
-     apply (frule_tac x=scp in pspace_relation_absD, erule state_relation_pspace_relation)
-     apply (frule (1) valid_sched_context_size_objsI, clarsimp)
-     apply (subgoal_tac "z = KOSchedContext ko", clarsimp)
-      apply (frule (1) sc_ko_at_valid_objs_valid_sc', clarsimp)
-      apply (clarsimp simp: valid_sched_context'_def sc_relation_def active_sc_def)
-     apply (case_tac z; clarsimp simp: obj_at'_def projectKOs)
-    apply (erule cross_relF [OF _ sc_at'_cross_rel], clarsimp simp: obj_at_def is_sc_obj)
-    apply (erule (1) valid_sched_context_size_objsI)
-   apply (case_tac z; clarsimp simp: obj_at'_def projectKOs)
-  apply (subgoal_tac "tcb_at t s")
-   apply (frule cross_relF [OF _ tcb_at'_cross_rel], clarsimp, assumption)
-   apply (clarsimp simp: obj_at'_def projectKOs)
-  apply (clarsimp simp: obj_at_def vs_all_heap_simps pred_map_def is_tcb)
-  done
-
-lemma setNextInterrupt_corres:
-  "corres dc ((\<lambda>s. active_sc_tcb_at (cur_thread s) s)
-              and (\<lambda>s. \<forall>t \<in> set (release_queue s). active_sc_tcb_at t s)
-              and valid_objs and pspace_aligned and pspace_distinct)
-             valid_objs'
-             set_next_interrupt
-             setNextInterrupt"
-  unfolding setNextInterrupt_def set_next_interrupt_def
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split [OF getCurTime_corres])
-      apply (rule corres_split [OF getCurThread_corres], simp)
-        apply (rule corres_split_eqr[OF get_tcb_obj_ref_corres])
-           apply (clarsimp simp: tcb_relation_def)
-          apply (rule corres_assert_opt_assume_l)
-          apply (rule corres_split [OF get_sc_corres])
-            apply (rule_tac F="sc_valid_refills' rv'" in corres_gen_asm2)
-            apply (rule corres_split [OF corres_if])
-                 apply clarsimp
-                apply (rule corres_split [OF getDomainTime_corres])
-                  apply (simp only: fun_app_def)
-                  apply (rule corres_return_eq_same)
-                  apply (clarsimp simp: refill_hd_relation refill_map_def)
-                 apply wpsimp
-                apply wpsimp
-               apply (rule corres_return_eq_same)
-               apply (clarsimp simp: refill_hd_relation refill_map_def)
-              apply (rule corres_split [OF getReleaseQueue_corres])
-                apply (rule corres_split [OF corres_if], simp)
-                    apply (rule corres_return_eq_same, simp)
-                   apply (rule corres_split_eqr)
-                      apply (simp, rule get_tcb_obj_ref_corres)
-                      apply (clarsimp simp: tcb_relation_def)
-                     apply (rule corres_assert_opt_assume_l)
-                     apply simp
-                     apply (rule corres_split [OF get_sc_corres])
-                       apply (rule_tac F="sc_valid_refills' rv'c" in corres_gen_asm2)
-                       apply (rule corres_return_eq_same)
-                       apply (clarsimp simp: refill_hd_relation refill_map_def)
-                      apply wpsimp
-                     apply wpsimp
-                    apply (wpsimp wp: get_tcb_obj_ref_wp)
-                   apply (wpsimp wp: threadGet_wp)
-                  apply (rule corres_machine_op)
-                  apply (simp del: dc_simp, rule setDeadline_corres, simp)
-                 apply wpsimp+
-         apply (wpsimp wp: get_tcb_obj_ref_wp)
-        apply (wpsimp wp: threadGet_wp)
-       apply wpsimp+
-   apply (fastforce intro!: valid_sched_context_size_objsI
-                      dest: list.set_sel(1)
-                      simp: vs_all_heap_simps obj_at_def is_tcb_def is_sc_obj_def)
-  apply (clarsimp simp: valid_release_q_def)
-  apply (subgoal_tac "(\<exists>tcb. ko_at' tcb (ksCurThread s') s' \<and>
-                    sc_at' (the (tcbSchedContext tcb)) s' \<and>
-                    (\<forall>ko. ko_at' ko (the (tcbSchedContext tcb)) s' \<longrightarrow> sc_valid_refills' ko)) \<and> (ksReleaseQueue s' \<noteq> [] \<longrightarrow> (\<exists>tcb. ko_at' tcb (hd (ksReleaseQueue s')) s' \<and>
-                    sc_at' (the (tcbSchedContext tcb)) s' \<and>
-                    (\<forall>ko. ko_at' ko (the (tcbSchedContext tcb)) s' \<longrightarrow> sc_valid_refills' ko)))")
-   apply (safe, blast, blast)[1]
-   apply (rule_tac x=tcb in exI, simp, safe, blast)[1]
-   apply (prop_tac "ksCurThread s' = cur_thread s", clarsimp simp: state_relation_def, simp)
-  apply (subgoal_tac "(ksReleaseQueue s') = release_queue s", simp)
-   apply (intro conjI impI)
-    apply (rule setNextInterrupt_corres_helper; simp)
-   apply (clarsimp simp: state_relation_def release_queue_relation_def)
-   apply (rule setNextInterrupt_corres_helper; simp?)
-   apply (clarsimp simp: state_relation_def release_queue_relation_def)+
-  done
-
-(* refillUnblockCheck_corres *)
-
-lemma isRoundRobin_corres:
-  "corres (=) (sc_at sc_ptr) (sc_at' sc_ptr)
-              (is_round_robin sc_ptr) (isRoundRobin sc_ptr)"
-  apply (clarsimp simp: is_round_robin_def isRoundRobin_def)
-  apply (corresKsimp corres: get_sc_corres
-                      simp: sc_relation_def)
-  done
-
-lemma refillPopHead_corres:
-  "corres (\<lambda>refill refill'. refill = refill_map refill')
-     (pspace_aligned and pspace_distinct and sc_at sc_ptr
-      and sc_refills_sc_at (\<lambda>refills. 1 < length refills) sc_ptr)
-     (valid_refills' sc_ptr)
-     (refill_pop_head sc_ptr) (refillPopHead sc_ptr)"
-  (is "corres _ ?abs ?conc _ _")
-  supply if_split[split del] opt_pred_def[simp add]
-  apply (rule corres_cross[where Q' = "sc_at' sc_ptr", OF sc_at'_cross_rel], fastforce)
-  apply (clarsimp simp: refill_pop_head_def refillPopHead_def)
-  apply (clarsimp simp: getRefillNext_getSchedContext get_refills_def liftM_def)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (rule corres_guard_imp)
-     apply (rule get_sc_corres)
-    apply simp
-   apply simp
-  apply (rename_tac sc')
-  apply (rule_tac F="refill_hd sc = refill_map (refillHd sc')" in corres_req)
-   apply (clarsimp simp: obj_at_def is_sc_obj obj_at'_def projectKOs)
-   apply (frule (1) pspace_relation_absD[OF _ state_relation_pspace_relation])
-   apply (clarsimp elim!: refill_hd_relation simp: valid_refills'_def opt_map_red)
-  apply (rule corres_guard_imp)
-    apply (rule corres_underlying_split[OF updateSchedContext_corres_gen[where
-                                    P="(\<lambda>s. ((\<lambda>sc. 1 < length (sc_refills sc)) |< scs_of2 s) sc_ptr)"
-                                and P'="valid_refills' sc_ptr"]])
-         apply (clarsimp, drule (2) state_relation_sc_relation)
-         apply (clarsimp simp: sc_relation_def refills_map_def tl_map obj_at_simps is_sc_obj opt_map_red)
-         apply (clarsimp simp: valid_refills'_def opt_map_red)
-         apply (subst tl_wrap_slice; clarsimp simp: min_def split: if_split)
-         apply (rule conjI impI; clarsimp simp: refillNextIndex_def wrap_slice_start_0 split: if_splits)
-        apply (fastforce simp: obj_at_simps is_sc_obj opt_map_red dest!: state_relation_sc_replies_relation_sc)
-        apply clarsimp
-       apply (clarsimp simp: objBits_simps)
-      apply simp
-     apply (wpsimp wp: update_sched_context_wp)
-    apply (wpsimp wp: updateSchedContext_wp)
-   apply (clarsimp simp: sc_refills_sc_at_def obj_at_def opt_map_red)
-  apply simp
-  done
-
-lemma refillPopHead_valid_refills'[wp]:
-  "\<lbrace>\<lambda>s. valid_refills' scPtr' s
-        \<and> (scPtr = scPtr' \<longrightarrow> obj_at' (\<lambda>sc'. Suc 0 < scRefillCount sc') scPtr s)\<rbrace>
-   refillPopHead scPtr
-   \<lbrace>\<lambda>_. valid_refills' scPtr'\<rbrace>"
-  apply (clarsimp simp: refillPopHead_def updateSchedContext_def setSchedContext_def)
-  apply (wpsimp wp: setObject_sc_wp)
-  apply (fastforce simp: valid_refills'_def obj_at'_def projectKOs opt_map_def opt_pred_def
-                         refillNextIndex_def)
-  done
-
-lemma refillHeadOverlapping_simp:
-  "sc_at' sc_ptr s' \<Longrightarrow>
-   refillHeadOverlapping sc_ptr s' =
-    (scs_of' s' ||> (\<lambda>sc'. Suc 0 < scRefillCount sc'
-                           \<and> rTime (scRefills sc' ! (if scRefillHead sc' = scRefillMax sc' - Suc 0
-                                                     then 0 else Suc (scRefillHead sc')))
-                                \<le> rTime (refillHd sc') + rAmount (refillHd sc'))) sc_ptr"
-  unfolding refillHeadOverlapping_def
-  apply (frule no_ofailD[OF no_ofail_readSchedContext])
-  apply (fastforce simp: obind_def omonad_defs oliftM_def obj_at'_def projectKOs readRefillNext_def
-                         readRefillSize_def refillIndex_def opt_map_red readSchedContext_def
-                  dest!: readObject_ko_at'_sc split: option.splits)
-  done
-
-lemma refill_head_overlapping_simp:
-  "sc_at sc_ptr s \<Longrightarrow>
-   refill_head_overlapping sc_ptr s =
-     (scs_of2 s ||> (\<lambda>sc. Suc 0 < length (sc_refills sc)
-                         \<and> r_time (hd (tl (sc_refills sc)))
-                                   \<le> r_time (refill_hd sc) + r_amount (refill_hd sc))) sc_ptr"
-  unfolding refill_head_overlapping_def
-  apply (insert no_ofailD[OF no_ofail_read_sched_context])
-  apply (clarsimp simp: obind_def obj_at_def is_sc_obj opt_map_red
-                 split: option.split)
-  apply (drule_tac x=s and y=sc_ptr in meta_spec2)
-  apply (clarsimp dest!: read_sched_context_SomeD)
-  done
-
-lemma refillHeadOverlapping_corres_eq:
-  "\<lbrakk>(s, s') \<in> state_relation; sc_at sc_ptr s; sc_at' sc_ptr s'; valid_refills' sc_ptr s'\<rbrakk>
-   \<Longrightarrow> refill_head_overlapping sc_ptr s = refillHeadOverlapping sc_ptr s'"
-  apply (frule no_ofailD[OF no_ofail_refillHeadOverlapping])
-  apply (insert refillHeadOverlapping_implies_count_greater_than_one[of sc_ptr s'])
-  apply clarsimp
-  apply (drule (2) state_relation_sc_relation)
-  apply (clarsimp simp: obj_at_simps is_sc_obj)
-  apply (rename_tac b n sc sc')
-  apply (case_tac b;
-         clarsimp simp: refillHeadOverlapping_simp refill_head_overlapping_simp obj_at_simps
-                        is_sc_obj sc_relation_def valid_refills'_def refillHd_def
-                        neq_Nil_lengthI tl_drop_1 hd_drop_conv_nth refills_map_def hd_map
-                        hd_wrap_slice wrap_slice_index refill_map_def opt_map_red opt_pred_def
-                 split: if_split_asm)
-  by linarith+
-
-lemma refillPopHead_scs_of'[wp]:
-  "\<lbrace>\<lambda>s'. P ((scs_of' s')(scp \<mapsto> (\<lambda>sc'. scRefillCount_update (\<lambda>_. scRefillCount sc' - Suc 0)
-                                      (scRefillHead_update
-                                          (\<lambda>_. refillNextIndex (scRefillHead sc') sc') sc'))
-                                        (the (scs_of' s' scp))))\<rbrace>
-  refillPopHead scp
-  \<lbrace>\<lambda>_ s'. P (scs_of' s')\<rbrace>"
-  unfolding refillPopHead_def
-  by (wpsimp wp: updateSchedContext_wp)
-
-crunch update_refill_hd, refill_pop_head, merge_refills, schedule_used, handle_overrun_loop_body
-  for is_active_sc2[wp]: "is_active_sc2 scp"
-  (wp: crunch_wps ignore: update_sched_context
-   simp: crunch_simps update_refill_hd_rewrite update_sched_context_set_refills_rewrite)
-
-lemma merge_refills_scs_of2[wp]:
-  "\<lbrace>\<lambda>s. P ((scs_of2 s)(scp \<mapsto> (\<lambda>sc. sc_refills_update
-            (\<lambda>_. merge_refill (refill_hd sc) (hd (tl (sc_refills sc))) # tl (tl (sc_refills sc))) sc)
-                          (the (scs_of2 s scp)))) \<rbrace>
-   merge_refills scp
-   \<lbrace>\<lambda>_ s. P (scs_of2 s)\<rbrace>"
-  unfolding merge_refills_def
-  apply (wpsimp simp: update_refill_hd_rewrite refill_pop_head_def
-                  wp: get_refills_wp set_refills_wp update_sched_context_wp)
-  by (clarsimp simp: is_active_sc2_def obj_at_def opt_map_red)
-
-(* if the loop guard is true, the refill length is greater than one *)
-lemma mergeRefills_corres:
-  "corres dc (sc_at sc_ptr and pspace_aligned and pspace_distinct
-              and (\<lambda>s. ((\<lambda>sc. 1 < length (sc_refills sc)) |< scs_of2 s) sc_ptr))
-             (valid_refills' sc_ptr)
-             (merge_refills sc_ptr) (mergeRefills sc_ptr)"
-  unfolding mergeRefills_def merge_refills_def merge_refill_def
-  apply (rule corres_cross[where Q' = "sc_at' sc_ptr", OF sc_at'_cross_rel], fastforce)
-  apply (rule_tac Q="\<lambda>s'. ((\<lambda>sc'. 1 < scRefillCount sc') |< scs_of' s') sc_ptr" in corres_cross_add_guard)
-   apply clarsimp
-   apply (drule (2) state_relation_sc_relation)
-   apply (clarsimp simp: sc_relation_def)
-   apply (clarsimp simp: valid_refills'_def obj_at_simps is_sc_obj opt_map_red opt_pred_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF refillPopHead_corres])
-      apply (rule updateRefillHd_corres, simp)
-       apply (clarsimp simp: refill_map_def merge_refill_def)+
-     apply (rule hoare_strengthen_post[where Q'="\<lambda>_. sc_at sc_ptr", rotated])
-      apply (simp add: active_sc_at_equiv is_active_sc_rewrite[symmetric])
-     apply (wpsimp wp: refill_pop_head_sc_active)
-    apply wpsimp
-   apply (clarsimp simp: obj_at_def is_sc_obj opt_map_red is_active_sc_rewrite active_sc_at_equiv
-                         sc_refills_sc_at_rewrite)
-  apply (fastforce simp: valid_refills'_def obj_at_simps opt_map_red opt_pred_def refillNextIndex_def)
-  done
-
-lemma mergeRefills_valid_refills'[wp]:
-  "\<lbrace>(\<lambda>s. ((\<lambda>sc. 1 < scRefillCount sc) |< scs_of' s) scp) and valid_refills' scp\<rbrace>
-   mergeRefills p
-   \<lbrace>\<lambda>_. valid_refills' scp\<rbrace>"
-  unfolding mergeRefills_def
-  apply (wpsimp simp: updateRefillHd_def refillPopHead_def wp: updateSchedContext_wp)
-  by (fastforce simp: valid_refills'_def obj_at_simps refillNextIndex_def opt_map_red opt_pred_def)
-
-lemma no_fail_refillPopHead[wp]:
-  "no_fail (sc_at' scPtr) (refillPopHead scPtr)"
-  by (wpsimp simp: refillPopHead_def obj_at'_def opt_map_def opt_pred_def objBits_simps projectKOs)
-
-crunch mergeRefills
-  for (no_fail) no_fail[wp]
-  (simp: opt_map_red opt_pred_def obj_at_simps)
-
-lemma refillPopHead_length_decreasing:
-  "\<lbrace>\<lambda>s'. ((\<lambda>sc. 0 < scRefillCount sc) |< scs_of' s') scp \<and> s' = s\<rbrace>
-   refillPopHead scp
-   \<lbrace>\<lambda>r' s'. scRefillCount (the (scs_of' s' scp)) < scRefillCount (the (scs_of' s scp))\<rbrace>"
-  unfolding refillPopHead_def
-  apply (simp add: liftM_def bind_assoc refillHd_def)
-  apply (wpsimp wp: updateSchedContext_wp)
-  by (clarsimp simp: obj_at'_def projectKOs opt_map_red opt_pred_def)
-
-lemma mergeRefills_length_decreasing:
-  "\<lbrace>\<lambda>s'. ((\<lambda>sc. 0 < scRefillCount sc) |< scs_of' s') scp \<and> s' = s\<rbrace>
-   mergeRefills scp
-   \<lbrace>\<lambda>r' s'. scRefillCount (the (scs_of' s' scp)) < scRefillCount (the (scs_of' s scp))\<rbrace>"
-  unfolding mergeRefills_def updateRefillHd_def
-  apply (rule bind_wp[OF _ refillPopHead_length_decreasing])
-  by (wpsimp wp: refillPopHead_length_decreasing updateSchedContext_wp)
-
-lemma scRefillCount_wf:
-  "wf {((r', s'), r, s).
-        scRefillCount (the (scs_of' s' sc_ptr))
-         < scRefillCount (the (scs_of' s sc_ptr))}"
-  apply (prop_tac "{((r', s'), r, s). scRefillCount (the (scs_of' s' sc_ptr))
-                                             < scRefillCount (the (scs_of' s sc_ptr))}
-                     = measure (\<lambda>(r, s). scRefillCount (the (scs_of' s sc_ptr)))")
-   apply (clarsimp simp: measure_def inv_image_def split_def)
-  apply (drule sym)
-  apply (erule subst)
-  apply (rule wf_measure)
-  done
-
-lemma mergeRefills_terminates:
-  "sc_at' sc_ptr s' \<Longrightarrow>
-   whileLoop_terminates
-               (\<lambda>_ s'. the (refillHeadOverlapping sc_ptr s'))
-               (\<lambda>_. mergeRefills sc_ptr) r' s'"
-  apply (rule_tac
-           I="\<lambda>_. sc_at' sc_ptr" and
-           R="{((r', s'), (r, s)). scRefillCount (the (scs_of' s' sc_ptr))
-                                    < scRefillCount (the (scs_of' s sc_ptr))}"
-         in whileLoop_terminates_inv)
-    apply simp
-   apply (wpsimp wp: mergeRefills_length_decreasing)
-   apply (fastforce simp: obj_at_simps opt_map_red opt_pred_def
-                   dest!: refillHeadOverlapping_implies_count_greater_than_one)
-  apply (rule scRefillCount_wf)
-  done
-
-lemma refillHeadOverlappingLoop_corres:
-  "corres dc (sc_at sc_ptr and  pspace_aligned and pspace_distinct)
-             (valid_refills' sc_ptr)
-             (refill_head_overlapping_loop sc_ptr) (refillHeadOverlappingLoop sc_ptr)"
-  unfolding refill_head_overlapping_loop_def refillHeadOverlappingLoop_def runReaderT_def
-  supply refillHeadOverlapping_implies_count_greater_than_one[dest!]
-  apply (rule corres_cross[where Q' = "sc_at' sc_ptr", OF sc_at'_cross_rel], fastforce)
-  apply (rule corres_whileLoop)
-        apply (drule refillHeadOverlapping_corres_eq[where sc_ptr=sc_ptr]; simp add: runReaderT_def)
-       apply simp
-       apply (rule corres_guard_imp
-                      [where P=P and Q=P for P,
-                       where
-                          P'= Q and
-                          Q'="Q and (\<lambda>s. ((\<lambda>sc. 1 < scRefillCount sc) |< scs_of' s) sc_ptr)" for Q])
-         apply (rule corres_cross_add_abs_guard
-                       [where Q="(\<lambda>s. ((\<lambda>sc. 1 < length (sc_refills sc)) |< scs_of2 s) sc_ptr)"])
-          apply clarsimp
-          apply (drule (2) state_relation_sc_relation)
-          apply (clarsimp simp: obj_at_simps is_sc_obj valid_refills'_def sc_relation_def
-                                opt_map_red opt_pred_def)
-         apply (rule corres_guard_imp)
-           apply (rule mergeRefills_corres)
-          apply clarsimp+
-      apply (wpsimp+)[4]
-  apply (fastforce intro!: mergeRefills_terminates)
-  done
-
-lemma refillUnblockCheck_corres:
-  "corres dc
-     (sc_at scp and pspace_aligned and pspace_distinct
-      and (\<lambda>s. ((\<lambda>sc. 0 < length (sc_refills sc)) |< scs_of2 s) scp))
-     (valid_refills' scp)
-     (refill_unblock_check scp) (refillUnblockCheck scp)"
-  unfolding refill_unblock_check_def refillUnblockCheck_def
-  apply (rule corres_cross[where Q' = "sc_at' scp", OF sc_at'_cross_rel], fastforce)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_eqr[OF isRoundRobin_corres])
-      apply (rule corres_split_eqr[OF refillReady_corres])
-        apply simp
-        apply (rule corres_when, fastforce)
-        apply (rule corres_split[OF setReprogramTimer_corres])
-          apply (rule corres_split[OF getCurTime_corres])
-            apply (rule corres_split[OF updateRefillHd_corres], simp)
-               apply (clarsimp simp: refill_map_def kernelWCETTicks_def)
-              apply (rule refillHeadOverlappingLoop_corres)
-             apply wpsimp
-            apply (wpsimp wp: getCurTime_wp updateSchedContext_wp
-                        simp: updateRefillHd_def)+
-        apply (wpsimp wp: refillReady_wp is_round_robin_wp isRoundRobin_wp
-                    simp: setReprogramTimer_def)+
-      apply (clarsimp simp: obj_at_simps valid_refills'_def opt_map_red opt_pred_def)
-  done
-
-lemma sporadic_implies_active_cross:
-  "\<lbrakk>(s, s') \<in> state_relation; active_scs_valid s; sc_at scPtr s; ko_at' sc scPtr s';
-    scSporadic sc\<rbrakk>
-   \<Longrightarrow> is_active_sc' scPtr s'"
-  apply (frule (1) state_relation_sc_relation[where ptr=scPtr])
-   apply fastforce
-  apply (clarsimp simp: active_scs_valid_def)
-  apply (drule_tac x=scPtr in spec)+
-  by (fastforce dest: is_sc_objD
-                simp: sc_relation_def vs_all_heap_simps active_sc_def is_active_sc'_def
-                      obj_at_simps opt_map_def opt_pred_def)
-
-lemma ifCondRefillUnblockCheck_corres:
-  "corres dc
-     (\<lambda>s. case_option True
-                      (\<lambda>scp. sc_at scp s \<and> active_scs_valid s
-                           \<and> pspace_aligned s \<and> pspace_distinct s
-                           \<and> (((\<lambda>sc. case_option (sc_active sc) \<top> act) |< scs_of2 s) scp)) scp_opt)
-     (\<lambda>s. case_option True (\<lambda>scp. case_option (valid_refills' scp s) (\<lambda>_. valid_objs' s) act) scp_opt)
-        (if_cond_refill_unblock_check scp_opt act ast) (ifCondRefillUnblockCheck scp_opt act ast)"
-  unfolding if_cond_refill_unblock_check_def ifCondRefillUnblockCheck_def
-  apply (cases scp_opt; simp add: maybeM_def)
-  apply (rename_tac scp)
-  apply (rule corres_cross[OF sc_at'_cross_rel], fastforce)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split[OF get_sc_corres _ get_sched_context_wp getSchedContext_wp])
-    apply (rule corres_split[OF getCurSc_corres])
-      apply (rule corres_when)
-       apply (clarsimp simp: active_sc_def sc_relation_def case_bool_if option.case_eq_if)
-      apply (rule corres_when)
-       apply fastforce
-      apply (rule refillUnblockCheck_corres)
-     apply wpsimp+
-   apply (prop_tac "is_active_sc scp s")
-    apply (cases act; clarsimp)
-     apply (clarsimp simp: vs_all_heap_simps obj_at_kh_kheap_simps opt_map_def opt_pred_def)
-    apply (clarsimp simp: vs_all_heap_simps active_scs_valid_def obj_at_kh_kheap_simps
-                   split: bool.splits)
-    apply (drule_tac x=scp in spec)+
-    apply force
-   apply (drule_tac scp=scp in active_scs_validE[rotated, simplified is_active_sc_rewrite];
-          clarsimp simp: opt_map_red obj_at_def is_active_sc2_def vs_all_heap_simps
-                         valid_refills_def rr_valid_refills_def active_sc_def opt_pred_def
-                  split: if_split_asm)
-  apply (clarsimp simp: case_bool_if option.case_eq_if split: if_split_asm)
-  apply (fastforce elim!: valid_objs'_valid_refills'
-                   dest!: sporadic_implies_active_cross)
-  done
-
-lemma getCurTime_sp:
-  "\<lbrace>P\<rbrace> getCurTime \<lbrace>\<lambda>rv. P and (\<lambda>s. rv = ksCurTime s)\<rbrace>"
-  by (wpsimp simp: getCurTime_def)
-
-lemma ovalid_readRefillReady'[rule_format, simp]:
-  "ovalid (\<lambda>s. sc_at' scp s \<longrightarrow> P (((\<lambda>sc'. rTime (refillHd sc') \<le> ksCurTime s + kernelWCETTicks) |< scs_of' s) scp) s)
-              (readRefillReady scp) P"
-  unfolding readRefillReady_def readSchedContext_def ovalid_def
-  by (fastforce simp: obind_def opt_map_red obj_at'_def projectKOs opt_pred_def
-                dest: use_ovalid[OF ovalid_readCurTime]
-               dest!: readObject_misc_ko_at'
-               split: option.split_asm)+
-
-lemma refillReady_wp':
-  "\<lbrace>\<lambda>s. sc_at' scp s \<longrightarrow>
-        P (((\<lambda>sc'. rTime (refillHd sc') \<le> ksCurTime s + kernelWCETTicks) |< scs_of' s) scp) s\<rbrace>
-   refillReady scp
-   \<lbrace>P\<rbrace>"
-  unfolding refillReady_def
-  by wpsimp (drule use_ovalid[OF ovalid_readRefillReady'])
-
-lemma refillAddTail_corres:
-  "new = refill_map new'
-   \<Longrightarrow> corres dc (sc_at sc_ptr)
-                 (sc_at' sc_ptr and
-                  (\<lambda>s'. ((\<lambda>sc'. scRefillCount sc' < scRefillMax sc' \<and> sc_valid_refills' sc') |< scs_of' s') sc_ptr))
-                 (refill_add_tail sc_ptr new)
-                 (refillAddTail sc_ptr new')"
-  supply projection_rewrites[simp] opt_pred_def[simp add]
-  apply (clarsimp simp: refill_add_tail_def refillAddTail_def getRefillNext_getSchedContext
-                        getRefillSize_def2 liftM_def get_refills_def)
-  apply (rule corres_symb_exec_r[OF _ get_sc_sp', rotated]; (solves wpsimp)?)+
-  apply (rename_tac sc')
-  apply (rule corres_guard_imp)
-    apply (rule corres_assert_assume_r)
-    apply (rule updateSchedContext_corres_gen[where P=\<top>
-                and P'="(\<lambda>s'. ((\<lambda>sc'. scRefillCount sc' < scRefillMax sc' \<and> sc_valid_refills' sc') |< scs_of' s') sc_ptr)"])
-      apply (clarsimp, drule (2) state_relation_sc_relation)
-      apply (clarsimp simp: obj_at_simps is_sc_obj)
-      apply (rename_tac sc')
-      apply (clarsimp simp: sc_relation_def neq_Nil_lengthI opt_map_red)
-      apply (prop_tac "scRefills sc' \<noteq> []")
-       apply (clarsimp simp: neq_Nil_lengthI)
-      apply (clarsimp simp: refills_map_def)
-      apply (subst wrap_slice_append; simp)
-      apply (insert less_linear)[1]
-      apply (drule_tac x="scRefillMax sc'" and y="scRefillHead sc' + scRefillCount sc' + Suc 0" in meta_spec2)
-      apply (erule disjE)
-       apply (simp add: refillNextIndex_def refillTailIndex_def Let_def)
-       apply (intro conjI impI;
-              clarsimp simp: Suc_diff_Suc wrap_slice_updateAt_eq[symmetric] neq_Nil_lengthI
-                             nat_le_Suc_less refill_map_def updateAt_index)
-      apply (erule disjE)
-       apply clarsimp
-       apply (rule conjI)
-        apply (simp add: refillNextIndex_def refillTailIndex_def Let_def)
-        apply (clarsimp simp: wrap_slice_updateAt_eq not_le)
-        apply (metis add_leE le_SucI le_refl lessI mult_is_add.mult_commute not_add_less2 not_less_eq wrap_slice_updateAt_eq)
-       apply (clarsimp simp: refillNextIndex_def refillTailIndex_def Let_def not_le)
-       apply (clarsimp simp: updateAt_index refill_map_def)
-      apply clarsimp
-      apply (rule conjI)
-       apply (clarsimp simp: refillNextIndex_def refillTailIndex_def Let_def)
-       apply (intro conjI impI; (clarsimp simp: not_le wrap_slice_updateAt_eq)?)
-       apply (metis add_leE le_refl le_simps(1) less_SucI mult_is_add.mult_commute nat_neq_iff
-                    not_less_eq trans_less_add2 wrap_slice_updateAt_eq)
-      apply (clarsimp simp: refillNextIndex_def refillTailIndex_def Let_def not_le)
-      apply (clarsimp simp: updateAt_index refill_map_def)
-     apply (fastforce simp: obj_at_simps is_sc_obj opt_map_red
-                     dest!: state_relation_sc_replies_relation_sc)
-    apply (clarsimp simp: objBits_simps)
-   apply (clarsimp simp: obj_at_def is_sc_obj)
-  apply (clarsimp simp: obj_at'_def projectKOs opt_map_red)
-  done
-
-lemma isRoundRobin_sp:
-  "\<lbrace>P\<rbrace>
-   isRoundRobin scPtr
-   \<lbrace>\<lambda>rv s. P s \<and> (\<exists>sc. ko_at' sc scPtr s \<and> rv = (scPeriod sc = 0))\<rbrace>"
-  apply (simp add: isRoundRobin_def)
-  apply (rule bind_wp_fwd)
-   apply (rule get_sc_sp')
-  apply (wp hoare_return_sp)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  done
-
-lemma maybeAddEmptyTail_corres:
-  "corres dc
-          (is_active_sc2 sc_ptr)
-                 (sc_at' sc_ptr and
-                  (\<lambda>s'. ((\<lambda>sc'. scRefillCount sc' < scRefillMax sc' \<and> sc_valid_refills' sc') |< scs_of' s') sc_ptr))
-          (maybe_add_empty_tail sc_ptr)
-          (maybeAddEmptyTail sc_ptr)" (is "corres _ ?abs ?conc _ _")
-  supply projection_rewrites[simp]
-  apply (rule corres_cross_add_abs_guard[where Q="sc_at sc_ptr"])
-   apply (fastforce dest!: sc_at'_cross[OF state_relation_pspace_relation])
-  apply (clarsimp simp: maybe_add_empty_tail_def maybeAddEmptyTail_def get_refills_def)
-  apply (rule corres_underlying_split[rotated 2, OF is_round_robin_sp isRoundRobin_sp])
-   apply (corresKsimp corres: isRoundRobin_corres)
-  apply (clarsimp simp: obj_at_def is_sc_obj)
-  apply (clarsimp simp: when_def)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (corresKsimp corres: get_sc_corres)
-   apply (fastforce intro: valid_objs_valid_sched_context_size
-                     simp: obj_at_def is_sc_obj_def)
-  apply (rename_tac sc')
-  apply (corresKsimp corres: refillAddTail_corres)
-  apply (frule refill_hd_relation; clarsimp simp: obj_at'_def projectKOs opt_map_red opt_pred_def)
-  apply (fastforce dest: valid_objs_valid_sched_context_size
-                   simp: obj_at_def is_sc_obj_def refill_map_def)
-  done
-
-lemma getRefills_sp:
-  "\<lbrace>P\<rbrace>
-   getRefills scPtr
-   \<lbrace>\<lambda>rv s. P s \<and> (\<exists>sc. ko_at' sc scPtr s \<and> (rv = scRefills sc))\<rbrace>"
-  apply (simp add: getRefills_def)
-  apply (rule bind_wp_fwd)
-   apply (rule get_sc_sp')
-  apply (wp hoare_return_sp)
-  apply (clarsimp simp: obj_at'_def projectKOs)
-  done
-
-lemma getCurSc_sp:
-  "\<lbrace>P\<rbrace>
-   getCurSc
-   \<lbrace>\<lambda>rv s. P s \<and> rv = ksCurSc s\<rbrace>"
-  apply (simp add: getCurSc_def)
-  apply (wpsimp wp: hoare_return_sp)
-  done
-
-lemma refillBudgetCheckRoundRobin_corres:
-  "corres dc
-          (cur_sc_active and (\<lambda>s. sc_at (cur_sc s) s))
-          ((\<lambda>s'. valid_refills' (ksCurSc s') s') and (\<lambda>s'. sc_at' (ksCurSc s') s'))
-          (refill_budget_check_round_robin usage) (refillBudgetCheckRoundRobin usage)"
-  supply projection_rewrites[simp]
-  apply (subst is_active_sc_rewrite)
-  apply (clarsimp simp: refill_budget_check_round_robin_def refillBudgetCheckRoundRobin_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurSc_sp])
-   apply (corresKsimp corres: getCurSc_corres)
-  apply (rule_tac Q="\<lambda>s. is_active_sc' (ksCurSc s) s" in corres_cross_add_guard)
-   apply (rule_tac ptr="ksCurSc s'" in is_active_sc'_cross[OF state_relation_pspace_relation]; simp)
-   apply clarsimp
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF updateRefillHd_corres], simp)
-       apply (clarsimp simp: refill_map_def)
-      apply (rule updateRefillTl_corres, simp)
-      apply (clarsimp simp: refill_map_def)
-     apply (wpsimp simp: update_refill_hd_rewrite wp: set_refills_wp get_refills_wp)
-    apply (wpsimp wp: hoare_vcg_conj_lift)
-     apply (wpsimp simp: updateRefillHd_def wp: updateSchedContext_wp)
-    apply (wpsimp wp: updateRefillHd_valid_objs')
-   apply (clarsimp simp: obj_at_def is_active_sc2_def is_sc_obj opt_map_red
-                  split: option.split_asm Structures_A.kernel_object.split_asm)
-  apply (clarsimp simp: obj_at_simps fun_upd_def[symmetric] scBits_simps ps_clear_upd)
-  apply (clarsimp simp: is_active_sc'_def valid_obj'_def valid_sched_context'_def valid_refills'_def
-                        opt_pred_def
-                 split: option.split_asm)
-  done
-
-lemma head_insufficient_length_greater_than_one:
-  "\<lbrakk>the (head_insufficient sc_ptr s);
-    pred_map (\<lambda>cfg. unat MIN_BUDGET \<le> refills_unat_sum (scrc_refills cfg)) (sc_refill_cfgs_of s) sc_ptr\<rbrakk>
-   \<Longrightarrow> pred_map (\<lambda>cfg. Suc 0 < length (scrc_refills cfg)) (sc_refill_cfgs_of s) sc_ptr"
-  apply (frule head_insufficient_true_imp_insufficient)
-   apply (clarsimp simp: vs_all_heap_simps)
-  apply (clarsimp simp: vs_all_heap_simps sc_at_ppred_def refills_unat_sum_def word_less_nat_alt)
-  apply (case_tac "sc_refills y"; fastforce dest!: member_le_sum_list)
-  done
-
-lemma length_sc_refills_cross:
-  "\<lbrakk>(s, s') \<in> state_relation; sc_at scp s; sc_at' scp s'; valid_refills' scp s'\<rbrakk>
-   \<Longrightarrow> ((\<lambda>sc. P (length (sc_refills sc))) |< scs_of2 s) scp
-        = ((\<lambda>sc'. P (scRefillCount sc')) |< scs_of' s') scp"
-  apply (drule (2) state_relation_sc_relation)
-  apply (clarsimp simp: obj_at_simps is_sc_obj valid_refills'_def sc_relation_def opt_map_red
-                        opt_pred_def)
-  done
-
-lemma update_refill_hd_comp:
-  "update_refill_hd scPtr (f \<circ> g)
-   = do update_refill_hd scPtr g;
-        update_refill_hd scPtr f
-     od"
-  apply (clarsimp simp: update_refill_hd_def)
-  apply (rule box_equals[OF update_sched_context_decompose]; fastforce)
-  done
-
-lemma updateRefillHd_valid_refills'[wp]:
-  "updateRefillHd scPtr f \<lbrace>valid_refills' scPtr'\<rbrace>"
-  apply (clarsimp simp: updateRefillHd_def updateSchedContext_def setSchedContext_def)
-  apply (wpsimp wp: setObject_sc_wp)
-  apply (clarsimp simp: valid_refills'_def obj_at'_def projectKOs opt_map_def opt_pred_def)
-  done
-
-lemma updateRefillTl_valid_refills'[wp]:
-  "updateRefillTl scPtr f \<lbrace>valid_refills' scPtr'\<rbrace>"
-  apply (clarsimp simp: updateRefillTl_def updateSchedContext_def setSchedContext_def)
-  apply (wpsimp wp: setObject_sc_wp)
-  apply (clarsimp simp: valid_refills'_def obj_at'_def projectKOs opt_map_def opt_pred_def)
-  done
-
-lemma refill_pop_head_is_active_sc[wp]:
-  "refill_pop_head sc_ptr \<lbrace>is_active_sc sc_ptr'\<rbrace>"
-  apply (wpsimp simp: refill_pop_head_def wp: update_sched_context_wp)
-  apply (clarsimp simp: vs_all_heap_simps obj_at_kh_kheap_simps active_sc_def)
-  done
-
-lemma setSchedContext_is_active_sc_at':
-  "\<lbrace>is_active_sc' scPtr' and K (scPtr' = scPtr \<longrightarrow> 0 < scRefillMax sc)\<rbrace>
-   setSchedContext scPtr sc
-   \<lbrace>\<lambda>_ s. is_active_sc' scPtr' s\<rbrace>"
-  apply (wpsimp wp: set_sc'.set_wp opt_map_red
-              simp: StateRelation.is_active_sc'_def opt_pred_def split: if_splits)
-  done
-
-lemma updateSchedContext_is_active_sc_at':
-  "\<lbrace>is_active_sc' scPtr'
-    and (\<lambda>s. scPtr = scPtr' \<longrightarrow> (\<forall>ko. ko_at' ko scPtr s \<longrightarrow> 0 < scRefillMax ko \<longrightarrow> 0 < scRefillMax (f ko)))\<rbrace>
-   updateSchedContext scPtr f
-   \<lbrace>\<lambda>_. is_active_sc' scPtr'\<rbrace>"
-  apply (simp add: updateSchedContext_def)
-  apply (wpsimp wp: setSchedContext_is_active_sc_at')
-  apply (clarsimp simp: is_active_sc'_def obj_at'_def projectKOs opt_map_red opt_pred_def)
-  done
-
-lemma refillPopHead_is_active_sc_at'[wp]:
-  "refillPopHead scPtr \<lbrace>is_active_sc' scPtr'\<rbrace>"
-  apply (simp add: refillPopHead_def)
-  apply (wpsimp wp: updateSchedContext_is_active_sc_at' getRefillNext_wp)
-  done
-
-lemma nonOverlappingMergeRefills_corres:
-  "sc_ptr = scPtr \<Longrightarrow>
-    corres dc (pspace_aligned and pspace_distinct and sc_at sc_ptr and is_active_sc sc_ptr
-                and valid_objs
-                and (\<lambda>s. pred_map (\<lambda>cfg. Suc 0 < length (scrc_refills cfg)) (sc_refill_cfgs_of s) sc_ptr))
-              (valid_refills' sc_ptr)
-    (non_overlapping_merge_refills sc_ptr)
-    (nonOverlappingMergeRefills scPtr)"
-  apply (clarsimp simp: non_overlapping_merge_refills_def nonOverlappingMergeRefills_def)
-  apply (rule corres_cross[OF sc_at'_cross_rel[where t=scPtr]], simp)
-  apply (rule corres_symb_exec_r[OF _ get_sc_sp', rotated]; (solves wpsimp)?)
-  apply (rule_tac Q="is_active_sc' scPtr" in corres_cross_add_guard)
-   apply (fastforce dest: is_active_sc'2_cross)
-  apply (rule_tac Q="obj_at' (\<lambda>sc'. Suc 0 < scRefillCount sc') scPtr"
-               in corres_cross_add_guard)
-   apply (fastforce dest!: length_sc_refills_cross[where P="\<lambda>l. Suc 0 < l"]
-                     simp: opt_map_red opt_pred_def vs_all_heap_simps obj_at'_def projectKOs)
-  apply (rule corres_symb_exec_r[OF _ assert_sp, rotated])
-    apply wpsimp
-   apply (rule no_fail_pre)
-    apply (rule no_fail_assert)
-   apply (clarsimp simp: no_fail_def obj_at'_def projectKOs)
-
-  apply (rule_tac Q="\<lambda>_. sc_at sc_ptr and is_active_sc sc_ptr"
-              and Q'="\<lambda>_. valid_refills' scPtr and sc_at' scPtr"
-               in corres_underlying_split
-         ; (solves wpsimp)?)
-   apply (corresKsimp corres: refillPopHead_corres
-                       simp: obj_at_def vs_all_heap_simps pred_map_simps sc_at_ppred_def)
-  apply (subst update_refill_hd_comp)
-  apply (rule corres_guard_imp)
-     apply (rule corres_underlying_split[OF updateRefillHd_corres])
-         apply blast
-        apply (clarsimp simp: refill_map_def)
-       apply (fastforce intro: updateRefillHd_corres
-                         simp: refill_map_def)
-      apply (wpsimp simp: update_refill_hd_def wp: update_sched_context_wp)
-      apply (clarsimp simp: vs_all_heap_simps active_sc_def is_active_sc2_def obj_at_def opt_map_def)
-     apply (wpsimp simp: updateRefillHd_def simp: objBits_simps)
-    apply (simp add: is_active_sc_rewrite[symmetric])
-   apply blast
-  done
-
-lemma head_insufficient_simp:
-  "sc_at scp s
-   \<Longrightarrow> head_insufficient scp s = Some (sc_at_pred (\<lambda>sc. r_amount (refill_hd sc) < MIN_BUDGET) scp s)"
-  unfolding head_insufficient_def
-  by (clarsimp simp: obind_def read_sched_context_def obj_at_def is_sc_obj sc_at_pred_n_def)
-
-lemma refillHdInsufficient_simp:
-  "sc_at' scp s
-   \<Longrightarrow> refillHdInsufficient scp s
-       = Some (obj_at' (\<lambda>sc :: sched_context. rAmount (refillHd sc) < minBudget) scp s)"
-  unfolding refillHdInsufficient_def
-  apply (clarsimp simp: obind_def readSchedContext_def split: option.splits)
-  apply (frule no_ofailD[OF no_ofail_sc_at'_readObject])
-  apply (clarsimp simp: obj_at'_def dest!: readObject_misc_ko_at')
-  done
-
-lemma head_insufficient_equiv:
-  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_objs s;
-    pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) scPtr; valid_refills' scPtr s'\<rbrakk>
-   \<Longrightarrow> head_insufficient scPtr s = refillHdInsufficient scPtr s'"
-  apply (prop_tac "sc_at scPtr s")
-   apply (fastforce dest: valid_objs_valid_sched_context_size
-                    simp: vs_all_heap_simps obj_at_kh_kheap_simps is_sc_obj_def)
-  apply (frule state_relation_pspace_relation)
-  apply (frule sc_at_cross; simp?)
-  apply (frule state_relation_sc_relation; simp?)
-  apply (subst head_insufficient_simp; simp?)
-  apply (subst refillHdInsufficient_simp; simp)
-  apply (frule refill_hd_relation)
-   apply (fastforce simp: vs_all_heap_simps valid_refills'_def opt_map_def opt_pred_def obj_at_simps)
-  apply (clarsimp simp: obj_at_def sc_at_ppred_def obj_at'_def projectKOs minBudget_def refill_map_def
-                        MIN_BUDGET_def kernelWCETTicks_def opt_map_def vs_all_heap_simps)
-  done
-
-lemma refill_pop_head_no_fail:
-  "no_fail (\<lambda>s. (\<exists>sc n. kheap s sc_ptr = Some (Structures_A.SchedContext sc n))
-                \<and> pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) sc_ptr)
-           (refill_pop_head sc_ptr)"
-  apply (wpsimp simp: refill_pop_head_def get_refills_def get_sched_context_def
-                  wp: get_object_wp update_sched_context_no_fail)
-  apply (clarsimp simp: obj_at_def a_type_def vs_all_heap_simps is_sc_obj_def)
-  done
-
-lemma refill_pop_head_sched_context_at[wp]:
-  "refill_pop_head sc_ptr' \<lbrace>\<lambda>s. \<exists>sc n. kheap s sc_ptr = Some (Structures_A.SchedContext sc n)\<rbrace>"
-  apply (clarsimp simp: refill_pop_head_def)
-  apply (wpsimp wp: update_sched_context_wp)
-  done
-
-lemma non_overlapping_merge_refills_no_fail:
-  "no_fail (\<lambda>s. (\<exists>sc n. kheap s sc_ptr = Some (Structures_A.SchedContext sc n))
-                \<and> pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) sc_ptr)
-           (non_overlapping_merge_refills sc_ptr)"
-  apply (wpsimp wp: refill_pop_head_no_fail
-              simp: non_overlapping_merge_refills_def update_refill_hd_def)
-  done
-
-lemma non_overlapping_merge_refills_is_active_sc[wp]:
-  "non_overlapping_merge_refills sc_ptr \<lbrace>is_active_sc sc_ptr'\<rbrace>"
-  apply (clarsimp simp: non_overlapping_merge_refills_def update_refill_hd_def)
-  apply (rule bind_wp_fwd_skip, solves wpsimp)
-  apply (wpsimp wp: update_sched_context_wp)
-  apply (clarsimp simp: vs_all_heap_simps obj_at_def)
-  done
-
-crunch non_overlapping_merge_refills
-  for valid_objs[wp]: valid_objs
-
-lemma nonOverLappingMergeRefills_valid_refills'[wp]:
-  "nonOverlappingMergeRefills scPtr \<lbrace>valid_refills' scPtr\<rbrace>"
-  apply (wpsimp simp: nonOverlappingMergeRefills_def)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-definition head_insufficient_loop_measure where
-  "head_insufficient_loop_measure sc_ptr
-     \<equiv> measure (\<lambda>(_, s). case kheap s sc_ptr of Some (Structures_A.SchedContext sc _)
-                                             \<Rightarrow> (length (sc_refills sc)))"
-
-lemma non_overlapping_merge_refills_terminates:
-  "\<lbrakk>pred_map (\<lambda>cfg. refills_unat_sum (scrc_refills cfg) \<le> unat max_time)
-             (sc_refill_cfgs_of s) sc_ptr;
-    pred_map (\<lambda>cfg. unat MIN_BUDGET \<le> refills_unat_sum (scrc_refills cfg))
-             (sc_refill_cfgs_of s) sc_ptr\<rbrakk>
-   \<Longrightarrow> whileLoop_terminates (\<lambda>_ s. the (head_insufficient sc_ptr s))
-                            (\<lambda>_. non_overlapping_merge_refills sc_ptr) r s"
-  (is "\<lbrakk>?P s; ?Q s\<rbrakk> \<Longrightarrow> _")
-  apply (rule_tac I="\<lambda>_. ?P and ?Q"
-               in whileLoop_terminates_inv[where R="head_insufficient_loop_measure sc_ptr"])
-    apply simp
-   apply (intro hoare_vcg_conj_lift_pre_fix)
-    apply (wpsimp wp: non_overlapping_merge_refills_refills_unat_sum_lower_bound
-                      non_overlapping_merge_refills_refills_unat_sum)
-    apply (fastforce dest: head_insufficient_length_at_least_two)
-   apply (wpsimp wp: update_sched_context_wp
-               simp: head_insufficient_loop_measure_def non_overlapping_merge_refills_def
-                     refill_pop_head_def update_refill_hd_def)
-   apply (fastforce dest: head_insufficient_length_at_least_two
-                    simp: vs_all_heap_simps obj_at_def)
-  apply (clarsimp simp: head_insufficient_loop_measure_def)
-  done
-
-lemma refills_unat_sum_MIN_BUDGET_implies_non_empty_refills:
-  "pred_map (\<lambda>cfg. unat MIN_BUDGET \<le> refills_unat_sum (scrc_refills cfg)) (sc_refill_cfgs_of s) sc_ptr
-   \<Longrightarrow> pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) sc_ptr"
-  apply (auto simp: vs_all_heap_simps refills_unat_sum_def MIN_BUDGET_nonzero unat_eq_zero)
-  done
-
-lemma headInsufficientLoop_corres:
-  "sc_ptr = scPtr
-   \<Longrightarrow> corres dc (pspace_aligned and pspace_distinct and sc_at sc_ptr and is_active_sc sc_ptr
-                  and valid_objs
-                  and (\<lambda>s. pred_map (\<lambda>cfg. unat MIN_BUDGET \<le> refills_unat_sum (scrc_refills cfg))
-                                    (sc_refill_cfgs_of s) sc_ptr)
-                  and (\<lambda>s. pred_map (\<lambda>cfg. refills_unat_sum (scrc_refills cfg) \<le> unat max_time)
-                                    (sc_refill_cfgs_of s) sc_ptr))
-                 (valid_refills' sc_ptr)
-                 (head_insufficient_loop sc_ptr)
-                 (headInsufficientLoop scPtr)"
-  apply (clarsimp simp: head_insufficient_loop_def headInsufficientLoop_def runReaderT_def)
-  apply (rule_tac Q="active_sc_at' scPtr" in corres_cross_add_guard)
-   apply (fastforce dest: active_sc_at'_cross)
-  apply (rule corres_whileLoop_abs; simp?)
-      apply (frule head_insufficient_equiv[where scPtr=scPtr]; simp?)
-      apply (fastforce intro: refills_unat_sum_MIN_BUDGET_implies_non_empty_refills)
-     apply (corresKsimp corres: nonOverlappingMergeRefills_corres)
-     apply (fastforce dest: head_insufficient_length_at_least_two)
-    apply (wpsimp wp: non_overlapping_merge_refills_no_fail)
-     apply (wpsimp wp: non_overlapping_merge_refills_refills_unat_sum_lower_bound
-                       non_overlapping_merge_refills_refills_unat_sum)
-    apply (fastforce dest: head_insufficient_length_greater_than_one)
-   apply (wpsimp wp: nonOverlappingMergeRefills_valid_objs')
-  apply (fastforce intro!: non_overlapping_merge_refills_terminates)
-  done
-
-lemma refillEmpty_sp:
-  "\<lbrace>P\<rbrace>refillEmpty scp \<lbrace>\<lambda>rv s. P s \<and> (\<forall>ko. ko_at' ko scp s \<longrightarrow> rv = (scRefillCount ko = 0))\<rbrace>"
-  apply (wpsimp wp: refillEmpty_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma refillFull_sp:
-  "\<lbrace>P\<rbrace> refillFull scp \<lbrace>\<lambda>rv s. P s \<and> (\<forall>ko. ko_at' ko scp s \<longrightarrow> rv = (scRefillCount ko = scRefillMax ko))\<rbrace>"
-  apply (wpsimp wp: refillFull_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma refillFull_corres:
-  "sc_ptr = scPtr
-   \<Longrightarrow> corres (=) (sc_at sc_ptr and pspace_aligned and pspace_distinct)
-                  (valid_refills' scPtr)
-                  (refill_full sc_ptr)
-                  (refillFull scPtr)"
-  apply (rule_tac Q="sc_at' scPtr" in corres_cross_add_guard)
-   apply (fastforce intro: sc_at_cross)
-  apply (clarsimp simp: refill_full_def refillFull_def)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (corresKsimp corres: get_sc_corres)
-  apply (corresKsimp corres: corres_return_eq_same)
-  apply (fastforce simp: sc_relation_def obj_at_simps valid_refills'_def opt_map_red opt_pred_def)
-  done
-
-lemma scheduleUsed_corres:
-  "\<lbrakk>sc_ptr = scPtr; new = refill_map new'\<rbrakk> \<Longrightarrow>
-    corres dc (sc_at sc_ptr and is_active_sc2 sc_ptr and pspace_aligned and pspace_distinct)
-              (valid_refills' scPtr)
-              (schedule_used sc_ptr new)
-              (scheduleUsed scPtr new')"
-  apply (clarsimp simp: schedule_used_def scheduleUsed_def get_refills_def bind_assoc)
-  apply (rule_tac Q="sc_at' scPtr" in corres_cross_add_guard)
-   apply (fastforce intro: sc_at_cross)
-  apply (rule_tac Q="is_active_sc' scPtr" in corres_cross_add_guard)
-   apply (fastforce intro: is_active_sc'_cross)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (corresKsimp corres: get_sc_corres)
-  apply (rename_tac sc sc')
-  apply (rule corres_symb_exec_r[rotated, OF assert_sp]; (solves wpsimp)?)
-   apply wpsimp
-   apply (clarsimp simp: is_active_sc'_def obj_at_simps opt_map_red opt_pred_def)
-  apply (rule corres_symb_exec_r[rotated, OF refillEmpty_sp]
-         ; (solves \<open>wpsimp simp: refillEmpty_def\<close>)?)
-  apply (rule_tac F="empty = (sc_refills sc = [])" in corres_req)
-   apply (fastforce dest: length_sc_refills_cross[where P="\<lambda>l. 0 = l"]
-                    simp: valid_refills'_def obj_at_simps opt_map_red opt_pred_def)
-  apply (rule corres_if_split; (solves simp)?)
-   apply (corresKsimp corres: refillAddTail_corres simp: refill_map_def)
-   apply (clarsimp simp: valid_refills'_def obj_at_simps opt_map_red opt_pred_def)
-  apply (rule_tac F="sc_valid_refills' sc'" in corres_req)
-   apply (clarsimp simp: valid_refills'_def obj_at_simps opt_map_red opt_pred_def)
-  apply (rule corres_if_split; (solves simp)?)
-    apply (fastforce dest: refills_tl_equal
-                     simp: refill_map_def can_merge_refill_def)
-   apply (corresKsimp corres: updateRefillTl_corres
-                       simp: refill_map_def)
-  apply (rule corres_underlying_split[rotated 2, OF refill_full_sp refillFull_sp])
-   apply (corresKsimp corres: refillFull_corres)
-  apply (rule corres_if_split; (solves simp)?)
-   apply (corresKsimp corres: refillAddTail_corres)
-   apply (clarsimp simp: refill_map_def obj_at_simps opt_map_red opt_pred_def)
-  apply (corresKsimp corres: updateRefillTl_corres simp: refill_map_def)
-  done
-
-lemma head_time_buffer_simp:
-  "sc_at (cur_sc s) s
-   \<Longrightarrow> head_time_buffer usage s
-       = Some (sc_at_pred (\<lambda>sc. r_amount (refill_hd sc) \<le> usage
-                                \<and> r_time (refill_hd sc) < MAX_RELEASE_TIME)
-                          (cur_sc s) s)"
-  unfolding head_time_buffer_def
-  apply (clarsimp simp: obind_def read_sched_context_def obj_at_def is_sc_obj sc_at_pred_n_def
-                        ogets_def)
-  done
-
-lemma headTimeBuffer_simp:
-  "sc_at' (ksCurSc s) s
-   \<Longrightarrow> headTimeBuffer usage s
-       = Some (obj_at' (\<lambda>sc :: sched_context. rAmount (refillHd sc) \<le> usage
-                                              \<and> rTime (refillHd sc) < maxReleaseTime)
-                       (ksCurSc s) s)"
-  unfolding headTimeBuffer_def
-  apply (clarsimp simp: obind_def readSchedContext_def split: option.splits)
-  apply (frule no_ofailD[OF no_ofail_sc_at'_readObject])
-  apply (fastforce simp: readObject_def obind_def omonad_defs split_def loadObject_default_def
-                         readCurSc_def obj_at'_def ogets_def
-                  split: option.splits if_split_asm)
-  done
-
-lemma head_time_buffer_equiv:
-  "\<lbrakk>(s, s') \<in> state_relation; pspace_aligned s; pspace_distinct s; valid_objs s;
-    pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) (cur_sc s);
-    valid_refills' (ksCurSc s') s'; usage = usage'\<rbrakk>
-   \<Longrightarrow> head_time_buffer usage s = headTimeBuffer usage' s'"
-  apply (prop_tac "sc_at (cur_sc s) s")
-   apply (fastforce dest: valid_objs_valid_sched_context_size
-                    simp: vs_all_heap_simps obj_at_kh_kheap_simps is_sc_obj_def)
-  apply (frule state_relation_pspace_relation)
-  apply (frule sc_at_cross; simp?)
-  apply (frule state_relation_sc_relation; simp?)
-  apply (subst head_time_buffer_simp; simp?)
-  apply (subst headTimeBuffer_simp)
-   apply (clarsimp simp: state_relation_def)
-  apply (frule refill_hd_relation)
-    apply (clarsimp simp: valid_refills'_def obj_at_simps state_relation_def)
-   apply (clarsimp simp: sc_ko_at_valid_objs_valid_sc' opt_map_def opt_pred_def obj_at_simps)
-  apply (clarsimp simp: obj_at_def sc_at_ppred_def obj_at'_def projectKOs state_relation_def
-                        maxReleaseTime_equiv opt_map_def vs_all_heap_simps refill_map_def)
-  done
-
-lemma refillSingle_sp:
-  "\<lbrace>P\<rbrace>
-   refillSingle scp
-   \<lbrace>\<lambda>rv s. P s \<and> (\<forall>ko. ko_at' ko scp s \<longrightarrow> rv = (scRefillHead ko = refillTailIndex ko))\<rbrace>"
-  apply (clarsimp simp: refillSingle_def)
-  apply wpsimp
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-crunch updateRefillHd, scheduleUsed
-   for valid_sched_context'[wp]: "valid_sched_context' sc"
-
-lemma handleOverrunLoopBody_corres:
-  "r = r'
-   \<Longrightarrow> corres (=) (\<lambda>s. sc_at (cur_sc s) s \<and> is_active_sc2 (cur_sc s) s
-                       \<and> pspace_aligned s \<and> pspace_distinct s
-                       \<and> pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) (cur_sc s))
-                  (\<lambda>s'. valid_refills' (ksCurSc s') s')
-                  (handle_overrun_loop_body r)
-                  (handleOverrunLoopBody r')"
-  apply (rule_tac Q="\<lambda>s'. sc_at' (ksCurSc s') s'" in corres_cross_add_guard)
-   apply (fastforce intro: sc_at_cross simp: state_relation_def)
-  apply (rule_tac Q="\<lambda>s'. is_active_sc' (ksCurSc s') s'" in corres_cross_add_guard)
-   apply (fastforce intro: is_active_sc'_cross simp: state_relation_def)
-  apply (clarsimp simp: handle_overrun_loop_body_def handleOverrunLoopBody_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurSc_sp])
-   apply (corresKsimp corres: getCurSc_corres)
-  apply (rule corres_underlying_split[rotated 2, OF refill_single_sp refillSingle_sp])
-   apply (corresKsimp corres: refillSingle_corres)
-   apply (fastforce simp: obj_at_simps valid_refills'_def opt_map_red opt_pred_def)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (corresKsimp corres: get_sc_corres)
-  apply (rename_tac sc sc')
-  apply (rule_tac Q="\<lambda>_ s. sc_refills sc \<noteq> []"
-              and Q'="\<lambda>_ _. sc_valid_refills' sc'"
-              and r'=dc
-               in corres_underlying_split[rotated])
-     apply corresKsimp
-     apply (fastforce dest: refill_hd_relation simp: refill_map_def)
-    apply (wpsimp simp: update_refill_hd_def
-                    wp: update_sched_context_wp)
-    apply (clarsimp simp: vs_all_heap_simps obj_at_def)
-   apply wpsimp
-   apply (clarsimp simp: valid_refills'_def obj_at_simps opt_map_red opt_pred_def)
-  apply (rule corres_if_split; simp?)
-   apply (corresKsimp corres: updateRefillHd_corres)
-   apply (fastforce simp: refill_map_def sc_relation_def)
-  apply (rule_tac F="1 < scRefillCount sc'" in corres_req)
-   apply (frule_tac scp="scPtr" and P="\<lambda>l. 1 < l" in length_sc_refills_cross)
-      apply (clarsimp simp: state_relation_def)
-     apply simp
-    apply (fastforce simp: refill_map_def sc_relation_def)
-   apply (clarsimp simp: opt_map_red opt_pred_def vs_all_heap_simps obj_at'_def projectKOs Suc_lessI)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF refillPopHead_corres])
-      apply (rule scheduleUsed_corres)
-       apply simp
-      apply (clarsimp simp: refill_map_def sc_relation_def)
-     apply wpsimp
-    apply wpsimp
-   apply (clarsimp simp: is_active_sc2_def sc_at_ppred_def obj_at_def is_sc_obj_def active_sc_def
-                         vs_all_heap_simps opt_map_red Suc_lessI)
-  apply (clarsimp simp: obj_at_simps)
-  done
-
-lemma schedule_used_no_fail[wp]:
-  "no_fail (\<lambda>s. (\<exists>sc n. kheap s sc_ptr = Some (Structures_A.SchedContext sc n)))
-           (schedule_used sc_ptr new)"
-  apply (wpsimp simp: schedule_used_defs get_refills_def refill_full_def
-                  wp: update_sched_context_wp)
-  done
-
-lemma handle_overrun_loop_body_no_fail:
-  "no_fail (\<lambda>s. (\<exists>sc n. kheap s (cur_sc s) = Some (Structures_A.SchedContext sc n))
-                \<and> pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) (cur_sc s))
-           (handle_overrun_loop_body usage)"
-  unfolding handle_overrun_loop_body_def
-  apply (wpsimp simp: refill_single_def refill_size_def get_refills_def update_refill_hd_def
-                  wp: refill_pop_head_no_fail)
-  done
-
-lemma scheduleUsed_is_active_sc'[wp]:
-  "scheduleUsed scPtr new \<lbrace>is_active_sc' sc_Ptr'\<rbrace>"
-  apply (clarsimp simp: scheduleUsed_def)
-  apply (wpsimp simp: refillAddTail_def updateRefillTl_def
-                  wp: updateSchedContext_wp refillFull_wp refillEmpty_wp)
-  apply (clarsimp simp: obj_at_simps is_active_sc'_def opt_map_def opt_pred_def)
-  done
-
-lemma handleOverrunLoopBody_is_active_sc'[wp]:
-  "handleOverrunLoopBody usage \<lbrace>is_active_sc' sc_ptr\<rbrace>"
-  apply (clarsimp simp: handleOverrunLoopBody_def)
-  apply (wpsimp simp: updateRefillHd_def refillSingle_def
-                  wp: updateSchedContext_wp)
-  apply (clarsimp simp: obj_at_simps is_active_sc'_def opt_map_def opt_pred_def)
-  done
-
-lemma refillAddTail_valid_refills'[wp]:
-  "refillAddTail scPtr refill \<lbrace>valid_refills' ptr\<rbrace>"
-  apply (clarsimp simp: refillAddTail_def)
-  apply (wpsimp wp: updateSchedContext_wp)
-  apply (clarsimp simp: valid_refills'_def obj_at_simps opt_map_red opt_pred_def)
-  done
-
-lemma scheduleUsed_valid_refills'[wp]:
-  "scheduleUsed ptr new \<lbrace>valid_refills' scPtr\<rbrace>"
-  apply (clarsimp simp: scheduleUsed_def)
-  apply (wpsimp wp: refillFull_wp refillEmpty_wp)
-  done
-
-crunch handle_overrun_loop_body
-  for valid_objs[wp]: valid_objs
-
-lemma handleOverrunLoopBody_valid_refills'[wp]:
-  "handleOverrunLoopBody r'  \<lbrace>valid_refills' scPtr\<rbrace>"
-  apply (clarsimp simp: handleOverrunLoopBody_def updateRefillHd_def refillSingle_def)
-  apply wpsimp
-  apply (fastforce simp: valid_refills'_def opt_map_red opt_pred_def obj_at_simps
-                         refillSingle_equiv[THEN arg_cong_Not, symmetric])
-  done
-
-lemma schedule_used_length_nonzero[wp]:
-  "\<lbrace>\<lambda>s. if sc_ptr' = sc_ptr
-        then pred_map \<top> (scs_of s) sc_ptr
-        else pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) sc_ptr\<rbrace>
-   schedule_used sc_ptr' new
-   \<lbrace>\<lambda>_ s. pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) sc_ptr\<rbrace>"
-  apply (wpsimp wp: update_sched_context_wp get_refills_wp
-              simp: schedule_used_defs)
-  apply (clarsimp simp: obj_at_def vs_all_heap_simps)
-  done
-
-lemma handle_overrun_loop_body_terminates_wf_helper:
-  "wf {((r' :: ticks, s' :: 'a state), (r, s)). unat r' < unat r}"
-  apply (insert wf_inv_image[where r="{(m, n). m < n}"
-                               and f="\<lambda>(r :: ticks, s :: 'a state). unat r"])
-  apply (clarsimp simp: inv_image_def)
-  apply (prop_tac "wf {(m, n). m < n}")
-   apply (fastforce intro: wf)
-  apply (drule meta_mp, simp)
-  apply (prop_tac "{(x :: ticks \<times> 'a state, y :: ticks \<times> 'a state).
-                     (case x of (r, s) \<Rightarrow> unat r)
-                      < (case y of (r, s) \<Rightarrow> unat r)}
-                   = {((r, s), r', s'). unat r < unat r'}")
-    apply fastforce
-  apply fastforce
-  done
-
-\<comment> \<open>The following method can be used to try to solve Hoare triples in the following way.
-    Note that the method works best when the precondition is not schematic.
-    First, if the postcondition is not a conjunction, it will try to solve the goal with the
-    method given to `solves`. The goal will be left untouched if it cannot solve the goal.
-    If the postcondition is a conjunction, the method will pull it apart into all the conjuncts
-    using hoare_vcg_conj_lift_pre_fix. It will then attempt to solve each of these individually.\<close>
-method wps_conj_solves uses wp simp wps
-   = (clarsimp simp: pred_conj_def)?
-     , (intro hoare_vcg_conj_lift_pre_fix
-        ; (solves \<open>rule hoare_weaken_pre, (wpsimp wp: wp simp: simp | wps wps)+\<close>)?)
-       | (solves \<open>rule hoare_weaken_pre, (wpsimp wp: wp simp: simp | wps wps)+\<close>)?
-
-lemma handle_overrun_loop_body_terminates:
-  "\<lbrakk>sc_at (cur_sc s) s;
-    pred_map (\<lambda>cfg. \<forall>refill \<in> set (scrc_refills cfg). 0 < unat (r_amount refill))
-             (sc_refill_cfgs_of s) (cur_sc s);
-    pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) (cur_sc s);
-    pred_map (\<lambda>cfg. refills_unat_sum (scrc_refills cfg) = unat (scrc_budget cfg))
-             (sc_refill_cfgs_of s) (cur_sc s)\<rbrakk>
-   \<Longrightarrow> whileLoop_terminates (\<lambda>r s. the (head_time_buffer r s)) handle_overrun_loop_body usage s"
-  (is "\<lbrakk>?P1 s; ?P2 s; ?P3 s; ?P4 s\<rbrakk> \<Longrightarrow> _")
-  apply (rule_tac R="{((r' :: ticks, s' :: 'a state), (r, s)). unat r' < unat r}"
-              and I="\<lambda>_ s'. ?P1 s' \<and> ?P2 s' \<and> ?P3 s' \<and> ?P4 s' \<and> cur_sc s' = cur_sc s"
-               in whileLoop_terminates_inv)
-    apply simp
-   prefer 2
-   apply (fastforce simp: handle_overrun_loop_body_terminates_wf_helper)
-  apply (rename_tac r s')
-  apply (wps_conj_solves wp: handle_overrun_loop_body_non_zero_refills
-                             handle_overrun_loop_body_refills_unat_sum_equals_budget)
-   apply (wpsimp simp: handle_overrun_loop_body_def)
-  apply (rename_tac sc n)
-  apply (subst unat_sub)
-   apply (prop_tac "sc_at (cur_sc s') s'", simp)
-   apply (frule_tac usage=r and s=s' in head_time_buffer_simp)
-   apply (clarsimp simp: sc_at_ppred_def obj_at_def)
-  apply (clarsimp simp: obj_at_def vs_all_heap_simps)
-  apply (frule_tac x="refill_hd sc" in bspec, fastforce)
-  apply (prop_tac "0 < unat r")
-   apply (prop_tac "sc_at (cur_sc s') s'")
-    apply (clarsimp simp: obj_at_def is_sc_obj_def)
-   apply (frule_tac usage=r and s=s' in head_time_buffer_simp)
-   apply (clarsimp simp: sc_at_ppred_def obj_at_def)
-   apply (frule_tac x="refill_hd sc" in bspec, fastforce)
-   apply (fastforce simp: word_le_nat_alt)
-  apply fastforce
-  done
-
-lemma handleOverrunLoop_corres:
-  "usage = usage' \<Longrightarrow>
-   corres (=) (\<lambda>s. sc_at (cur_sc s) s \<and> is_active_sc2 (cur_sc s) s
-                   \<and> pspace_aligned s \<and> pspace_distinct s
-                   \<and> valid_objs s
-                   \<and> pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> []) (sc_refill_cfgs_of s) (cur_sc s)
-                   \<and> pred_map (\<lambda>cfg. \<forall>refill\<in>set (scrc_refills cfg). 0 < unat (r_amount refill))
-                               (sc_refill_cfgs_of s) (cur_sc s)
-                   \<and> pred_map (\<lambda>cfg. refills_unat_sum (scrc_refills cfg) = unat (scrc_budget cfg))
-                               (sc_refill_cfgs_of s) (cur_sc s))
-              (\<lambda>s'. valid_refills' (ksCurSc s') s')
-              (handle_overrun_loop usage)
-              (handleOverrunLoop usage')"
-  apply (rule_tac Q="\<lambda>s'. sc_at' (ksCurSc s') s'" in corres_cross_add_guard)
-   apply (fastforce intro: sc_at_cross simp: state_relation_def)
-  apply (rule_tac Q="\<lambda>s'. is_active_sc' (ksCurSc s') s'" in corres_cross_add_guard)
-   apply (fastforce intro: is_active_sc'_cross simp: state_relation_def)
-  apply (clarsimp simp: handle_overrun_loop_def handleOverrunLoop_def runReaderT_def)
-  apply (rule corres_whileLoop_abs; simp?)
-      apply (frule_tac usage=r' in head_time_buffer_equiv; simp?)
-      apply fastforce
-     apply (corresKsimp corres: handleOverrunLoopBody_corres)
-    apply (wps_conj_solves wp: handle_overrun_loop_body_non_zero_refills
-                               handle_overrun_loop_body_refills_unat_sum_equals_budget)
-   apply wps_conj_solves
-  apply (fastforce intro:  handle_overrun_loop_body_terminates)
-  done
-
-lemma handle_overrun_loop_is_active_sc[wp]:
-  "handle_overrun_loop usage \<lbrace>\<lambda>s. is_active_sc sc_ptr s\<rbrace>"
-  apply handle_overrun_loop_simple
-  done
-
-lemma get_refills_exs_valid[wp]:
-  "sc_at sc_ptr s \<Longrightarrow> \<lbrace>(=) s\<rbrace> get_refills sc_ptr \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
-  apply (clarsimp simp: get_refills_def)
-  apply (wpsimp wp: get_sched_context_exs_valid)
-   apply (erule sc_atD1)
-  apply simp
-  done
-
-crunch handleOverrunLoop
-  for valid_refills'[wp]: "valid_refills' scPtr"
-  (wp: crunch_wps)
-
-lemma refillBudgetCheck_corres:
-  "usage = usage'
-   \<Longrightarrow> corres dc ((\<lambda>s. sc_at (cur_sc s) s \<and> is_active_sc (cur_sc s) s
-                       \<and> valid_objs s
-                       \<and> pspace_aligned s \<and> pspace_distinct s)
-                  and (\<lambda>s. \<not> round_robin (cur_sc s) s \<and> valid_refills (cur_sc s) s))
-                 (\<lambda>s'. valid_refills' (ksCurSc s') s')
-                 (refill_budget_check usage)
-                 (refillBudgetCheck usage')"
-  (is "_ \<Longrightarrow> corres _ (?P and _) _ _ _")
-  apply (rule_tac Q="\<lambda>s'. sc_at' (ksCurSc s') s'" in corres_cross_add_guard)
-   apply (fastforce intro: sc_at_cross simp: state_relation_def)
-  apply (rule_tac Q="\<lambda>s'. is_active_sc' (ksCurSc s') s'" in corres_cross_add_guard)
-   apply (fastforce intro!: is_active_sc'2_cross simp: state_relation_def)
-
-  apply (clarsimp simp: refill_budget_check_def refillBudgetCheck_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurSc_sp])
-   apply (corresKsimp corres: getCurSc_corres)
-  apply (rule corres_symb_exec_r[rotated, OF scActive_sp]; (solves \<open>wpsimp simp: scActive_def\<close>)?)
-  apply (rule corres_symb_exec_r[rotated, OF assert_sp]; (solves wpsimp)?)
-   apply (wpsimp wp: no_fail_assert
-               simp: is_active_sc'_def opt_map_red opt_pred_def obj_at_simps)
-  apply (rule corres_underlying_split[rotated 2, OF is_round_robin_sp isRoundRobin_sp])
-   apply (corresKsimp corres: isRoundRobin_corres)
-  apply (rule corres_symb_exec_l[rotated, OF _  assert_sp]; (solves wpsimp)?)
-  apply (rule_tac F="\<not>roundRobin" in corres_req)
-   apply clarsimp
-  apply (rule corres_symb_exec_r[rotated, OF assert_sp]; (solves wpsimp)?)
-
-  apply (rule_tac Q="\<lambda>usage' s. ?P s
-                                \<and> pred_map (\<lambda>cfg. refills_unat_sum (scrc_refills cfg)
-                                                   = unat (scrc_budget cfg))
-                                           (sc_refill_cfgs_of s) sc_ptr
-                                \<and> pred_map (\<lambda>cfg. MIN_BUDGET \<le> scrc_budget cfg)
-                                            (sc_refill_cfgs_of s) sc_ptr
-                                \<and> sc_ptr = cur_sc s
-                                \<and> (pred_map (\<lambda>cfg. r_time (hd (scrc_refills cfg)) < MAX_RELEASE_TIME)
-                                             (sc_refill_cfgs_of s) (cur_sc s)
-                                   \<longrightarrow> pred_map (\<lambda>cfg. usage' < r_amount (hd (scrc_refills cfg)))
-                                                (sc_refill_cfgs_of s) (cur_sc s))
-                                \<and> pred_map (\<lambda>cfg. scrc_refills cfg \<noteq> [])
-                                            (sc_refill_cfgs_of s) sc_ptr"
-               and Q'="\<lambda>_ s'. valid_refills' scPtr s' \<and> active_sc_at' scPtr s' \<and> scPtr = ksCurSc s'"
-               in corres_underlying_split)
-     apply (corresKsimp corres: handleOverrunLoop_corres)
-     apply (fastforce intro: valid_refills_refills_unat_sum_equals_budget
-                       simp: vs_all_heap_simps cfg_valid_refills_def round_robin_def
-                             sp_valid_refills_def is_active_sc_rewrite[symmetric])
-    apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> handle_overrun_loop _ \<lbrace>Q\<rbrace>" for P Q \<Rightarrow> -\<close>)
-    apply (clarsimp simp: pred_conj_def)
-    apply (intro hoare_vcg_conj_lift_pre_fix; (solves handle_overrun_loop_simple)?)
-      apply wps_conj_solves
-     apply (wpsimp wp: handle_overrun_loop_refills_unat_sum_equals_budget)
-     apply (fastforce intro: valid_refills_refills_unat_sum_equals_budget
-                       simp: vs_all_heap_simps cfg_valid_refills_def round_robin_def
-                             sp_valid_refills_def)
-    apply (clarsimp simp: handle_overrun_loop_def)
-    apply (wpsimp wp: valid_whileLoop[where I="\<lambda>_ s. pred_map \<top> (scs_of s) (cur_sc s)"])
-     apply (fastforce simp: head_time_buffer_true_imp_unat_buffer vs_all_heap_simps
-                            word_less_nat_alt word_le_nat_alt)
-    apply (clarsimp simp: vs_all_heap_simps)
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> handleOverrunLoop _ \<lbrace>Q\<rbrace>" for P Q \<Rightarrow> -\<close>)
-   apply wpsimp
-   apply (clarsimp simp: active_sc_at'_def obj_at_simps)
-
-  apply (clarsimp simp: get_refills_def)
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (corresKsimp corres: get_sc_corres
-                       simp: state_relation_def active_sc_at'_def obj_at_simps)
-  apply (rename_tac sc sc')
-  apply (rule_tac Q="\<lambda>_ s. ?P s
-                           \<and> pred_map (\<lambda>cfg. refills_unat_sum (scrc_refills cfg)
-                                              = unat (scrc_budget cfg))
-                                       (sc_refill_cfgs_of s) scPtr
-                           \<and> pred_map (\<lambda>cfg. MIN_BUDGET \<le> scrc_budget cfg)
-                                       (sc_refill_cfgs_of s) scPtr
-                           \<and> scPtr = cur_sc s"
-              and Q'="\<lambda>_ s'. valid_refills' scPtr s' \<and> active_sc_at' scPtr s' \<and> scPtr = ksCurSc s'"
-              and r'=dc
-               in corres_underlying_split[rotated])
-     apply (corresKsimp corres: headInsufficientLoop_corres)
-     apply (fastforce simp: vs_all_heap_simps word_le_nat_alt)
-    apply (intro hoare_vcg_conj_lift_pre_fix; (solves wpsimp)?)
-       apply schedule_used_simple
-       apply (clarsimp simp: obj_at_def is_sc_obj_def)
-      apply schedule_used_simple
-     apply (wpsimp wp: schedule_used_refills_unat_sum update_sched_context_wp
-                 simp: update_refill_hd_def)
-     apply (clarsimp simp: obj_at_def vs_all_heap_simps refills_unat_sum_cons
-                           refills_unat_sum_append)
-     apply (subst unat_sub)
-      apply fastforce
-     apply (clarsimp simp: word_less_nat_alt)
-     apply (drule less_imp_le)
-     apply (clarsimp simp: refills_unat_sum_def)
-     apply (case_tac "sc_refills sc"; clarsimp simp: refills_unat_sum_cons)
-    apply schedule_used_simple
-   apply wpsimp
-
-  apply (rule_tac F="refill_hd sc = refill_map (refillHd sc')" in corres_req)
-   apply clarsimp
-   apply (rule refill_hd_relation)
-     apply fastforce
-    apply (clarsimp simp: vs_all_heap_simps obj_at_def)
-   apply (fastforce simp: valid_refills'_def obj_at_simps opt_map_red opt_pred_def)
-
-  apply (clarsimp simp: maxReleaseTime_equiv)
-  apply (simp add: when_def split del: if_split)
-  apply (rule corres_if_split; (solves simp)?)
-   apply (clarsimp simp: refill_map_def)
-  apply (rule corres_symb_exec_l[rotated 2, OF get_sched_context_sp])
-    apply wpsimp
-    apply (clarsimp simp: obj_at_def)
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<exists>\<lbrace>Q\<rbrace>" for P f Q \<Rightarrow> -\<close>)
-   apply (wpsimp wp: get_sched_context_exs_valid)
-    apply (clarsimp simp: obj_at_def)
-   apply simp
-  apply (rename_tac new_sc)
-  apply (rule_tac F="new_sc=sc" in corres_req)
-   apply (clarsimp simp: obj_at_def)
-  apply (subst update_refill_hd_comp)
-  apply (clarsimp simp: bind_assoc)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF updateRefillHd_corres])
-        apply simp
-       apply (clarsimp simp: refill_map_def)
-      apply (rule corres_split[OF updateRefillHd_corres])
-          apply simp
-         apply (clarsimp simp: refill_map_def)
-        apply (rule scheduleUsed_corres)
-         apply simp
-        apply (clarsimp simp: refill_map_def sc_relation_def)
-       apply wpsimp
-      apply wpsimp
-     apply wpsimp
-    apply wpsimp
-   apply (clarsimp simp: is_active_sc_rewrite)
-  apply (fastforce simp: active_sc_at'_def is_active_sc'_def obj_at_simps opt_map_red)
-  done
-
-(* schedule_corres *)
-
-crunch setReprogramTimer
-  for valid_tcbs'[wp]: valid_tcbs'
-  and valid_refills'[wp]: "valid_refills' scPtr"
-  and ksCurSc[wp]: "\<lambda>s. P (ksCurSc s)"
-  (simp: valid_refills'_def)
-
-lemma checkDomainTime_corres:
-  "corres dc (valid_tcbs and weak_valid_sched_action and active_scs_valid and pspace_aligned
-              and pspace_distinct)
-             (valid_tcbs' and valid_queues and valid_queues' and valid_release_queue_iff)
-             check_domain_time
-             checkDomainTime"
-  apply (clarsimp simp: check_domain_time_def checkDomainTime_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF isCurDomainExpired_corres])
-      apply (rule corres_when)
-       apply simp
-      apply (rule corres_split[OF setReprogramTimer_corres])
-        apply (rule rescheduleRequired_corres)
-       apply (wpsimp wp: hoare_drop_imps
-                   simp: isCurDomainExpired_def)+
-  done
-
-crunch refill_budget_check_round_robin
-  for sc_at[wp]: "sc_at sc_ptr"
-  and valid_objs[wp]: valid_objs
-  and pspace_aligned[wp]: pspace_aligned
-  and pspace_distinct[wp]: pspace_distinct
-
-lemma commitTime_corres:
-  "corres dc (\<lambda>s. sc_at (cur_sc s) s \<and> valid_objs s \<and> pspace_aligned s \<and> pspace_distinct s
-                  \<and> (cur_sc_active s \<longrightarrow> valid_refills (cur_sc s) s))
-             (\<lambda>s'. is_active_sc' (ksCurSc s') s' \<longrightarrow> valid_refills' (ksCurSc s') s')
-             commit_time
-             commitTime"
-  supply if_split[split del]
-  apply (rule_tac Q="\<lambda>s'. sc_at' (ksCurSc s') s'" in corres_cross_add_guard)
-   apply (fastforce intro: sc_at_cross simp: state_relation_def)
-  apply (clarsimp simp: commit_time_def commitTime_def liftM_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurSc_sp])
-   apply (corresKsimp corres: getCurSc_corres)
-  apply clarsimp
-  apply (rule corres_underlying_split[rotated 2, OF get_sched_context_sp get_sc_sp'])
-   apply (corresKsimp corres: get_sc_corres)
-  apply (rule corres_symb_exec_r[rotated, OF getIdleSC_sp])
-    apply wpsimp
-   apply (wpsimp simp: getIdleSC_def)
-  apply (rename_tac idleSCPtr)
-  apply (rule corres_underlying_split[rotated, where r'=dc])
-     apply (rule setConsumedTime_corres)
-     apply simp
-    apply wpsimp
-   apply wpsimp
-  apply (clarsimp simp: when_def)
-  apply (rule_tac F="idleSCPtr = idle_sc_ptr" in corres_req)
-   apply (clarsimp simp: state_relation_def)
-  apply (rule corres_if_split; fastforce?)
-   apply (fastforce simp: sc_relation_def active_sc_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getConsumedTime_sp])
-   apply corresKsimp
-  apply clarsimp
-  apply (rename_tac consumed)
-  apply (rule_tac Q="\<lambda>_ s. sc_at (cur_sc s) s \<and> csc = cur_sc s"
-              and Q'="\<lambda>_ s'. sc_at' (ksCurSc s') s' \<and> csc = ksCurSc s'"
-              and r'=dc
-               in corres_underlying_split[rotated])
-     apply (clarsimp simp: updateSchedContext_def)
-     apply (rule corres_symb_exec_r[rotated, OF get_sc_sp'])
-       apply wpsimp
-      apply wpsimp
-     apply (rename_tac sc')
-     apply (prop_tac "(\<lambda>sc. sc\<lparr>sc_consumed := sc_consumed sc + consumed\<rparr>)
-                      = sc_consumed_update (\<lambda>c. c + consumed)")
-      apply force
-     apply (prop_tac "scConsumed_update (\<lambda>_. scConsumed sc' + consumed) sc'
-                      = scConsumed_update (\<lambda>c. c + consumed) sc'")
-      apply (fastforce intro: sched_context.expand)
-     apply (rule_tac P="\<lambda>t. corres dc _ _ (update_sched_context csc t) _" in subst[OF sym])
-      apply assumption
-     apply (rule_tac P="\<lambda>t. corres dc _ _ _ (setSchedContext csc t)" in subst[OF sym])
-      apply assumption
-     apply (rule corres_guard_imp)
-       apply (rule_tac f'="\<lambda>sched_context'. (scConsumed_update (\<lambda>c. c + consumed)) sched_context'"
-                    in setSchedContext_update_sched_context_no_stack_update_corres)
-          apply (clarsimp simp: sc_relation_def opt_map_red opt_map_def active_sc_def)
-         apply fastforce
-        apply (fastforce simp: obj_at_simps)
-       apply (wpsimp simp: isRoundRobin_def | wps)+
-  apply (clarsimp simp: ifM_def split: if_split)
-  apply (rule corres_underlying_split[rotated 2, OF is_round_robin_sp isRoundRobin_sp])
-   apply (corresKsimp corres: isRoundRobin_corres)
-  apply (corresKsimp corres: refillBudgetCheckRoundRobin_corres refillBudgetCheck_corres)
-  apply (fastforce simp: obj_at_def vs_all_heap_simps is_sc_obj_def obj_at_simps sc_relation_def
-                         is_active_sc'_def opt_map_red opt_pred_def active_sc_def)
-  done
-
-crunch ifCondRefillUnblockCheck
-  for valid_objs'[wp]: valid_objs'
-  (simp: crunch_simps)
-
-lemma switchSchedContext_corres:
-  "corres dc (\<lambda>s. valid_state s \<and> cur_tcb s \<and> sc_at (cur_sc s) s  \<and> active_scs_valid s
-                  \<and> current_time_bounded s \<and> active_sc_tcb_at (cur_thread s) s)
-             valid_objs'
-             switch_sched_context
-             switchSchedContext"
-  apply (clarsimp simp: valid_state_def)
-  apply add_cur_tcb'
-  apply (clarsimp simp: switch_sched_context_def switchSchedContext_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurSc_sp])
-   apply (corresKsimp corres: getCurSc_corres)
-  apply (clarsimp, rename_tac curScPtr)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurThread_sp])
-   apply corresKsimp
-  apply (clarsimp, rename_tac ct)
-  apply (rule corres_underlying_split[rotated 2, OF gsc_sp threadGet_sp, where r'="(=)"])
-   apply (rule corres_guard_imp)
-     apply (rule get_tcb_obj_ref_corres)
-     apply (fastforce simp: tcb_relation_def)
-    apply (fastforce simp: cur_tcb_def)
-   apply (fastforce simp: cur_tcb'_def)
-  apply (clarsimp, rename_tac ctScOpt)
-  apply (rule corres_symb_exec_l[rotated, OF _ assert_opt_sp])
-    apply wpsimp
-    apply (fastforce simp: obj_at_def pred_tcb_at_def vs_all_heap_simps)
-   apply wpsimp
-   apply (fastforce simp: obj_at_def pred_tcb_at_def vs_all_heap_simps)
-  apply (rename_tac scp)
-  apply (rule corres_symb_exec_l[rotated, OF _ get_sched_context_sp])
-    apply (rule get_sched_context_exs_valid)
-    apply (clarsimp simp: sc_at_pred_n_def obj_at_def is_sc_obj_def)
-    apply (rename_tac ko n, case_tac ko; clarsimp)
-   apply wpsimp
-   apply (clarsimp simp: sc_at_pred_n_def obj_at_def is_sc_obj_def)
-  apply (rename_tac ko n, case_tac ko; clarsimp)
-  apply (rule_tac F="the ctScOpt = scp" in corres_req, simp)
-  apply (rule_tac Q="\<lambda>_ s. sc_at (cur_sc s) s \<and> valid_objs s \<and> pspace_aligned s \<and> pspace_distinct s
-                           \<and> (cur_sc_active s \<longrightarrow> valid_refills (cur_sc s) s)"
-              and Q'="\<lambda>_. valid_objs'"
-              and r'=dc
-               in corres_underlying_split;
-         (solves wpsimp)?)
-    apply (clarsimp simp: when_def)
-    apply (rule corres_split_skip; (solves \<open>wpsimp wp: hoare_vcg_ex_lift\<close>)?)
-     apply (corresKsimp corres: setReprogramTimer_corres)
-    apply (corresKsimp corres: ifCondRefillUnblockCheck_corres)
-    apply (fastforce intro: valid_objs'_valid_refills' sc_at_cross is_active_sc'2_cross
-                            valid_sched_context_size_objsI
-                      simp: obj_at_def pred_tcb_at_def vs_all_heap_simps is_sc_obj_def opt_map_red
-                            opt_pred_def)
-   apply (rule corres_split_skip; (solves wpsimp)?)
-    apply (corresKsimp corres: getReprogramTimer_corres)
-   apply (rule_tac Q="\<top>\<top>" and Q'="\<top>\<top>" and r'=dc in corres_underlying_split; (solves wpsimp)?)
-    apply (corresKsimp corres: commitTime_corres)
-    apply (fastforce intro!: valid_objs'_valid_refills' sc_at_cross
-                       simp: state_relation_def)
-   apply (corresKsimp corres: setCurSc_corres)
-  apply (wpsimp wp: hoare_vcg_imp_lift' | wps)+
-  apply (fastforce intro: valid_sched_context_size_objsI active_scs_validE
-                    simp: obj_at_def is_sc_obj_def)
-  done
-
-lemma commit_time_active_sc_tcb_at[wp]:
-  "commit_time \<lbrace>active_sc_tcb_at t\<rbrace>"
-  by (wpsimp simp: commit_time_def)
-
-crunch switch_sched_context
-  for active_sc_tcb_at[wp]: "active_sc_tcb_at t"
-  and not_in_release_q[wp]: "\<lambda>s. t \<notin> set (release_queue s)"
-  and pspace_aligned[wp]: pspace_aligned
-  and pspace_distinct[wp]: pspace_distinct
-  (wp: crunch_wps simp: crunch_simps)
-
-crunch schedule_choose_new_thread
-  for sc_at[wp]: "sc_at sc_ptr"
-  (wp: crunch_wps dxo_wp_weak simp: crunch_simps)
-
-lemma scAndTimer_corres:
-  "corres dc (\<lambda>s. valid_state s \<and> cur_tcb s \<and> sc_at (cur_sc s) s
-                  \<and> active_scs_valid s \<and> valid_release_q s
-                  \<and> current_time_bounded s \<and> active_sc_tcb_at (cur_thread s) s)
-             invs'
-             sc_and_timer
-             scAndTimer"
-  apply (clarsimp simp: sc_and_timer_def scAndTimer_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF switchSchedContext_corres])
-      apply (rule corres_split[OF getReprogramTimer_corres])
-        apply (clarsimp simp: when_def)
-        apply (rule corres_split[OF setNextInterrupt_corres])
-          apply (rule setReprogramTimer_corres)
-         apply (wpsimp wp: hoare_vcg_ball_lift2| wps)+
-     apply (rule_tac Q'="\<lambda>_.invs" in hoare_post_imp, fastforce)
-     apply wpsimp+
-    apply (rule_tac Q'="\<lambda>_. invs'" in hoare_post_imp, fastforce)
-    apply (wpsimp wp: switchSchedContext_invs')
-   apply (clarsimp simp: valid_state_def valid_release_q_def)
-  apply fastforce
-  done
-
-lemma tcb_sched_action_valid_state[wp]:
-  "tcb_sched_action action thread \<lbrace>valid_state\<rbrace>"
-  by (wpsimp simp: tcb_sched_action_def set_tcb_queue_def get_tcb_queue_def valid_state_def
-               wp: hoare_drop_imps hoare_vcg_all_lift)
-
-crunch setQueue, addToBitmap
-  for isSchedulable_bool[wp]: "isSchedulable_bool tcbPtr"
-  (simp: bitmap_fun_defs isSchedulable_bool_def isScActive_def)
-
-lemma tcbSchedEnqueue_isSchedulable_bool[wp]:
-  "tcbSchedEnqueue tcbPtr \<lbrace>isSchedulable_bool tcbPtr'\<rbrace>"
-  apply (clarsimp simp: tcbSchedEnqueue_def unless_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)+
-  apply (rule hoare_when_cases, simp)
-  apply (rule bind_wp_fwd_skip, wpsimp)+
-  apply (wpsimp wp: threadSet_wp)
-  apply (fastforce simp: obj_at_simps isSchedulable_bool_def pred_map_simps opt_map_def
-                         isScActive_def
-                  split: option.splits)
-  done
-
-lemma schedule_switch_thread_branch_sc_at_cur_sc:
-  "\<lbrace>valid_objs and cur_sc_tcb\<rbrace>
-   schedule_switch_thread_branch candidate ct ct_schdlble
-   \<lbrace>\<lambda>_ s. sc_at (cur_sc s) s\<rbrace>"
-  apply (rule hoare_weaken_pre)
-   apply (rule_tac f=cur_sc in hoare_lift_Pf2)
-    apply (wpsimp simp: schedule_switch_thread_fastfail_def wp: hoare_drop_imps)+
-  apply (fastforce intro: cur_sc_tcb_sc_at_cur_sc)
-  done
-
-lemma schedule_switch_thread_branch_valid_state_and_cur_tcb:
-  "\<lbrace>\<lambda>s. invs s \<and> scheduler_action s = switch_thread candidate\<rbrace>
-   schedule_switch_thread_branch candidate ct ct_schdlble
-   \<lbrace>\<lambda>_ s. valid_state s \<and> cur_tcb s\<rbrace>"
-  apply (wpsimp simp: schedule_switch_thread_fastfail_def set_scheduler_action_def
-                  wp: switch_to_thread_invs thread_get_inv hoare_drop_imps)
-  done
-
-lemma schedule_corres:
-  "corres dc (invs and valid_sched and current_time_bounded and ct_ready_if_schedulable
-              and (\<lambda>s. schact_is_rct s \<longrightarrow> cur_sc_active s))
-             invs'
-             (Schedule_A.schedule)
-             schedule"
-  apply add_sch_act_wf
-  apply add_cur_tcb'
-  apply (clarsimp simp: Schedule_A.schedule_def schedule_def sch_act_wf_asrt_def cur_tcb'_asrt_def)
-  apply (rule corres_stateAssert_add_assertion[rotated], simp)+
-  apply (rule corres_split_skip)
-     apply (wpsimp wp: awaken_valid_sched hoare_vcg_imp_lift')
-     apply fastforce
-    apply (wpsimp wp: awaken_invs')
-   apply (corresKsimp corres: awaken_corres)
-   apply (fastforce intro: weak_sch_act_wf_at_cross
-                     simp: invs_def valid_state_def)
-  apply (rule corres_split_skip)
-     apply (wpsimp wp: hoare_vcg_imp_lift' cur_sc_active_lift)
-    apply wpsimp
-   apply (corresKsimp corres: checkDomainTime_corres)
-   apply (fastforce intro: weak_sch_act_wf_at_cross
-                     simp: invs_def valid_state_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurThread_sp])
-   apply corresKsimp
-  apply (rule corres_underlying_split[rotated 2, OF is_schedulable_sp' isSchedulable_sp])
-   apply (corresKsimp corres: isSchedulable_corres)
-   apply (fastforce intro: weak_sch_act_wf_at_cross
-                     simp: invs_def valid_state_def state_relation_def cur_tcb_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getSchedulerAction_sp])
-   apply (corresKsimp corres: getSchedulerAction_corres)
-
-  apply (case_tac "action = resume_cur_thread"; clarsimp)
-   apply (corresKsimp corres: scAndTimer_corres)
-   subgoal by (fastforce intro: valid_sched_context_size_objsI
-                          dest: schact_is_rct_ct_active_sc
-                          simp: invs_def cur_sc_tcb_def sc_at_pred_n_def obj_at_def is_sc_obj_def
-                                valid_state_def valid_sched_def)
-
-  apply (case_tac "action = choose_new_thread")
-   apply (clarsimp simp: bind_assoc)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF corres_when])
-         apply simp
-        apply (rule tcbSchedEnqueue_corres)
-       apply (rule corres_split[OF scheduleChooseNewThread_corres])
-         apply (rule scAndTimer_corres)
-        apply (subst conj_assoc[symmetric])
-        apply ((wpsimp wp: schedule_choose_new_thread_valid_state_cur_tcb
-                           schedule_choose_new_thread_active_sc_tcb_at_cur_thread
-               | rule_tac f=cur_sc in hoare_lift_Pf2
-               | rule_tac f=cur_thread in hoare_lift_Pf2)+)[1]
-       apply (wpsimp wp: scheduleChooseNewThread_invs')
-      apply (wpsimp | wps)+
-    subgoal by (fastforce intro!: cur_sc_tcb_sc_at_cur_sc valid_sched_context_size_objsI
-                            simp: schedulable_def2 pred_tcb_at_def obj_at_def get_tcb_def
-                                  invs_def cur_tcb_def is_tcb_def ct_ready_if_schedulable_def
-                                  vs_all_heap_simps valid_sched_def)
-   apply (fastforce simp: invs'_def isSchedulable_bool_def st_tcb_at'_def pred_map_simps
-                          obj_at_simps cur_tcb'_def
-                   elim!: opt_mapE)
-
-  apply (case_tac action; clarsimp)
-  apply (rule corres_underlying_split[OF _ scAndTimer_corres, where r'=dc])
-
-    apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-    apply (subst bind_dummy_ret_val)+
-    apply (subst conj_assoc[symmetric])
-    apply (rule hoare_vcg_conj_lift_pre_fix)
-     apply (wpsimp wp: schedule_switch_thread_branch_valid_state_and_cur_tcb)
-    apply (intro hoare_vcg_conj_lift_pre_fix;
-           (solves \<open>wpsimp simp: schedule_switch_thread_fastfail_def
-                             wp: thread_get_inv hoare_drop_imps\<close>)?)
-     apply (wpsimp wp: schedule_switch_thread_branch_sc_at_cur_sc)
-     apply fastforce
-    apply (wpsimp wp: schedule_switch_thread_branch_active_sc_tcb_at_cur_thread)
-    apply (fastforce simp: valid_sched_def valid_sched_action_def weak_valid_sched_action_def
-                           vs_all_heap_simps)
-
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-   apply (rename_tac target)
-   apply (rule_tac Q'="\<lambda>_ s. invs' s \<and> curThread = ksCurThread s \<and> st_tcb_at' runnable' target s"
-                in bind_wp_fwd)
-    apply wpsimp
-    apply (clarsimp simp: invs'_def isSchedulable_bool_def st_tcb_at'_def pred_map_simps
-                          obj_at_simps cur_tcb'_def sch_act_wf_cases
-                   elim!: opt_mapE
-                   split: scheduler_action.splits)
-   apply (rule bind_wp_fwd_skip, solves wpsimp)+
-   apply (wpsimp wp: scheduleChooseNewThread_invs' ksReadyQueuesL1Bitmap_return_wp
-               simp: isHighestPrio_def scheduleSwitchThreadFastfail_def)
-
-  apply (rename_tac candidate)
-  apply (rule corres_split_skip[where r'="(=)"])
-     apply wpsimp
-     apply (clarsimp simp: schedulable_def2 pred_tcb_at_def obj_at_def valid_sched_def
-                           ct_ready_if_schedulable_def vs_all_heap_simps)
-    apply wpsimp
-    apply (clarsimp simp: invs'_def isSchedulable_bool_def st_tcb_at'_def pred_map_simps
-                          obj_at_simps vs_all_heap_simps cur_tcb'_def
-                   elim!: opt_mapE)
-   apply (corresKsimp corres: tcbSchedEnqueue_corres)
-   apply (fastforce dest: invs_cur
-                    simp: cur_tcb_def)
-
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getIdleThread_sp])
-   apply corresKsimp
-  apply (rule corres_underlying_split[rotated 2, OF thread_get_sp threadGet_sp, where r'="(=)"])
-   apply (rule corres_guard_imp)
-     apply (rule threadGet_corres)
-     apply (clarsimp simp: tcb_relation_def)
-    apply (fastforce simp: valid_sched_def valid_sched_action_def weak_valid_sched_action_def
-                           vs_all_heap_simps obj_at_def is_tcb_def)
-   apply (clarsimp simp: sch_act_wf_cases split: scheduler_action.splits)
-
-  apply (rule_tac Q="\<lambda>_ s. invs s \<and> valid_ready_qs s \<and> ready_or_release s
-                           \<and> pred_map runnable (tcb_sts_of s) candidate
-                           \<and> released_sc_tcb_at candidate s \<and> not_in_release_q candidate s"
-              and Q'="\<lambda>_ s. invs' s \<and> cur_tcb' s \<and> curThread = ksCurThread s
-                            \<and> st_tcb_at' runnable' candidate s"
-              and r'="(=)"
-               in corres_underlying_split)
-     apply clarsimp
-     apply (rule corres_guard_imp)
-       apply (rule threadGet_corres)
-       apply (clarsimp simp: tcb_relation_def)
-      apply clarsimp
-     apply (clarsimp simp: cur_tcb'_def)
-
-    apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-    apply (wpsimp wp: thread_get_wp)
-    apply (clarsimp simp: valid_sched_def valid_sched_action_def weak_valid_sched_action_def
-                          in_queue_2_def)
-
-   apply (find_goal \<open>match conclusion in "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>" for P f Q  \<Rightarrow> -\<close>)
-   apply (wpsimp wp: threadGet_wp)
-   apply (clarsimp simp: cur_tcb'_def obj_at_simps sch_act_wf_cases
-                  split: scheduler_action.splits)
-
-  apply (rule corres_underlying_split[rotated 2, OF schedule_switch_thread_fastfail_inv
-                                          scheduleSwitchThreadFastfail_inv])
-   apply (corresKsimp corres: scheduleSwitchThreadFastfail_corres)
-   apply (fastforce dest: invs_cur
-                    simp: cur_tcb_def obj_at_def is_tcb_def state_relation_def cur_tcb'_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp curDomain_sp])
-   apply (corresKsimp corres: curDomain_corres)
-  apply (clarsimp simp: isHighestPrio_def' split del: if_split)
-
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp gets_sp, where r'="(=)"])
-   apply (corresKsimp corres: isHighestPrio_corres)
-   apply (clarsimp simp: is_highest_prio_def)
-   apply (subst bitmapL1_zero_ksReadyQueues)
-     apply (fastforce dest: invs_queues simp: valid_queues_def)
-    apply (fastforce dest: invs_queues simp: valid_queues_def)
-   apply (rule disj_cong)
-    apply (fastforce simp: ready_queues_relation_def dest!: state_relationD)
-   apply clarsimp
-   apply (subst lookupBitmapPriority_Max_eqI)
-      apply (fastforce dest: invs_queues simp: valid_queues_def)
-     apply (fastforce dest: invs_queues simp: valid_queues_def)
-    apply (subst bitmapL1_zero_ksReadyQueues)
-      apply (fastforce dest: invs_queues simp: valid_queues_def)
-     apply (fastforce dest: invs_queues simp: valid_queues_def)
-    apply (fastforce simp: ready_queues_relation_def dest!: state_relationD)
-   apply (clarsimp simp: ready_queues_relation_def dest!: state_relationD)
-
-  apply (rule corres_if_split; (solves simp)?)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF tcbSchedEnqueue_corres])
-       apply clarsimp
-       apply (rule corres_split[OF setSchedulerAction_corres])
-          apply (clarsimp simp: sched_act_relation_def)
-         apply (rule scheduleChooseNewThread_corres)
-        apply wpsimp+
-    apply (fastforce simp: obj_at_def vs_all_heap_simps is_tcb_def pred_tcb_at_def)
-   apply fastforce
-
-  apply (rule corres_if_split; (solves simp)?)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split[OF tcbSchedAppend_corres])
-       apply clarsimp
-       apply (rule corres_split[OF setSchedulerAction_corres])
-          apply (clarsimp simp: sched_act_relation_def)
-         apply (rule scheduleChooseNewThread_corres)
-        apply wpsimp+
-    apply (fastforce simp: obj_at_def vs_all_heap_simps is_tcb_def pred_tcb_at_def)
-   apply fastforce
-
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF switchToThread_corres])
-      apply clarsimp
-      apply (rule setSchedulerAction_corres)
-      apply (clarsimp simp: sched_act_relation_def)
-     apply wpsimp
-    apply wpsimp
-   apply (clarsimp simp: pred_conj_def)
-   apply (fastforce simp: obj_at_def vs_all_heap_simps pred_tcb_at_def)
-  apply fastforce
+    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 corres_split[OF getSchedulerAction_corres])
+          apply (rule corres_if, simp)
+           apply (rule tcbSchedEnqueue_corres, simp)
+          apply (rule corres_if, simp)
+            apply (case_tac action; simp)
+           apply (rule corres_split[OF rescheduleRequired_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)
   done
 
 end
-
-lemma schedContextDonate_valid_queues[wp]:
-  "\<lbrace>valid_queues and valid_objs'\<rbrace> schedContextDonate scPtr tcbPtr \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  (is "valid ?pre _ _")
-  apply (clarsimp simp: schedContextDonate_def)
-  apply (rule bind_wp[OF _ get_sc_sp'])
-  apply (rule_tac Q'="\<lambda>_. ?pre" in bind_wp_fwd)
-   apply (rule hoare_when_cases, clarsimp)
-   apply (rule_tac Q'="\<lambda>_. ?pre" in bind_wp_fwd)
-    apply (wpsimp wp: tcbSchedDequeue_valid_queues)
-    apply (fastforce intro: valid_objs'_maxDomain valid_objs'_maxPriority)
-   apply (rule bind_wp_fwd_skip)
-    apply (wpsimp wp: tcbReleaseRemove_valid_queues)
-   apply (rule bind_wp_fwd_skip)
-    apply (wpsimp wp: threadSet_valid_queues_new threadSet_valid_objs')
-    apply (clarsimp simp: obj_at'_def inQ_def valid_tcb'_def tcb_cte_cases_def)
-   apply (wpsimp wp: rescheduleRequired_valid_queues)
-   apply fastforce
-  apply (wpsimp wp: threadSet_valid_queues_new hoare_vcg_all_lift hoare_vcg_imp_lift')
-  apply (clarsimp simp: obj_at'_def inQ_def)
-  done
-
-lemma schedContextDonate_valid_queues'[wp]:
-  "schedContextDonate sc t \<lbrace>valid_queues'\<rbrace>"
-  apply (clarsimp simp: schedContextDonate_def)
-  apply (rule bind_wp_fwd_skip, solves wpsimp)
-  apply (rule bind_wp_fwd_skip)
-   apply (rule hoare_when_cases, simp)
-   apply ((rule bind_wp_fwd_skip
-           , wpsimp wp: threadSet_valid_queues' hoare_vcg_imp_lift' simp: inQ_def)
-          | wpsimp wp: threadSet_valid_queues' hoare_vcg_imp_lift' simp: inQ_def)+
-  done
-
-crunch tcbSchedDequeue
-  for ksReleaseQueue[wp]: "\<lambda>s. P (ksReleaseQueue s)"
-
-crunch schedContextDonate
-  for vrq[wp]: valid_release_queue
-  and vrq'[wp]: valid_release_queue'
-  (wp: threadSet_vrq_inv threadSet_vrq'_inv simp: crunch_simps)
-
-crunch schedContextDonate
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' ptr"
-  (wp: threadSet_cap_to simp: tcb_cte_cases_def)
-
-crunch schedContextDonate
-  for valid_irq_handlers'[wp]: "\<lambda>s. valid_irq_handlers' s"
-  and valid_mdb'[wp]: valid_mdb'
-  (ignore: threadSet
-     simp: comp_def valid_mdb'_def crunch_simps
-       wp: valid_irq_handlers_lift'' threadSet_ctes_of)
-
-crunch schedContextDonate
-  for sch_act_sane[wp]: sch_act_sane
-  and sch_act_simple[wp]: sch_act_simple
-  and sch_act_not[wp]: "sch_act_not t"
-  (wp: crunch_wps simp: crunch_simps rule: sch_act_sane_lift)
-
-crunch schedContextDonate
-  for no_0_obj'[wp]: no_0_obj'
-  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and if_unsafe_then_cap'[wp]: "if_unsafe_then_cap'"
-  and valid_global_refs'[wp]: "valid_global_refs'"
-  and valid_arch_state'[wp]: "valid_arch_state'"
-  and valid_irq_node'[wp]: "\<lambda>s. valid_irq_node' (irq_node' s) s"
-  and valid_irq_states'[wp]: "\<lambda>s. valid_irq_states' s"
-  and valid_machine_state'[wp]: "\<lambda>s. valid_machine_state' s"
-  and ct_not_inQ[wp]: "ct_not_inQ"
-  and ct_idle_or_in_cur_domain'[wp]: "ct_idle_or_in_cur_domain'"
-  and valid_pde_mappings'[wp]: "\<lambda>s. valid_pde_mappings' s"
-  and pspace_domain_valid[wp]: "\<lambda>s. pspace_domain_valid s"
-  and irqs_masked'[wp]: "\<lambda>s. irqs_masked' s"
-  and cur_tcb'[wp]: "cur_tcb'"
-  and urz[wp]: untyped_ranges_zero'
-  and valid_dom_schedule'[wp]: valid_dom_schedule'
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and valid_replies' [wp]: valid_replies'
-  and pspace_bounded'[wp]: "pspace_bounded'"
-  (simp: comp_def tcb_cte_cases_def crunch_simps
-     wp: threadSet_not_inQ hoare_vcg_imp_lift' valid_irq_node_lift
-         setQueue_cur threadSet_ifunsafe'T threadSet_cur crunch_wps
-         cur_tcb_lift valid_dom_schedule'_lift valid_replies'_lift)
-
-lemma schedContextDonate_valid_pspace':
-  "\<lbrace>valid_pspace' and tcb_at' tcbPtr\<rbrace> schedContextDonate scPtr tcbPtr \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
-  by (wpsimp wp: schedContextDonate_valid_objs' simp: valid_pspace'_def)
-
-lemma schedContextDonate_if_live_then_nonz_cap':
-  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s \<and> valid_objs' s \<and>
-        ex_nonz_cap_to' tcbPtr s \<and> ex_nonz_cap_to' scPtr s\<rbrace>
-   schedContextDonate scPtr tcbPtr
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  unfolding schedContextDonate_def
-  by (wpsimp wp: threadSet_iflive'T setSchedContext_iflive' hoare_vcg_all_lift threadSet_cap_to'
-           simp: conj_ac cong: conj_cong | wp hoare_drop_imps | fastforce simp: tcb_cte_cases_def)+
-
-(* `obj_at' (\<lambda>x. scTCB x \<noteq> Some idle_thread_ptr) scPtr s` is
-   needed because sometimes sym_refs doesn't hold in its entirety here. *)
-lemma schedContextDonate_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> bound_sc_tcb_at' ((=) None) tcbPtr s \<and>
-        ex_nonz_cap_to' scPtr s \<and> ex_nonz_cap_to' tcbPtr s\<rbrace>
-   schedContextDonate scPtr tcbPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp only: invs'_def)
-  apply (rule_tac E="\<lambda>s. sc_at' scPtr s" in hoare_strengthen_pre_via_assert_backward)
-   apply (simp only: schedContextDonate_def)
-   apply (rule bind_wp[OF _ get_sc_sp'])
-   apply (rule_tac hoare_weaken_pre[OF hoare_pre_cont])
-   apply (clarsimp simp: obj_at'_def)
-  apply (wp schedContextDonate_valid_pspace'
-            schedContextDonate_valid_queues schedContextDonate_valid_queues'
-            schedContextDonate_if_live_then_nonz_cap')
-  apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_sc)
-  apply (auto dest!: global'_sc_no_ex_cap
-              simp: ko_wp_at'_def obj_at'_def projectKO_eq projectKO_tcb
-                    pred_tcb_at'_def)
-  done
-
-lemma tcbSchedDequeue_notksQ:
-  "tcbSchedDequeue t \<lbrace>\<lambda>s. t' \<notin> set(ksReadyQueues s p)\<rbrace>"
-  apply (simp add: tcbSchedDequeue_def)
-  apply (wp hoare_when_weak_wp)
-     apply (rule_tac Q'="\<lambda>_ s. t' \<notin> set(ksReadyQueues s p)" in hoare_post_imp)
-      apply wpsimp+
-  done
-
-lemma tcbSchedDequeue_nonq:
-  "\<lbrace>\<lambda>s. if t=t' then valid_queues s else t' \<notin> set (ksReadyQueues s p)\<rbrace>
-   tcbSchedDequeue t
-   \<lbrace>\<lambda>_ s. t' \<notin> set (ksReadyQueues s p)\<rbrace>"
-  unfolding tcbSchedDequeue_def
-  apply (wpsimp wp: threadGet_wp)
-  apply (case_tac p)
-  apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def
-                  split: if_splits)
-  done
-
-crunch tcbReleaseRemove
-  for not_queued[wp]: "\<lambda>s. t' \<notin> set (ksReadyQueues s p)"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma reprogram_timer_corres:
-   "corres dc \<top> \<top>
-      (modify (reprogram_timer_update (\<lambda>_. True)))
-      (setReprogramTimer True)"
-  unfolding setReprogramTimer_def
-  by (rule corres_modify) (simp add: state_relation_def swp_def)
-
-lemma release_queue_corres:
-  "corres (=) \<top> \<top> (gets release_queue) getReleaseQueue"
-  by (simp add: getReleaseQueue_def state_relation_def release_queue_relation_def)
-
-lemma tcbReleaseRemove_corres:
-  "t = t' \<Longrightarrow>
-   corres dc (pspace_aligned and pspace_distinct and tcb_at t) \<top>
-             (tcb_release_remove t) (tcbReleaseRemove t')"
-  unfolding tcb_release_remove_def tcbReleaseRemove_def tcb_sched_dequeue_def setReleaseQueue_def
-  apply clarsimp
-  apply (rule stronger_corres_guard_imp)
-    apply (rule_tac r'="(=)" in corres_split)
-       apply (rule release_queue_corres)
-      apply (rule corres_split)
-         apply (rule corres_when)
-          apply clarsimp
-         apply (rule reprogram_timer_corres)
-        apply (rule corres_add_noop_lhs2)
-        apply (rule corres_split)
-           apply (rule corres_modify)
-           apply (auto simp: release_queue_relation_def state_relation_def swp_def)[1]
-          apply (rule threadSet_corres_noop; clarsimp simp: tcb_relation_def)
-         apply wp
-        apply wp
-       apply clarsimp
-       apply wp
-      apply (rule when_wp)
-      apply clarsimp
-      apply wp
-     apply wp
-    apply clarsimp
-    apply wpsimp
-   apply simp
-   apply metis
-  apply (fastforce simp: state_relation_def tcb_at_cross)
-  done
-
-lemma threadSet_valid_queues_no_state:
-  "\<lbrace>valid_queues and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_. valid_queues\<rbrace>"
-  apply (simp add: threadSet_def)
-  apply wp
-   apply (simp add: valid_queues_def valid_queues_no_bitmap_def' pred_tcb_at'_def)
-   apply (wp hoare_Ball_helper
-             hoare_vcg_all_lift
-             setObject_tcb_strongest)[1]
-  apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: valid_queues_def valid_queues_no_bitmap_def' pred_tcb_at'_def)
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma threadSet_valid_queues'_no_state:
-  "(\<And>tcb. tcbQueued tcb = tcbQueued (f tcb)) \<Longrightarrow>
-   \<lbrace>valid_queues' and (\<lambda>s. \<forall>p. t \<notin> set (ksReadyQueues s p))\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: valid_queues'_def threadSet_def obj_at'_real_def
-                split del: if_split)
-  apply (simp only: imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-     apply (wp setObject_ko_wp_at | simp add: objBits_simps')+
-    apply (wp getObject_tcb_wp updateObject_default_inv
-               | simp split del: if_split)+
-  apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs
-                        objBits_simps addToQs_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: projectKOs inQ_def split: if_split_asm)
-  done
-
-lemma setQueue_valid_tcbs'[wp]:
-  "setQueue qdom prio q \<lbrace>valid_tcbs'\<rbrace>"
-  unfolding valid_tcbs'_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
-  done
-
-lemma removeFromBitmap_valid_tcbs'[wp]:
-  "removeFromBitmap tdom prio \<lbrace>valid_tcbs'\<rbrace>"
-  apply (wpsimp simp: valid_tcbs'_def bitmap_fun_defs)
-  done
-
-lemma tcbSchedDequeue_valid_tcbs'[wp]:
-  "tcbSchedDequeue tcbPtr \<lbrace>valid_tcbs'\<rbrace>"
-  apply (clarsimp simp: tcbSchedDequeue_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (clarsimp simp: when_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)+
-  apply (wpsimp wp: threadSet_valid_tcbs')
-  done
-
-lemma schedContextDonate_corres_helper:
-  "(case rv' of SwitchToThread x \<Rightarrow> when (x = t \<or> t = cur) rescheduleRequired
-                             | _ \<Rightarrow> when (t = cur) rescheduleRequired) =
-   (when (t = cur \<or> (case rv' of SwitchToThread x \<Rightarrow> t = x | _ \<Rightarrow> False)) rescheduleRequired)"
-  by (case_tac rv'; clarsimp simp: when_def)
-
-crunch tcbReleaseRemove
-  for valid_tcbs'[wp]: valid_tcbs'
-  (wp: crunch_wps)
-
-lemma schedContextDonate_corres:
-  "corres dc (sc_at scp and tcb_at thread and weak_valid_sched_action and pspace_aligned and
-              pspace_distinct and valid_objs and active_scs_valid)
-             (valid_objs' and valid_queues and valid_queues' and
-              valid_release_queue and valid_release_queue')
-             (sched_context_donate scp thread)
-             (schedContextDonate scp thread)"
-  apply (simp add: test_reschedule_def get_sc_obj_ref_def set_tcb_obj_ref_thread_set
-                   schedContextDonate_def sched_context_donate_def schedContextDonate_corres_helper)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule corres_split [OF get_sc_corres])
-      apply (rule corres_split [OF corres_when2])
-          apply (clarsimp simp: sc_relation_def)
-         apply (rule corres_assert_opt_assume_l)
-         apply (rule corres_split_nor)
-            apply (rule_tac x="the (sc_tcb sc)" and x'="the (scTCB sca)" in lift_args_corres)
-             apply (rule tcbSchedDequeue_corres)
-            apply (clarsimp simp: sc_relation_def)
-           apply (rule corres_split_nor)
-              apply (rule tcbReleaseRemove_corres)
-              apply (clarsimp simp: sc_relation_def)
-             apply (rule corres_split_nor)
-                apply (rule_tac x="the (sc_tcb sc)" and x'="the (scTCB sca)" in lift_args_corres)
-                 apply (rule threadset_corresT)
-                   apply (clarsimp simp: tcb_relation_def)
-                  apply (clarsimp simp: tcb_cap_cases_def)
-                 apply (clarsimp simp: tcb_cte_cases_def)
-                apply (clarsimp simp: sc_relation_def)
-               apply (rule corres_split_eqr)
-                  apply (rule getCurThread_corres)
-                 apply (rule_tac r'=sched_act_relation in corres_split)
-                    apply (rule getSchedulerAction_corres)
-                   apply (rule corres_when)
-                    apply (case_tac rv; clarsimp simp: sched_act_relation_def sc_relation_def)
-                   apply (rule rescheduleRequired_corres_weak)
-                  apply wpsimp
-                 apply wpsimp
-                apply wpsimp
-               apply wpsimp
-              apply (wpsimp wp: hoare_drop_imps)
-             apply (wpsimp wp: hoare_drop_imps
-                               threadSet_valid_release_queue threadSet_valid_release_queue'
-                               threadSet_valid_queues_no_state threadSet_valid_queues'_no_state)
-            apply (wpsimp | strengthen weak_valid_sched_action_strg)+
-           apply (rule_tac Q'="\<lambda>_. tcb_at' (the (scTCB sca)) and valid_tcbs' and
-                                  valid_queues and valid_queues' and
-                                  valid_release_queue and valid_release_queue' and
-                                  (\<lambda>s. \<forall>d p. the (scTCB sca) \<notin> set (ksReadyQueues s (d, p)))"
-                        in hoare_strengthen_post[rotated])
-            apply (clarsimp simp: valid_release_queue'_def obj_at'_def)
-           apply (wpsimp wp: tcbReleaseRemove_valid_queues hoare_vcg_all_lift)
-          apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
-         apply (wpsimp wp: tcbSchedDequeue_valid_queues hoare_vcg_all_lift tcbSchedDequeue_nonq)
-        apply (rule corres_split
-                   [OF update_sc_no_reply_stack_update_ko_at'_corres
-                         [where f'="scTCB_update (\<lambda>_. Some thread)"]
-                       threadset_corresT])
-                apply (clarsimp simp: sc_relation_def)
-               apply clarsimp
-              apply (clarsimp simp: objBits_def objBitsKO_def)
-             apply clarsimp
-            apply (clarsimp simp: tcb_relation_def)
-           apply (clarsimp simp: tcb_cap_cases_def)
-          apply (clarsimp simp: tcb_cte_cases_def)
-         apply wpsimp
-        apply wpsimp
-       apply (wpsimp wp: hoare_drop_imp)+
-   apply (frule (1) valid_objs_ko_at)
-   apply (fastforce simp: valid_obj_def valid_sched_context_def valid_bound_obj_def obj_at_def)
-  apply (prop_tac "sc_at' scp s' \<and> tcb_at' thread s'")
-   apply (fastforce elim: sc_at_cross tcb_at_cross simp: state_relation_def)
-  apply clarsimp
-  apply (frule valid_objs'_valid_tcbs')
-  apply (rule valid_objsE', assumption)
-   apply (fastforce simp: obj_at'_def projectKO_eq projectKO_sc)
-  apply (clarsimp simp: valid_obj'_def valid_sched_context'_def obj_at'_def projectKOs)
-  apply (frule valid_objs'_valid_tcbs')
-  apply (fastforce simp: valid_obj'_def valid_tcb'_def)
-  done
-
 end
diff --git a/proof/refine/ARM/StateRelation.thy b/proof/refine/ARM/StateRelation.thy
index e81f395e71..b03db17684 100644
--- a/proof/refine/ARM/StateRelation.thy
+++ b/proof/refine/ARM/StateRelation.thy
@@ -12,7 +12,7 @@ theory StateRelation
 imports InvariantUpdates_H
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 definition
   cte_map :: "cslot_ptr \<Rightarrow> word32"
 where
@@ -49,8 +49,6 @@ where
    Fault_H.UnknownSyscallException n"
 | "fault_map (ExceptionTypes_A.UserException x y) =
    Fault_H.UserException x y"
-| "fault_map (ExceptionTypes_A.Timeout d) =
-   Fault_H.Timeout d"
 
 
 text \<open>
@@ -108,12 +106,8 @@ where
            Structures_H.CNodeCap ref n (of_bl L) (length L))"
 | "cap_relation (Structures_A.ThreadCap ref) c            = (c =
            Structures_H.ThreadCap ref)"
-| "cap_relation (Structures_A.ReplyCap ref r) c           = (c =
-           Structures_H.ReplyCap ref (AllowGrant \<in> r))"
-| "cap_relation (Structures_A.SchedContextCap ref n) c    = (c =
-           Structures_H.SchedContextCap ref (min_sched_context_bits + n))"
-| "cap_relation (Structures_A.SchedControlCap) c          = (c =
-           Structures_H.SchedControlCap)"
+| "cap_relation (Structures_A.ReplyCap ref master r) c    = (c =
+           Structures_H.ReplyCap ref master (AllowGrant \<in> r))"
 | "cap_relation (Structures_A.IRQControlCap) c            = (c =
            Structures_H.IRQControlCap)"
 | "cap_relation (Structures_A.IRQHandlerCap irq) c        = (c =
@@ -143,7 +137,7 @@ where
       Structures_A.IdleNtfn       \<Rightarrow> ntfnObj ntfn' = Structures_H.IdleNtfn
     | Structures_A.WaitingNtfn q  \<Rightarrow> ntfnObj ntfn' = Structures_H.WaitingNtfn q
     | Structures_A.ActiveNtfn b \<Rightarrow> ntfnObj ntfn' = Structures_H.ActiveNtfn b)
-  \<and> ntfn_bound_tcb ntfn = ntfnBoundTCB ntfn' \<and> ntfn_sc ntfn = ntfnSc ntfn'"
+  \<and> ntfn_bound_tcb ntfn = ntfnBoundTCB ntfn'"
 
 definition
   ep_relation :: "Structures_A.endpoint \<Rightarrow> Structures_H.endpoint \<Rightarrow> bool"
@@ -169,10 +163,10 @@ where
      = (ts' = Structures_H.Inactive)"
 | "thread_state_relation (Structures_A.IdleThreadState) ts'
      = (ts' = Structures_H.IdleThreadState)"
-| "thread_state_relation (Structures_A.BlockedOnReply r) ts'
-     = (ts' = Structures_H.BlockedOnReply (Some r))"
-| "thread_state_relation (Structures_A.BlockedOnReceive oref reply sp) ts'
-     = (ts' = Structures_H.BlockedOnReceive oref (receiver_can_grant sp) reply)"
+| "thread_state_relation (Structures_A.BlockedOnReply) ts'
+     = (ts' = Structures_H.BlockedOnReply)"
+| "thread_state_relation (Structures_A.BlockedOnReceive oref sp) ts'
+     = (ts' = Structures_H.BlockedOnReceive oref (receiver_can_grant sp))"
 | "thread_state_relation (Structures_A.BlockedOnSend oref sp) ts'
      = (ts' = Structures_H.BlockedOnSend oref (sender_badge sp)
                    (sender_can_grant sp) (sender_can_grant_reply sp) (sender_is_call sp))"
@@ -189,141 +183,18 @@ definition
   tcb_relation :: "Structures_A.tcb \<Rightarrow> Structures_H.tcb \<Rightarrow> bool"
 where
  "tcb_relation \<equiv> \<lambda>tcb tcb'.
-    tcb_ipc_buffer tcb = tcbIPCBuffer tcb'
+    tcb_fault_handler tcb = to_bl (tcbFaultHandler tcb')
+  \<and> tcb_ipc_buffer tcb = tcbIPCBuffer tcb'
   \<and> arch_tcb_relation (tcb_arch tcb) (tcbArch tcb')
   \<and> thread_state_relation (tcb_state tcb) (tcbState tcb')
   \<and> fault_rel_optionation (tcb_fault tcb) (tcbFault tcb')
   \<and> cap_relation (tcb_ctable tcb) (cteCap (tcbCTable tcb'))
   \<and> cap_relation (tcb_vtable tcb) (cteCap (tcbVTable tcb'))
-  \<and> cap_relation (tcb_fault_handler tcb) (cteCap (tcbFaultHandler tcb'))
-  \<and> cap_relation (tcb_timeout_handler tcb) (cteCap (tcbTimeoutHandler tcb'))
+  \<and> cap_relation (tcb_reply tcb) (cteCap (tcbReply tcb'))
+  \<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_sched_context tcb = tcbSchedContext tcb'
-  \<and> tcb_yield_to tcb = tcbYieldTo tcb'
-  \<and> tcb_mcpriority tcb = tcbMCP tcb'
-  \<and> tcb_priority tcb = tcbPriority tcb'
-  \<and> tcb_domain tcb = tcbDomain tcb'"
-
-lemma sc_sporadic_flag_eq_schedContextSporadicFlag[simp]:
-  "sc_sporadic_flag = schedContextSporadicFlag"
-  by (simp add: sc_sporadic_flag_def schedContextSporadicFlag_def)
-
-lemma minRefills_eq_MIN_REFILLS[simp]:
-  "minRefills = MIN_REFILLS"
-  by (clarsimp simp: minRefills_def MIN_REFILLS_def)
-
-definition refill_map :: "Structures_H.refill \<Rightarrow> Structures_A.refill" where
-  "refill_map refill \<equiv> \<lparr> r_time = rTime refill, r_amount = rAmount refill\<rparr>"
-
-
-(* Assumes count \<le> mx; start \<le> mx; mx \<le> length xs
-   Produces count elements from start, wrapping around to the beginning of the list at mx *)
-definition wrap_slice :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
-  "wrap_slice start count mx xs \<equiv> if start + count \<le> mx
-                                   then take count (drop start xs)
-                                   else take (mx - start) (drop start xs) @ take (start + count - mx) xs"
-
-(* Sanity check: *)
-lemma "wrap_slice 1 3 4 [1::nat,2,3,4,5,6] = [2,3,4]" by eval
-lemma "wrap_slice 3 3 4 [1::nat,2,3,4,5,6] = [4,1,2]" by eval
-
-lemma length_wrap_slice[simp]:
-  "\<lbrakk> count \<le> mx; start \<le> mx; mx \<le> length xs \<rbrakk> \<Longrightarrow> length (wrap_slice start count mx xs) = count"
-  by (simp add: wrap_slice_def)
-
-lemma wrap_slice_empty[simp]:
-  "start \<le> mx \<Longrightarrow> wrap_slice start 0 mx xs = []"
-  by (clarsimp simp: wrap_slice_def)
-
-lemma hd_wrap_slice:
-  "\<lbrakk>0 < count; mx \<le> length list; start < mx\<rbrakk> \<Longrightarrow> hd (wrap_slice start count mx list) = list ! start"
-  by (auto simp: wrap_slice_def hd_drop_conv_nth)
-
-definition refills_map :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> refill list \<Rightarrow>  Structures_A.refill list" where
-  "refills_map start count mx \<equiv> map refill_map \<circ> wrap_slice (min start mx) (min count mx) mx"
-
-(* This leaves those Haskell refills unconstrained that are not in the abstract sc_refills list.
-   This is intentional: for instance, refillPopHead will leave "garbage" behind in memory which
-   is not captured on the abstract side, and we can't demand that the Haskell side has empty
-   refills there. This should be fine, from concrete to abstract we still have a function.
- *)
-definition sc_relation ::
-  "Structures_A.sched_context \<Rightarrow> nat \<Rightarrow> Structures_H.sched_context \<Rightarrow> bool" where
-  "sc_relation \<equiv> \<lambda>sc n sc'.
-     sc_period sc = scPeriod sc' \<and>
-     sc_consumed sc = scConsumed sc' \<and>
-     sc_tcb sc = scTCB sc' \<and>
-     sc_ntfn sc = scNtfn sc' \<and>
-     sc_refills sc = refills_map (scRefillHead sc') (scRefillCount sc')
-                                 (scRefillMax sc') (scRefills sc') \<and>
-     n = scSize sc' \<and>
-     sc_refill_max sc = scRefillMax sc' \<and>
-     sc_badge sc = scBadge sc' \<and>
-     sc_sporadic sc = scSporadic sc' \<and>
-     sc_yield_from sc = scYieldFrom sc'"
-
-(* projection rewrite *)
-
-definition is_active_sc' where
-  "is_active_sc' p s' \<equiv> ((\<lambda>sc'. 0 < scRefillMax sc') |< scs_of' s') p"
-
-lemma active_sc_at'_imp_is_active_sc':
-  "active_sc_at' scp s \<Longrightarrow> is_active_sc' scp s"
-  by (clarsimp simp: active_sc_at'_def is_active_sc'_def obj_at'_def opt_map_def projectKO_eq
-                     opt_pred_def)
-
-lemma active_sc_at'_rewrite:
-  "active_sc_at' scp s = (is_active_sc' scp s \<and> sc_at' scp s)"
-  by (fastforce simp: active_sc_at'_def is_active_sc'_def obj_at'_def opt_map_def projectKO_eq
-                      opt_pred_def)
-
-(* valid_refills' *)
-
-(* Most sched contexts should satisfy these conditions. These are the conditions we need for
-   the refill list circular buffer to make sense. In other words, these are the constraints
-   we expect for wrap_slice to give what we want. *)
-
-abbreviation sc_valid_refills' where
-  "sc_valid_refills' sc \<equiv> scRefillMax sc \<le> length (scRefills sc) \<and> scRefillHead sc < scRefillMax sc \<and>
-                    scRefillCount sc \<le> scRefillMax sc \<and> 0 < scRefillCount sc"
-
-definition valid_refills' where
-  "valid_refills' sc_ptr s' \<equiv> (sc_valid_refills' |< scs_of' s') sc_ptr"
-
-lemma valid_refills'_nonzero_scRefillCount:
-  "valid_refills' scp s' \<Longrightarrow> ((\<lambda>sc. 0 < scRefillCount sc) |< scs_of' s') scp"
-  by (clarsimp simp: valid_refills'_def opt_pred_def split: option.splits)
-
-lemma valid_objs'_valid_refills':
-  "\<lbrakk>valid_objs' s'; sc_at' scp s'; is_active_sc' scp s'\<rbrakk> \<Longrightarrow> valid_refills' scp s'"
-  apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_opt_sc
-                 split: option.split_asm)
-  apply (case_tac ko; clarsimp)
-  apply (erule (1) valid_objsE')
-  by (clarsimp simp: valid_refills'_def valid_obj'_def valid_sched_context'_def opt_pred_def
-                     is_active_sc'_def opt_map_red projectKO_opt_sc)
-
-lemma
-  valid_refills'_ksSchedulerAction_update[simp]:
-  "valid_refills' scp (ksSchedulerAction_update g s) = valid_refills' scp s" and
-  valid_refills'_ksReadyQueues_update[simp]:
-  "valid_refills' scp (ksReadyQueues_update f s) = valid_refills' scp s" and
-  valid_refills'_ksReadyQueuesL1Bitmap_update[simp]:
-  "valid_refills' scp (ksReadyQueuesL1Bitmap_update f' s) = valid_refills' scp s" and
-  valid_refills'_ksReadyQueuesL2Bitmap_update[simp]:
-  "valid_refills' scp (ksReadyQueuesL2Bitmap_update f'' s) = valid_refills' scp s"
-  by (clarsimp simp: valid_refills'_def)+
-
-lemma maxReleaseTime_equiv:
-  "maxReleaseTime = MAX_RELEASE_TIME"
-  apply (clarsimp simp: maxReleaseTime_def MAX_RELEASE_TIME_def maxBound_max_word maxPeriodUs_def
-                        usToTicks_def MAX_PERIOD_def)
-  done
-
-definition reply_relation :: "Structures_A.reply \<Rightarrow> Structures_H.reply \<Rightarrow> bool" where
-  "reply_relation \<equiv> \<lambda>reply reply'.
-     reply_sc reply = replySC reply' \<and> reply_tcb reply = replyTCB reply'"
+  \<and> tcb_mcpriority tcb = tcbMCP tcb'"
 
 \<comment> \<open>
   A pair of objects @{term "(obj, obj')"} should satisfy the following relation when, under further
@@ -417,22 +288,6 @@ where
 | "aobj_relation_cuts (PageDirectory pd) x =
      (\<lambda>y. (x + (ucast y << 2), pde_relation y)) ` UNIV"
 
-abbreviation
-  sc_relation_cut :: "Structures_A.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
-where
-  "sc_relation_cut obj obj' \<equiv>
-  (case (obj, obj') of
-        (Structures_A.SchedContext sc n, KOSchedContext sc') \<Rightarrow> sc_relation sc n sc'
-      | _ \<Rightarrow> False)"
-
-abbreviation
-  reply_relation_cut :: "Structures_A.kernel_object \<Rightarrow> Structures_H.kernel_object \<Rightarrow> bool"
-where
-  "reply_relation_cut obj obj' \<equiv>
-  (case (obj, obj') of
-        (Structures_A.Reply r, KOReply r') \<Rightarrow> reply_relation r r'
-      | _ \<Rightarrow> False)"
-
 definition tcb_relation_cut :: "Structures_A.kernel_object \<Rightarrow> kernel_object \<Rightarrow> bool" where
   "tcb_relation_cut obj obj' \<equiv>
    case (obj, obj') of
@@ -449,9 +304,6 @@ where
 | "obj_relation_cuts (TCB tcb) x = {(x, tcb_relation_cut)}"
 | "obj_relation_cuts (Endpoint ep) x = {(x, other_obj_relation)}"
 | "obj_relation_cuts (Notification ntfn) x = {(x, other_obj_relation)}"
-| "obj_relation_cuts (Structures_A.SchedContext sc n) x =
-     (if valid_sched_context_size n then {(x, sc_relation_cut)} else {(x, \<bottom>\<bottom>)})"
-| "obj_relation_cuts (Structures_A.Reply _) x = {(x, reply_relation_cut)}"
 | "obj_relation_cuts (ArchObj ao) x = aobj_relation_cuts ao x"
 
 
@@ -460,9 +312,6 @@ lemma obj_relation_cuts_def2:
    (case ko of CNode sz cs \<Rightarrow> if well_formed_cnode_n sz cs
                              then {(cte_map (x, y), cte_relation y) | y. y \<in> dom cs}
                              else {(x, \<bottom>\<bottom>)}
-             | Structures_A.SchedContext sc n \<Rightarrow>
-                 if valid_sched_context_size n then {(x, sc_relation_cut)} else {(x, \<bottom>\<bottom>)}
-             | Structures_A.Reply reply \<Rightarrow> {(x, reply_relation_cut)}
              | TCB tcb \<Rightarrow> {(x, tcb_relation_cut)}
              | ArchObj (PageTable pt) \<Rightarrow> (\<lambda>y. (x + (ucast y << 2), pte_relation y))
                                            ` (UNIV :: word8 set)
@@ -476,11 +325,8 @@ lemma obj_relation_cuts_def2:
 
 lemma obj_relation_cuts_def3:
   "obj_relation_cuts ko x =
-  (case a_type ko of
+  (case (a_type ko) of
      ACapTable n \<Rightarrow> {(cte_map (x, y), cte_relation y) | y. length y = n}
-   | ASchedContext n \<Rightarrow>
-       if valid_sched_context_size n then {(x, sc_relation_cut)} else {(x, \<bottom>\<bottom>)}
-   | AReply \<Rightarrow> {(x, reply_relation_cut)}
    | ATCB \<Rightarrow> {(x, tcb_relation_cut)}
    | AArch APageTable \<Rightarrow> (\<lambda>y. (x + (ucast y << 2), pte_relation y))
                             ` (UNIV :: word8 set)
@@ -500,8 +346,6 @@ definition
  "is_other_obj_relation_type tp \<equiv>
   case tp of
      ACapTable n \<Rightarrow> False
-   | ASchedContext n \<Rightarrow> False
-   | AReply \<Rightarrow> False
    | ATCB \<Rightarrow> False
    | AArch APageTable \<Rightarrow> False
    | AArch APageDirectory \<Rightarrow> False
@@ -514,13 +358,6 @@ lemma is_other_obj_relation_type_CapTable:
   "\<not> is_other_obj_relation_type (ACapTable n)"
   by (simp add: is_other_obj_relation_type_def)
 
-lemma is_other_obj_relation_type_SchedContext:
-  "\<not> is_other_obj_relation_type (ASchedContext n)"
-  by (simp add: is_other_obj_relation_type_def)
-
-lemma is_other_obj_relation_type_Reply:
-  "\<not> is_other_obj_relation_type AReply"
-
 lemma is_other_obj_relation_type_TCB:
   "\<not> is_other_obj_relation_type ATCB"
   by (simp add: is_other_obj_relation_type_def)
@@ -552,27 +389,21 @@ where
   (\<forall>x \<in> dom ab. \<forall>(y, P) \<in> obj_relation_cuts (the (ab x)) x.
        P (the (ab x)) (the (con y)))"
 
-definition
-  sc_replies_relation_2 ::
-  "(obj_ref \<rightharpoonup> obj_ref list) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> bool" where
-  "sc_replies_relation_2 sc_repls scRepl replPrevs \<equiv>
-     \<forall>p replies. sc_repls p = Some replies \<longrightarrow> heap_ls replPrevs (scRepl p) replies"
-
-abbreviation sc_replies_relation :: "det_state \<Rightarrow> kernel_state \<Rightarrow> bool" where
-  "sc_replies_relation s s' \<equiv>
-    sc_replies_relation_2 (sc_replies_of s) (scReplies_of s') (replyPrevs_of s')"
-
-lemmas sc_replies_relation_def = sc_replies_relation_2_def
+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'"
 
-abbreviation sc_replies_relation_obj ::
-  "Structures_A.kernel_object \<Rightarrow> kernel_object \<Rightarrow> (obj_ref \<rightharpoonup> obj_ref) \<Rightarrow> bool" where
-  "sc_replies_relation_obj obj obj' nexts \<equiv>
-   case (obj, obj') of
-     (Structures_A.SchedContext sc _, KOSchedContext sc') \<Rightarrow>
-       heap_ls nexts (scReply sc') (sc_replies sc)"
+definition
+ ekheap_relation :: "(obj_ref \<Rightarrow> etcb option) \<Rightarrow> (word32 \<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 :: "Structures_A.scheduler_action \<Rightarrow> Structures_H.scheduler_action \<Rightarrow> bool"
+  sched_act_relation :: "Deterministic_A.scheduler_action \<Rightarrow> Structures_H.scheduler_action \<Rightarrow> bool"
 where
   "sched_act_relation resume_cur_thread a' = (a' = ResumeCurrentThread)" |
   "sched_act_relation choose_new_thread a' = (a' = ChooseNewThread)" |
@@ -628,11 +459,6 @@ abbreviation ready_queues_relation :: "det_state \<Rightarrow> kernel_state \<Ri
 
 lemmas ready_queues_relation_def = ready_queues_relation_2_def
 
-definition
-  release_queue_relation :: "Structures_A.release_queue \<Rightarrow> KernelStateData_H.release_queue \<Rightarrow> bool"
-where
-  "release_queue_relation qs qs' \<equiv> (qs = qs')"
-
 definition
   ghost_relation :: "Structures_A.kheap \<Rightarrow> (word32 \<rightharpoonup> vmpage_size) \<Rightarrow> (word32 \<rightharpoonup> nat) \<Rightarrow> bool"
 where
@@ -699,17 +525,12 @@ where
  "rights_mask_map \<equiv> \<lambda>rs. CapRights (AllowWrite \<in> rs) (AllowRead \<in> rs) (AllowGrant \<in> rs)
                                    (AllowGrantReply \<in> rs)"
 
+
 lemma obj_relation_cutsE:
   "\<lbrakk> (y, P) \<in> obj_relation_cuts ko x; P ko ko';
      \<And>sz cs z cap cte. \<lbrakk> ko = CNode sz cs; well_formed_cnode_n sz cs; y = cte_map (x, z);
                       ko' = KOCTE cte; cs z = Some cap; cap_relation cap (cteCap cte) \<rbrakk>
               \<Longrightarrow> R;
-     \<And>sc n sc'. \<lbrakk> y = x; ko = Structures_A.SchedContext sc n; valid_sched_context_size n;
-                      ko' = KOSchedContext sc'; sc_relation sc n sc' \<rbrakk>
-              \<Longrightarrow> R;
-     \<And>reply reply'. \<lbrakk> y = x; ko = Structures_A.Reply reply;
-                      ko' = KOReply reply'; reply_relation reply reply' \<rbrakk>
-              \<Longrightarrow> R;
      \<And>tcb tcb'. \<lbrakk> y = x; ko = TCB tcb; ko' = KOTCB tcb'; tcb_relation tcb tcb' \<rbrakk>
                \<Longrightarrow> R;
      \<And>pt (z :: word8) pte'. \<lbrakk> ko = ArchObj (PageTable pt); y = x + (ucast z << 2);
@@ -725,10 +546,10 @@ lemma obj_relation_cutsE:
   apply (simp add: obj_relation_cuts_def2 is_other_obj_relation_type_def tcb_relation_cut_def
                    a_type_def
             split: Structures_A.kernel_object.split_asm if_split_asm
-                   ARM_A.arch_kernel_obj.split_asm)
-  by (clarsimp split: if_splits kernel_object.split_asm,
-      clarsimp simp: cte_relation_def pte_relation_def pde_relation_def
-                     reply_relation_def sc_relation_def)+
+                   ARM_A.arch_kernel_obj.split_asm kernel_object.splits)
+      apply ((clarsimp split: if_splits,
+              force simp: cte_relation_def pte_relation_def pde_relation_def)+)[5]
+  done
 
 lemma eq_trans_helper:
   "\<lbrakk> x = y; P y = Q \<rbrakk> \<Longrightarrow> P x = Q"
@@ -801,10 +622,9 @@ definition
 where
  "state_relation \<equiv> {(s, s').
          pspace_relation (kheap s) (ksPSpace s')
-       \<and> sc_replies_relation s s'
+       \<and> ekheap_relation (ekheap s) (ksPSpace s')
        \<and> sched_act_relation (scheduler_action s) (ksSchedulerAction s')
        \<and> ready_queues_relation s s'
-       \<and> release_queue_relation (release_queue s) (ksReleaseQueue s')
        \<and> ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')
        \<and> cdt_relation (swp cte_at s) (cdt s) (ctes_of s')
        \<and> cdt_list_relation (cdt_list s) (cdt s) (ctes_of s')
@@ -813,18 +633,12 @@ where
        \<and> interrupt_state_relation (interrupt_irq_node s) (interrupt_states s) (ksInterruptState s')
        \<and> (cur_thread s = ksCurThread s')
        \<and> (idle_thread s = ksIdleThread s')
-       \<and> (idle_sc_ptr = ksIdleSC s')
        \<and> (machine_state s = ksMachineState s')
        \<and> (work_units_completed s = ksWorkUnitsCompleted s')
        \<and> (domain_index s = ksDomScheduleIdx s')
        \<and> (domain_list s = ksDomSchedule s')
        \<and> (cur_domain s = ksCurDomain s')
-       \<and> (domain_time s = ksDomainTime s')
-       \<and> (consumed_time s = ksConsumedTime s')
-       \<and> (cur_time s = ksCurTime s')
-       \<and> (cur_sc s = ksCurSc s')
-       \<and> (reprogram_timer s = ksReprogramTimer s')}"
-
+       \<and> (domain_time s = ksDomainTime s')}"
 
 text \<open>Rules for using states in the relation.\<close>
 
@@ -840,13 +654,9 @@ 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_release_queue_relation:
-  "(s,s') \<in> state_relation \<Longrightarrow> release_queue_relation (release_queue s) (ksReleaseQueue s')"
-  by (clarsimp simp: state_relation_def)
-
-lemma state_relation_sc_replies_relation:
-  "(s,s') \<in> state_relation \<Longrightarrow> sc_replies_relation s s'"
-  using state_relation_def by blast
+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')"
@@ -863,10 +673,9 @@ lemma state_relation_idle_thread[elim!]:
 lemma state_relationD:
   assumes sr:  "(s, s') \<in> state_relation"
   shows "pspace_relation (kheap s) (ksPSpace s') \<and>
-  sc_replies_relation s s' \<and>
+  ekheap_relation (ekheap s) (ksPSpace s') \<and>
   sched_act_relation (scheduler_action s) (ksSchedulerAction s') \<and>
   ready_queues_relation s s' \<and>
-  release_queue_relation (release_queue s) (ksReleaseQueue s') \<and>
   ghost_relation (kheap s) (gsUserPages s') (gsCNodes s') \<and>
   cdt_relation (swp cte_at s) (cdt s) (ctes_of s') \<and>
   cdt_list_relation (cdt_list s) (cdt s) (ctes_of s') \<and>
@@ -875,26 +684,20 @@ lemma state_relationD:
   interrupt_state_relation (interrupt_irq_node s) (interrupt_states s) (ksInterruptState s') \<and>
   cur_thread s = ksCurThread s' \<and>
   idle_thread s = ksIdleThread s' \<and>
-  idle_sc_ptr = ksIdleSC s' \<and>
   machine_state s = ksMachineState s' \<and>
   work_units_completed s = ksWorkUnitsCompleted s' \<and>
   domain_index s = ksDomScheduleIdx s' \<and>
   domain_list s = ksDomSchedule s' \<and>
   cur_domain s = ksCurDomain s' \<and>
-  domain_time s = ksDomainTime s' \<and>
-  consumed_time s = ksConsumedTime s' \<and>
-  cur_time s = ksCurTime s' \<and>
-  cur_sc s = ksCurSc s' \<and>
-  reprogram_timer s = ksReprogramTimer s'"
+  domain_time s = ksDomainTime s'"
   using sr unfolding state_relation_def by simp
 
 lemma state_relationE [elim?]:
   assumes sr:  "(s, s') \<in> state_relation"
   and rl: "\<lbrakk>pspace_relation (kheap s) (ksPSpace s');
-  sc_replies_relation s s';
+  ekheap_relation (ekheap s) (ksPSpace s');
   sched_act_relation (scheduler_action s) (ksSchedulerAction s');
   ready_queues_relation s s';
-  release_queue_relation (release_queue s) (ksReleaseQueue s');
   ghost_relation (kheap s) (gsUserPages s') (gsCNodes s');
   cdt_relation (swp cte_at s) (cdt s) (ctes_of s') \<and>
   revokable_relation (is_original_cap s) (null_filter (caps_of_state s)) (ctes_of s');
@@ -908,11 +711,7 @@ lemma state_relationE [elim?]:
   domain_index s = ksDomScheduleIdx s';
   domain_list s = ksDomSchedule s';
   cur_domain s = ksCurDomain s';
-  domain_time s = ksDomainTime s';
-  consumed_time s = ksConsumedTime s';
-  cur_time s = ksCurTime s';
-  cur_sc s = ksCurSc s';
-  reprogram_timer s = ksReprogramTimer s' \<rbrakk> \<Longrightarrow> R"
+  domain_time s = ksDomainTime s' \<rbrakk> \<Longrightarrow> R"
   shows "R"
   using sr by (blast intro!: rl dest: state_relationD)
 
@@ -923,7 +722,6 @@ lemmas isCap_defs =
   isThreadCap_def isCNodeCap_def isNotificationCap_def
   isEndpointCap_def isUntypedCap_def isNullCap_def
   isIRQHandlerCap_def isIRQControlCap_def isReplyCap_def
-  isSchedContextCap_def isSchedControlCap_def
   isPageCap_def isPageTableCap_def isPageDirectoryCap_def
   isASIDControlCap_def isASIDPoolCap_def isArchPageCap_def
   isDomainCap_def
@@ -934,23 +732,10 @@ lemma isCNodeCap_cap_map [simp]:
    apply clarsimp+
   done
 
-lemma cap_rel_valid_fh:
-  "cap_relation a b \<Longrightarrow> valid_fault_handler a = isValidFaultHandler b"
-  apply (case_tac a
-         ; case_tac b
-         ; simp add: valid_fault_handler_def isValidFaultHandler_def)
-  apply (rule iffI
-         ; clarsimp simp: has_handler_rights_def split: bool.split_asm)
-  done
-
 lemma sts_rel_idle :
   "thread_state_relation st IdleThreadState = (st = Structures_A.IdleThreadState)"
   by (cases st, auto)
 
-lemma sts_rel_runnable :
-  "\<lbrakk>thread_state_relation st st'; runnable st\<rbrakk> \<Longrightarrow> runnable' st'"
-  by (cases st, auto)
-
 lemma pspace_relation_absD:
   "\<lbrakk> ab x = Some y; pspace_relation ab con \<rbrakk>
       \<Longrightarrow> \<forall>(x', P) \<in> obj_relation_cuts y x. \<exists>z. con x' = Some z \<and> P y z"
@@ -965,32 +750,10 @@ lemma pspace_relation_absD:
   apply (simp add: image_def rev_bexI)
   done
 
-lemma pspace_relation_None:
-  "\<lbrakk>pspace_relation p p'; p' ptr = None \<rbrakk> \<Longrightarrow> p ptr = None"
-  apply (rule not_Some_eq[THEN iffD1, OF allI, OF notI])
-  apply (drule(1) pspace_relation_absD)
-   apply (case_tac y; clarsimp simp: cte_map_def of_bl_def well_formed_cnode_n_def split: if_splits)
-   subgoal for n
-    apply (drule spec[of _ ptr])
-    apply (drule spec)
-    apply clarsimp
-    apply (drule spec[of _ "replicate n False"])
-    apply (drule mp[OF _ refl])
-     apply (drule mp)
-    subgoal premises by (induct n; simp)
-    apply clarsimp
-    done
-  subgoal for x
-     apply (cases x; clarsimp)
-   apply ((drule spec[of _ 0], fastforce)+)[2]
-   apply (drule spec[of _ ptr])
-   apply (drule spec)
-   apply clarsimp
-   apply (drule mp[OF _ refl])
-   apply (drule spec[of _ 0])
-   subgoal for _ sz by (cases sz; simp add: pageBits_def)
-   done
-  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"
@@ -1019,409 +782,5 @@ lemma ghost_relation_typ_at:
    apply (intro conjI impI iffI allI; force)
    done
 
-(* more replyNext/replyPrev related lemmas *)
-
-lemma sc_replies_relation_replyNext_None:
-  "\<lbrakk>sc_replies_relation s s'; reply_at rp s; replies_of' s' rp \<noteq> None;
-    \<forall>p'. replyPrevs_of s' p' \<noteq> Some rp; \<forall>p'. scReplies_of s' p' \<noteq> Some rp\<rbrakk>
-     \<Longrightarrow> sc_replies_relation s (s'\<lparr>ksPSpace := (ksPSpace s')(rp \<mapsto> KOReply r)\<rparr>)"
-  apply (clarsimp simp: sc_replies_relation_def)
-  apply (rename_tac scp replies)
-  apply (drule_tac x=scp and y=replies in spec2)
-  apply simp
-  apply (clarsimp simp: projectKO_opts_defs obj_at'_def opt_map_red obj_at_def is_reply vs_all_heap_simps)
-  apply (rename_tac ko scp sc reply n)
-  apply (case_tac ko; clarsimp)
-  apply (intro conjI; clarsimp)
-  apply (rename_tac sc reply n)
-  apply (rule heap_path_heap_upd_not_in, simp)
-  apply clarsimp
-  apply (frule split_list)
-  apply (elim exE)
-  apply (simp only:)
-  apply (case_tac ys; simp only:)
-   apply (clarsimp simp: opt_map_red)
-  apply (prop_tac "\<exists>ls x. a # list = ls @ [x]")
-   using append_butlast_last_id apply fastforce
-  apply (elim exE conjE, simp only:)
-  apply (prop_tac "(ls @ [x]) @ rp # zs = ls @ x # rp # zs", simp)
-  apply (simp only:)
-  apply (frule_tac z=x in heap_path_non_nil_lookup_next)
-  apply (clarsimp simp: opt_map_red)
-  done
-
-lemma sc_replies_relation_scReplies_of:
-  "\<lbrakk>sc_replies_relation s s'; sc_at sc_ptr s; bound (scs_of' s' sc_ptr)\<rbrakk>
-   \<Longrightarrow> (sc_replies_of s |> hd_opt) sc_ptr = scReplies_of s' sc_ptr"
-  by (fastforce simp: sc_replies_relation_def sc_replies_of_scs_def scs_of_kh_def map_project_def
-                      hd_opt_def obj_at_def is_sc_obj_def opt_map_def
-               split: option.splits Structures_A.kernel_object.splits list.splits)
-
-lemma sc_replies_prevs_walk:
-  "\<lbrakk> sc_replies_relation s s';
-     ksPSpace s' p = Some (KOSchedContext sc'); kheap s p = Some (kernel_object.SchedContext sc n) \<rbrakk>
-   \<Longrightarrow> heap_walk (replyPrevs_of s') (scReply sc') [] = sc_replies sc"
-  unfolding sc_replies_relation_def
-  apply (erule_tac x=p in allE)
-  apply (erule_tac x="sc_replies sc" in allE)
-  apply (clarsimp simp: sc_replies.all_simps)
-  apply (rule heap_ls_is_walk)
-  apply (subgoal_tac "scReplies_of s' p = scReply sc'", simp)
-  apply (clarsimp simp: opt_map_def projectKO_opt_sc)
-  done
-
-lemma sc_replies_relation_prevs_list:
-  "\<lbrakk> sc_replies_relation s s';
-     kheap s x = Some (kernel_object.SchedContext sc n);
-     ksPSpace s' x = Some (KOSchedContext sc')\<rbrakk>
-    \<Longrightarrow> heap_ls (replyPrevs_of s') (scReply sc') (sc_replies sc)"
-  apply (clarsimp simp: sc_replies_relation_def sc_replies_of_scs_def scs_of_kh_def map_project_def)
-  apply (drule_tac x=x and y="sc_replies sc" in spec2)
-  apply (clarsimp simp: opt_map_def projectKO_opt_sc split: option.splits)
-  done
-
-lemma list_refs_of_replies'_reftype[simp]:
-  "(p, reftype) \<in> list_refs_of_replies' s' p' \<Longrightarrow> reftype \<in> {ReplyPrev, ReplyNext}"
-  by (clarsimp simp: list_refs_of_replies'_def list_refs_of_reply'_def get_refs_def2
-              elim!: opt_mapE
-              split: option.split_asm)
-
-lemma replyNext_replyNexts_of_opt_map:
-  "\<lbrakk>ksPSpace s' p = Some (KOReply reply); replyNext reply = Some (Next p')\<rbrakk>
-    \<Longrightarrow> (replyNexts_of s' |> f s') p = f s' p'"
-  by (clarsimp simp: opt_map_red projectKO_opt_reply split: option.split)
-
-lemma replyPrevs_of_refs:
-  "replyPrevs_of s' p = Some p' \<longleftrightarrow> (p', ReplyPrev) \<in> list_refs_of_replies' s' p"
-  by (fastforce simp: map_set_def list_refs_of_reply'_def opt_map_def get_refs_def
-               split: option.splits)
-
-lemma replyNexts_of_refs:
-  "replyNexts_of s' p = Some p' \<longleftrightarrow> (p', ReplyNext) \<in> list_refs_of_replies' s' p"
-  by (fastforce simp: map_set_def list_refs_of_reply'_def opt_map_def get_refs_def
-               split: option.splits)
-
-lemma sym_replies_prev_then_next_id_p:
-  "\<lbrakk>sym_refs (list_refs_of_replies' s'); replyPrevs_of s' p = Some p'\<rbrakk>
-   \<Longrightarrow> (replyPrevs_of s' |> replyNexts_of s') p = Some p"
-  apply (clarsimp simp: replyPrevs_of_refs replyNexts_of_refs opt_map_red)
-  by (drule (1) sym_refsD[rotated], simp)
-
-lemma sym_replies_next_then_prev_id_p:
-  "\<lbrakk>sym_refs (list_refs_of_replies' s'); replyNexts_of s' p = Some p'\<rbrakk>
-   \<Longrightarrow> (replyNexts_of s' |> replyPrevs_of s') p = Some p"
-  supply opt_map_red[simp]
-  apply (clarsimp simp: replyPrevs_of_refs replyNexts_of_refs)
-  by (drule (1) sym_refsD[rotated], simp)
-
-(* Some results related to the size of scheduling contexts *)
-
-lemma sc_const_eq:
-  "refillSizeBytes = (refill_size_bytes::nat)"
-  "schedContextStructSize = sizeof_sched_context_t"
-  "minSchedContextBits = min_sched_context_bits"
-  by (auto simp: refillSizeBytes_def refill_size_bytes_def minSchedContextBits_def
-                 wordSize_def wordBits_def' word_size_def
-                 sizeof_sched_context_t_def min_sched_context_bits_def schedContextStructSize_def)
-
-lemma max_num_refills_eq_refillAbsoluteMax':
-  "max_num_refills = refillAbsoluteMax'"
-  by (rule ext)
-     (simp add: max_num_refills_def refillAbsoluteMax'_def shiftL_nat sc_const_eq)
-
-lemma maxUntyped_eq:
-  "untyped_max_bits = maxUntypedSizeBits"
-  by (simp add: untyped_max_bits_def maxUntypedSizeBits_def)
-
-lemmas sc_const_conc = sc_const_eq[symmetric] max_num_refills_eq_refillAbsoluteMax' maxUntyped_eq
-
-lemma refillAbsoluteMax'_mono:
-  fixes x y
-  assumes "minSchedContextBits \<le> x"
-    and "x \<le> y"
-  shows "refillAbsoluteMax' x \<le> refillAbsoluteMax' y"
-proof -
-  show ?thesis
-    unfolding refillAbsoluteMax'_def
-    using assms
-    by (simp add: diff_le_mono div_le_mono shiftL_nat)
-qed
-
-lemmas scBits_simps = refillAbsoluteMax_def sc_size_bounds_def sc_const_conc
-
-lemma minSchedContextBits_check:
-  "minSchedContextBits = (LEAST n. schedContextStructSize + MIN_REFILLS * refillSizeBytes \<le> 2 ^ n)"
-proof -
-  note simps = minSchedContextBits_def sc_const_eq(2) sizeof_sched_context_t_def word_size_def
-               MIN_REFILLS_def refillSizeBytes_def
-  show ?thesis
-    apply (rule sym)
-    apply (rule Least_equality)
-     apply (clarsimp simp: simps)
-    apply (rename_tac n)
-    apply (rule ccontr)
-    apply (simp add: not_le)
-    apply (prop_tac "2 ^ n \<le> 2 ^ (minSchedContextBits - 1)")
-     apply (fastforce intro: power_increasing_iff[THEN iffD2])
-    using less_le_trans
-    by (fastforce simp: simps)
-qed
-
-lemma minSchedContextBits_rel:
-  "schedContextStructSize + MIN_REFILLS * refillSizeBytes \<le> 2 ^ minSchedContextBits"
-  apply (simp add: minSchedContextBits_check)
-  by (meson self_le_ge2_pow order_refl wellorder_Least_lemma(1))
-
-lemma refillAbsoluteMax'_greatest:
-  assumes "schedContextStructSize \<le> 2 ^ n"
-  shows "refillAbsoluteMax' n = (GREATEST r. schedContextStructSize + r * refillSizeBytes \<le> 2 ^ n)"
-  apply (simp flip: max_num_refills_eq_refillAbsoluteMax'
-               add: max_num_refills_def scBits_simps(4) scBits_simps(3))
-  apply (rule sym)
-  apply (rule Greatest_equality)
-   apply (metis assms le_diff_conv2 le_imp_diff_is_add div_mult_le le_add1 diff_add_inverse)
-  apply (rename_tac r)
-  apply (prop_tac "r * refillSizeBytes \<le> 2 ^ n - schedContextStructSize")
-   apply linarith
-  apply (drule_tac k=refillSizeBytes in div_le_mono)
-  by (simp add: refillSizeBytes_def)
-
-lemma refillAbsoluteMax'_leq:
-  "schedContextStructSize \<le> 2 ^ n \<Longrightarrow>
-   schedContextStructSize + refillAbsoluteMax' n * refillSizeBytes \<le> 2 ^ n"
-  apply (frule refillAbsoluteMax'_greatest)
-   apply (simp add: refillSizeBytes_def)
-  apply (rule_tac b="2 ^ n" in GreatestI_ex_nat)
-   apply presburger
-  by fastforce
-
-lemma schedContextStructSize_minSchedContextBits:
-  "schedContextStructSize \<le> 2 ^ minSchedContextBits"
-  apply (insert minSchedContextBits_check)
-  by (metis LeastI_ex add_leD1 le_refl self_le_ge2_pow)
-
-lemma MIN_REFILLS_refillAbsoluteMax'[simp]:
-  "minSchedContextBits \<le> us \<Longrightarrow> MIN_REFILLS \<le> refillAbsoluteMax' us"
-  apply (insert minSchedContextBits_rel)
-  apply (frule_tac b1=2 in power_increasing_iff[THEN iffD2, rotated])
-   apply fastforce
-  apply (subst refillAbsoluteMax'_greatest)
-   apply (insert schedContextStructSize_minSchedContextBits)
-   apply (fastforce elim!: order_trans)
-  apply (rule_tac b="2 ^ us" in Greatest_le_nat)
-   apply (fastforce intro: order_trans)
-  apply (clarsimp simp: refillSizeBytes_def)
-  done
-
-lemma scBits_pos_power2:
-  assumes "minSchedContextBits + scSize sc < word_bits"
-  shows "(1::machine_word) < (2::machine_word) ^ (minSchedContextBits + scSize sc)"
-  apply (insert assms)
-  apply (subst word_less_nat_alt)
-  apply (clarsimp simp: minSchedContextBits_def)
-  by (auto simp: pow_mono_leq_imp_lt)
-
-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 archObjSize_def pteBits_def pdeBits_def objBits_simps scBits_pos_power2
-         split: arch_kernel_object.split)+
-
-lemma objBitsKO_no_overflow[simp, intro!]:
-  "objBitsKO ko < word_bits \<Longrightarrow> (1::machine_word) < (2::machine_word)^(objBitsKO ko)"
-  by (cases ko; simp add: objBits_simps' pageBits_def archObjSize_def pteBits_def pdeBits_def
-                          scBits_pos_power2
-                   split: arch_kernel_object.splits)
-
-(* for handling refill buffer *)
-
-abbreviation replaceAt where
-  "replaceAt i xs new \<equiv> updateAt i xs (\<lambda>_. new)"
-
-lemmas replaceAt_def = updateAt_def
-
-lemma length_updateAt[simp]:
-  "length (updateAt i xs f) = length xs"
-  apply (clarsimp simp: updateAt_def)
-  by (case_tac xs; simp)
-
-lemma wrap_slice_index:
-  "\<lbrakk>count \<le> mx; start < mx; mx \<le> length xs; index < count\<rbrakk>
-   \<Longrightarrow> (wrap_slice start count mx xs) ! index
-       = (if start + index < mx
-             then (xs ! (start + index))
-             else (xs ! (start + index - mx)))"
-  apply (clarsimp split: if_splits)
-  apply (intro conjI)
-   apply (clarsimp simp: wrap_slice_def)
-   apply (prop_tac "index < mx - start", linarith)
-   apply (prop_tac "(take (mx - start) (drop start xs) @ take (start + count - mx) xs) ! index
-                    = (take (mx - start) (drop start xs)) ! index")
-    apply (simp add: nth_append)
-   apply fastforce
-  apply (clarsimp simp: wrap_slice_def)
-  apply (cases "index < mx - start")
-   apply linarith
-  apply (drule not_less[THEN iffD1])+
-  apply (prop_tac "(take (mx - start) (drop start xs) @ take (start + count - mx) xs) ! index
-                   = (take (start + count - mx) xs) ! (index - (mx - start))")
-   apply (prop_tac "mx - start \<le> index", linarith)
-   apply (simp add: nth_append)
-  using less_imp_le_nat nat_le_iff_add apply auto
-  done
-
-lemma wrap_slice_append:
-  "\<lbrakk>Suc count \<le> mx; start < mx; mx \<le> length xs\<rbrakk>
-   \<Longrightarrow> wrap_slice start (Suc count) mx xs
-       = wrap_slice start count mx xs @ [if (start + count < mx)
-                                            then (xs ! (start + count))
-                                            else (xs ! (start + count - mx))]"
-  apply (rule nth_equalityI)
-   apply simp
-  apply (rename_tac i)
-  apply (case_tac "i < count")
-   apply (prop_tac "(wrap_slice start count mx xs
-                     @ [if start + count < mx
-                           then xs ! (start + count)
-                           else xs ! (start + count - mx)]) ! i
-                    = (wrap_slice start count mx xs) ! i")
-    apply (metis length_wrap_slice Suc_leD less_imp_le_nat nth_append)
-   apply (simp add: wrap_slice_index)
-  apply (prop_tac "(wrap_slice start count mx xs
-                    @ [if start + count < mx
-                          then xs ! (start + count)
-                          else xs ! (start + count - mx)]) ! i
-                   = (if start + count < mx
-                         then xs ! (start + count)
-                         else xs ! (start + count - mx))")
-   apply (clarsimp simp: nth_append)
-  apply (simp add: wrap_slice_index)
-  apply (prop_tac "i = count", linarith)
-  apply simp
-  done
-
-lemma updateAt_index:
-  "\<lbrakk>xs \<noteq> []; i < length xs; j < length xs\<rbrakk>
-   \<Longrightarrow> (updateAt i xs f) ! j = (if i = j then f (xs ! i) else (xs ! j))"
-  by (fastforce simp: updateAt_def null_def nth_append)
-
-lemma wrap_slice_updateAt_eq:
-  "\<lbrakk>if start + count \<le> mx
-       then (i < start \<or> start + count \<le> i)
-       else (start + count - mx \<le> i \<and> i < start);
-    count \<le> mx; start < mx; mx \<le> length xs; xs \<noteq> []; i < mx\<rbrakk>
-   \<Longrightarrow> wrap_slice start count mx xs = wrap_slice start count mx (updateAt i xs new)"
-  apply (rule nth_equalityI)
-   apply clarsimp
-  by (subst wrap_slice_index; clarsimp simp: updateAt_index split: if_split_asm)+
-
-lemma take_updateAt_eq[simp]:
-  "n \<le> i \<Longrightarrow> take n (updateAt i ls f) = take n ls"
-  by (clarsimp simp: updateAt_def)
-
-lemma refills_tl_equal:
-  "\<lbrakk>sc_relation sc n sc'; sc_valid_refills' sc'\<rbrakk>
-   \<Longrightarrow> refill_tl sc = refill_map (refillTl sc')"
-  apply (clarsimp simp: sc_relation_def refillTl_def refills_map_def)
-  apply (subst last_conv_nth)
-   apply (prop_tac "0 < scRefillCount sc'", blast)
-   apply (metis length_wrap_slice Nat.add_0_right le0 le_eq_less_or_eq less_add_eq_less
-                less_imp_le_nat map_is_Nil_conv not_gr0 plus_nat.add_0 wrap_slice_empty)
-  apply (subst nth_map)
-   apply fastforce
-  apply (subst wrap_slice_index; clarsimp simp: refillTailIndex_def)
-  done
-
-(* wrap_slice *)
-lemma wrap_slice_start_0:
-  "\<lbrakk>0 < count; mx \<le> length ls; count \<le> mx\<rbrakk> \<Longrightarrow> wrap_slice 0 count mx ls = take count ls"
-  by (clarsimp simp: wrap_slice_def)
-
-lemma butlast_wrap_slice:
-  "\<lbrakk>0 < count; start < mx; count \<le> mx; mx \<le> length list\<rbrakk> \<Longrightarrow>
-   butlast (wrap_slice start count mx list) =  wrap_slice start (count -1) mx list"
-  by (case_tac "start + count - 1 < mx"; clarsimp simp: wrap_slice_def butlast_conv_take add_ac)
-
-lemma last_wrap_slice:
-  "\<lbrakk>0 < count; start < mx; count \<le> mx; mx \<le> length list\<rbrakk>
-   \<Longrightarrow> last (wrap_slice start count mx list)
-           = list ! (if start + count - 1 < mx then start + count - 1 else start + count - mx -1)"
-  by (fastforce simp: wrap_slice_def last_take last_append not_le)
-
-lemma tl_wrap_slice:
-  "\<lbrakk>0 < count; mx \<le> length list; start < mx\<rbrakk> \<Longrightarrow>
-   tl (wrap_slice start count mx list) = wrap_slice (start + 1) (count - 1) mx list"
-  by (fastforce simp: wrap_slice_def tl_take tl_drop drop_Suc)
-
-lemma wrap_slice_max[simp]:
-  "wrap_slice start count start list = take count list"
-  by (clarsimp simp: wrap_slice_def)
-
-lemma length_refills_map[simp]:
-  "\<lbrakk> mx \<le> length list; count \<le> mx \<rbrakk> \<Longrightarrow> length (refills_map start count mx list) = count"
-  by (clarsimp simp: refills_map_def)
-
-lemma sc_valid_refills_scRefillCount:
-  "\<lbrakk>sc_valid_refills sc; sc_relation sc n sc'\<rbrakk> \<Longrightarrow> 0 < scRefillCount sc'"
-  apply (clarsimp simp: valid_sched_context_def sc_relation_def)
-  apply (case_tac "scRefillCount sc'"; simp)
-  by (clarsimp simp: refills_map_def sc_valid_refills_def rr_valid_refills_def split: if_splits)
-
-lemma sc_refills_neq_zero_cross:
-  "\<lbrakk>sc_relation sc n sc'; sc_refills sc \<noteq> []\<rbrakk>
-   \<Longrightarrow> refills_map (scRefillHead sc') (scRefillCount sc') (scRefillMax sc') (scRefills sc') \<noteq> []"
-  by (clarsimp simp: sc_relation_def)
-
-lemma refills_map_non_empty_pos_count:
-  "refills_map start count mx list \<noteq> [] \<Longrightarrow> 0 < count \<and> 0 < mx"
-  apply (clarsimp simp: refills_map_def refill_map_def wrap_slice_def split: if_split_asm)
-  by linarith
-
-lemma hd_refills_map:
-  "\<lbrakk>refills_map start count mx list \<noteq> []; mx \<le> length list; start < mx\<rbrakk>
-   \<Longrightarrow> hd (refills_map start count mx list) = refill_map (list ! start)"
-  apply (frule refills_map_non_empty_pos_count)
-  apply (clarsimp simp: refills_map_def)
-  by (simp add: hd_map hd_wrap_slice)
-
-lemma refill_hd_relation:
-  "sc_relation sc n sc' \<Longrightarrow> sc_valid_refills' sc' \<Longrightarrow> refill_hd sc = refill_map (refillHd sc')"
-  apply (clarsimp simp: sc_relation_def refillHd_def refills_map_def valid_sched_context'_def hd_map)
-  apply (subst hd_map, clarsimp simp: wrap_slice_def)
-  apply (clarsimp simp: hd_wrap_slice)
-  done
-
-lemma refill_hd_relation2:
-  "\<lbrakk>sc_relation sc n sc'; sc_refills sc \<noteq> []; valid_sched_context' sc' s'\<rbrakk>
-   \<Longrightarrow> rAmount (refillHd sc') = r_amount (refill_hd sc)
-       \<and> rTime (refillHd sc') = r_time (refill_hd sc)"
-  apply (frule refill_hd_relation)
-   apply (frule (1) sc_refills_neq_zero_cross[THEN refills_map_non_empty_pos_count])
-   apply (simp add: valid_sched_context'_def)
-  apply (clarsimp simp: refill_map_def)
-  done
-
-lemma sc_refill_ready_relation:
-  "\<lbrakk>sc_relation sc n sc'; sc_valid_refills' sc'\<rbrakk> \<Longrightarrow>
-  sc_refill_ready time sc = (rTime (refillHd sc') \<le> time + kernelWCETTicks)"
-   apply (frule (1) refill_hd_relation)
-  by (clarsimp simp: refill_ready_def kernelWCETTicks_def refill_map_def)
-
-lemma sc_refill_capacity_relation:
-  "\<lbrakk>sc_relation sc n sc'; sc_valid_refills' sc'\<rbrakk> \<Longrightarrow>
-  sc_refill_capacity x sc = refillsCapacity x (scRefills sc') (scRefillHead sc')"
-  apply (frule (1) refill_hd_relation)
-  by (clarsimp simp: refillsCapacity_def refill_capacity_def refillHd_def refill_map_def)
-
-lemma sc_refill_sufficient_relation:
-  "\<lbrakk>sc_relation sc n sc'; sc_valid_refills' sc'\<rbrakk> \<Longrightarrow>
-  sc_refill_sufficient x sc = sufficientRefills x (scRefills sc') (scRefillHead sc')"
-  apply (frule (1) sc_refill_capacity_relation[where x=x])
-  by (clarsimp simp: sufficientRefills_def refill_sufficient_def minBudget_def MIN_BUDGET_def
-                        kernelWCETTicks_def)
-
 end
 end
diff --git a/proof/refine/ARM/SubMonad_R.thy b/proof/refine/ARM/SubMonad_R.thy
index 5692bc4060..a7ac1b8281 100644
--- a/proof/refine/ARM/SubMonad_R.thy
+++ b/proof/refine/ARM/SubMonad_R.thy
@@ -47,7 +47,7 @@ lemma doMachineOp_mapM_x:
   done
 
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 definition
   "asUser_fetch \<equiv> \<lambda>t s. case (ksPSpace s t) of
       Some (KOTCB tcb) \<Rightarrow> (atcbContextGet o tcbArch) tcb
@@ -64,12 +64,12 @@ definition
 lemma threadGet_stateAssert_gets_asUser:
   "threadGet (atcbContextGet o tcbArch) t = do stateAssert (tcb_at' t) []; gets (asUser_fetch t) od"
   apply (rule is_stateAssert_gets [OF _ _ empty_fail_threadGet no_fail_threadGet])
-    apply (clarsimp simp: threadGet_def liftM_def, wp, simp)
-   apply (simp add: threadGet_def liftM_def, wp getObject_tcb_at',
-          clarsimp simp: threadRead_tcb_at')
-  apply (wpsimp simp: threadGet_def)
-  apply (drule use_ovalid[OF ovalid_threadRead_sp], simp)
-  apply (clarsimp simp: obj_at'_def asUser_fetch_def projectKOs atcbContextGet_def o_def)
+    apply (clarsimp simp: threadGet_def liftM_def, wp)
+   apply (simp add: threadGet_def liftM_def, wp getObject_tcb_at')
+  apply (simp add: threadGet_def liftM_def, wp)
+   apply (rule hoare_strengthen_post, rule getObject_obj_at')
+     apply (simp add: objBits_simps')+
+   apply (clarsimp simp: obj_at'_def asUser_fetch_def projectKOs atcbContextGet_def o_def)+
   done
 
 lemma threadSet_modify_asUser:
diff --git a/proof/refine/ARM/Syscall_R.thy b/proof/refine/ARM/Syscall_R.thy
index d4a9721271..1b6188b32e 100644
--- a/proof/refine/ARM/Syscall_R.thy
+++ b/proof/refine/ARM/Syscall_R.thy
@@ -9,10 +9,10 @@
 *)
 
 theory Syscall_R
-imports Tcb_R Arch_R Interrupt_R SchedContextInv_R
+imports Tcb_R Arch_R Interrupt_R
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 (*
 syscall has 5 sections: m_fault h_fault m_error h_error m_finalise
@@ -88,16 +88,12 @@ where
      (x = InvokeEndpoint w w2 b c)"
 | "inv_relation (Invocations_A.InvokeNotification w w2) x =
      (x = InvokeNotification w w2)"
-| "inv_relation (Invocations_A.InvokeReply w grant) x =
-     (x = InvokeReply w grant)"
+| "inv_relation (Invocations_A.InvokeReply w ptr grant) x =
+     (x = InvokeReply w (cte_map ptr) grant)"
 | "inv_relation (Invocations_A.InvokeTCB i) x =
      (\<exists>i'. tcbinv_relation i i' \<and> x = InvokeTCB i')"
 | "inv_relation (Invocations_A.InvokeDomain tptr domain) x =
      (x = InvokeDomain tptr domain)"
-| "inv_relation (Invocations_A.InvokeSchedContext sc_inv) x =
-     (\<exists>sc_inv'. sc_inv_rel sc_inv sc_inv' \<and> x = InvokeSchedContext sc_inv')"
-| "inv_relation (Invocations_A.InvokeSchedControl sc_control_inv) x =
-     (\<exists>sc_inv'. sc_ctrl_inv_rel sc_control_inv sc_inv' \<and> x = InvokeSchedControl sc_inv')"
 | "inv_relation (Invocations_A.InvokeIRQControl i) x =
      (\<exists>i'. irq_control_inv_relation i i' \<and> x = InvokeIRQControl i')"
 | "inv_relation (Invocations_A.InvokeIRQHandler i) x =
@@ -117,18 +113,18 @@ where
 primrec
   valid_invocation' :: "Invocations_H.invocation \<Rightarrow> kernel_state \<Rightarrow> bool"
 where
-  "valid_invocation' (InvokeUntyped i) = valid_untyped_inv' i"
-| "valid_invocation' (InvokeEndpoint w w2 b c) = (ep_at' w and ex_nonz_cap_to' w)"
-| "valid_invocation' (InvokeNotification w w2) = (ntfn_at' w and ex_nonz_cap_to' w)"
-| "valid_invocation' (InvokeTCB i) = tcb_inv_wf' i"
-| "valid_invocation' (InvokeDomain thread domain) = (tcb_at' thread  and K (domain \<le> maxDomain))"
-| "valid_invocation' (InvokeSchedContext i) = valid_sc_inv' i"
-| "valid_invocation' (InvokeSchedControl i) = valid_sc_ctrl_inv' i"
-| "valid_invocation' (InvokeReply reply grant) = reply_at' reply"
-| "valid_invocation' (InvokeIRQControl i) = irq_control_inv_valid' i"
-| "valid_invocation' (InvokeIRQHandler i) = irq_handler_inv_valid' i"
-| "valid_invocation' (InvokeCNode i) = valid_cnode_inv' i"
-| "valid_invocation' (InvokeArchObject i) = valid_arch_inv' i"
+  "valid_invocation' (Invocations_H.InvokeUntyped i) = valid_untyped_inv' i"
+| "valid_invocation' (Invocations_H.InvokeEndpoint w w2 b c) = (ep_at' w and ex_nonz_cap_to' w)"
+| "valid_invocation' (Invocations_H.InvokeNotification w w2) = (ntfn_at' w and ex_nonz_cap_to' w)"
+| "valid_invocation' (Invocations_H.InvokeTCB i) = tcb_inv_wf' i"
+| "valid_invocation' (Invocations_H.InvokeDomain thread domain) =
+   (tcb_at' thread  and K (domain \<le> maxDomain))"
+| "valid_invocation' (Invocations_H.InvokeReply thread slot grant) =
+       (tcb_at' thread and cte_wp_at' (\<lambda>cte. \<exists>gr. cteCap cte = ReplyCap thread False gr) slot)"
+| "valid_invocation' (Invocations_H.InvokeIRQControl i) = irq_control_inv_valid' i"
+| "valid_invocation' (Invocations_H.InvokeIRQHandler i) = irq_handler_inv_valid' i"
+| "valid_invocation' (Invocations_H.InvokeCNode i) = valid_cnode_inv' i"
+| "valid_invocation' (Invocations_H.InvokeArchObject i) = valid_arch_inv' i"
 
 
 (* FIXME: move *)
@@ -173,62 +169,54 @@ lemma decodeInvocation_corres:
            (invs and valid_sched and valid_list
                  and valid_cap cap and cte_at slot and cte_wp_at ((=) cap) slot
                  and (\<lambda>s. \<forall>x\<in>set excaps. s \<turnstile> fst x \<and> cte_at (snd x) s)
-                 and case_option \<top> in_user_frame buffer
                  and (\<lambda>s. length args < 2 ^ word_bits))
            (invs' and valid_cap' cap' and cte_at' slot'
             and (\<lambda>s. \<forall>x\<in>set excaps'. s \<turnstile>' fst x \<and> cte_at' (snd x) s)
-            and case_option \<top> valid_ipc_buffer_ptr' buffer
             and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
-      (decode_invocation first_phase (mi_label mi) args cptr slot cap excaps buffer)
-      (RetypeDecls_H.decodeInvocation (msgLabel mi') args' cptr' slot' cap' excaps' first_phase buffer)"
+      (decode_invocation (mi_label mi) args cptr slot cap excaps)
+      (RetypeDecls_H.decodeInvocation (mi_label mi) args' cptr' slot' cap' excaps')"
   apply (rule corres_gen_asm)
   apply (unfold decode_invocation_def decodeInvocation_def)
   apply (case_tac cap, simp_all only: cap.simps)
    \<comment> \<open>dammit, simp_all messes things up, must handle cases manually\<close>
              \<comment> \<open>Null\<close>
-               apply (simp add: isCap_defs)
-              \<comment> \<open>Untyped\<close>
-              apply (simp add: isCap_defs Let_def o_def split del: if_split)
+             apply (simp add: isCap_defs)
+            \<comment> \<open>Untyped\<close>
+            apply (simp add: isCap_defs Let_def o_def split del: if_split)
             apply (rule corres_guard_imp, rule decodeUntypedInvocation_corres)
-                apply ((clarsimp simp:cte_wp_at_caps_of_state)+)[3]
-             \<comment> \<open>(Async)Endpoint\<close>
-             apply (simp add: isCap_defs returnOk_def)
-            apply (simp add: isCap_defs)
-            apply (clarsimp simp: returnOk_def neq_Nil_conv)
-           \<comment> \<open>ReplyCap\<close>
-           apply (simp add: isCap_defs Let_def returnOk_def)
-          \<comment> \<open>CNodeCap\<close>
-          apply (rename_tac word nat list)
-          apply (simp add: isCap_defs Let_def CanModify_def
-                      split del: if_split cong: if_cong)
-          apply (clarsimp simp add: o_def)
-          apply (rule corres_guard_imp)
-            apply (rule_tac F="length list \<le> 32" in corres_gen_asm)
+              apply ((clarsimp simp:cte_wp_at_caps_of_state)+)[3]
+           \<comment> \<open>(Async)Endpoint\<close>
+           apply (simp add: isCap_defs returnOk_def)
+          apply (simp add: isCap_defs)
+          apply (clarsimp simp: returnOk_def neq_Nil_conv)
+         \<comment> \<open>ReplyCap\<close>
+         apply (simp add: isCap_defs Let_def returnOk_def)
+        \<comment> \<open>CNodeCap\<close>
+        apply (rename_tac word nat list)
+        apply (simp add: isCap_defs Let_def CanModify_def
+                    split del: if_split cong: if_cong)
+        apply (clarsimp simp add: o_def)
+        apply (rule corres_guard_imp)
+          apply (rule_tac F="length list \<le> 32" in corres_gen_asm)
           apply (rule decodeCNodeInvocation_corres, simp+)
-           apply (simp add: valid_cap_def word_bits_def)
-          apply simp
-         \<comment> \<open>ThreadCap\<close>
-         apply (simp add: isCap_defs Let_def CanModify_def
-                     split del: if_split cong: if_cong)
-         apply (clarsimp simp add: o_def)
-         apply (rule corres_guard_imp)
+         apply (simp add: valid_cap_def word_bits_def)
+        apply simp
+       \<comment> \<open>ThreadCap\<close>
+       apply (simp add: isCap_defs Let_def CanModify_def
+                   split del: if_split cong: if_cong)
+       apply (clarsimp simp add: o_def)
+       apply (rule corres_guard_imp)
          apply (rule decodeTCBInvocation_corres, rule refl,
-                  simp_all add: valid_cap_def valid_cap'_def)[3]
-         apply (simp add: split_def)
-         apply (rule list_all2_conj)
-          apply (simp add: list_all2_map2 list_all2_map1)
-         apply assumption
-        \<comment> \<open>DomainCap\<close>
-        apply (clarsimp simp: isCap_defs)
-        apply (rule corres_guard_imp)
+                simp_all add: valid_cap_def valid_cap'_def)[3]
+       apply (simp add: split_def)
+       apply (rule list_all2_conj)
+        apply (simp add: list_all2_map2 list_all2_map1)
+       apply assumption
+      \<comment> \<open>DomainCap\<close>
+      apply (simp add: isCap_defs)
+      apply (rule corres_guard_imp)
       apply (rule decodeDomainInvocation_corres)
-           apply (simp+)[4]
-       \<comment> \<open>SchedContextCap\<close>
-       apply (clarsimp simp: isCap_defs o_def)
-       apply (rule corres_guard_imp, erule decode_sc_inv_corres; clarsimp simp: valid_cap_def)
-      \<comment> \<open>SchedControlCap\<close>
-      apply (clarsimp simp: isCap_defs o_def)
-      apply (rule corres_guard_imp, rule decode_sc_ctrl_inv_corres; clarsimp)
+      apply (simp+)[4]
      \<comment> \<open>IRQControl\<close>
      apply (simp add: isCap_defs o_def)
      apply (rule corres_guard_imp, rule decodeIRQControlInvocation_corres, simp+)[1]
@@ -244,6 +232,8 @@ lemma decodeInvocation_corres:
       apply (simp_all add: list_all2_map2 list_all2_map1)+
   done
 
+declare mapME_Nil [simp]
+
 lemma hinv_corres_assist:
   "\<lbrakk> info' = message_info_map info \<rbrakk>
        \<Longrightarrow> corres (fr \<oplus> (\<lambda>(p, cap, extracaps, buffer) (p', capa, extracapsa, buffera).
@@ -295,8 +285,7 @@ lemma threadSet_tcbDomain_update_ct_not_inQ:
   apply (simp add: threadSet_def ct_not_inQ_def)
   apply (wp)
     apply (rule hoare_convert_imp [OF setObject_nosch])
-     apply simp
-     apply (rule updateObject_default_inv)
+     apply (rule updateObject_tcb_inv)
     apply (wps setObject_ct_inv)
     apply (wp setObject_tcb_strongest getObject_tcb_wp)+
   apply (case_tac "t = ksCurThread s")
@@ -338,7 +327,7 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]:
   apply (wp hoare_vcg_conj_lift)
     apply (simp add: threadSet_def)
     apply wp
-     apply (wps set_tcb'.ksSchedulerAction)
+     apply (wps setObject_sa_unchanged)
      apply (wp hoare_weak_lift_imp getObject_tcb_wp hoare_vcg_all_lift)+
    apply (rename_tac word)
    apply (rule_tac Q'="\<lambda>_ s. ksSchedulerAction s = SwitchToThread word \<longrightarrow>
@@ -352,186 +341,217 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]:
 
 lemma setDomain_corres:
   "corres dc
-     (valid_tcbs and pspace_aligned and pspace_distinct and weak_valid_sched_action
-      and active_scs_valid and tcb_at tptr)
-     (invs' and (\<lambda>_. new_dom \<le> maxDomain))
-     (set_domain tptr new_dom)
-     (setDomain tptr new_dom)"
+     (valid_etcbs and 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)
   apply (simp add: set_domain_def setDomain_def thread_set_domain_def)
-  apply (rule stronger_corres_guard_imp)
+  apply (rule corres_guard_imp)
     apply (rule corres_split[OF getCurThread_corres])
-      apply (rule corres_split[OF tcbSchedDequeue_corres])
-        apply (rule corres_split[OF threadset_corresT])
-             apply (clarsimp simp: tcb_relation_def)
-            apply (clarsimp simp: tcb_cap_cases_def)
-           apply (clarsimp simp: tcb_cte_cases_def)
-          apply (rule corres_split[OF isSchedulable_corres])
-            apply (rule corres_split[OF corres_when[OF _ tcbSchedEnqueue_corres]], simp)
-              apply (rule corres_when[OF _ rescheduleRequired_corres], simp)
-             apply (wpsimp wp: hoare_drop_imp hoare_vcg_if_lift2 thread_set_valid_tcbs
-                               thread_set_weak_valid_sched_action threadSet_valid_tcbs'
-                               threadSet_vrq_inv threadSet_vrq'_inv threadSet_valid_queues_no_state
-                               threadSet_valid_queues'_no_state)+
-      apply (clarsimp cong: conj_cong)
-      apply (rule hoare_vcg_conj_lift, strengthen valid_tcb'_tcbDomain_update, wpsimp)
-      apply (wpsimp wp: tcbSchedDequeue_valid_queues tcbSchedDequeue_nonq hoare_vcg_all_lift)
-     apply wpsimp+
-  apply (frule cross_relF[OF _ tcb_at'_cross_rel], fastforce)
-  apply (frule invs'_valid_tcbs', clarsimp)
-  apply (frule obj_at_ko_at', clarsimp)
-  apply (frule tcb_ko_at_valid_objs_valid_tcb', fastforce)
-  apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def valid_tcb'_def invs'_def)
+      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 corres_split[OF isRunnable_corres])
+            apply simp
+            apply (rule corres_split)
+               apply clarsimp
+               apply (rule corres_when[OF refl])
+               apply (rule tcbSchedEnqueue_corres, simp)
+              apply (rule corres_when[OF refl])
+              apply (rule rescheduleRequired_corres)
+             apply (wpsimp wp: hoare_drop_imps)
+            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 (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"
+                     in hoare_strengthen_post[rotated])
+         apply (fastforce simp: invs'_def valid_state'_def sch_act_wf_weak st_tcb_at'_def o_def)
+        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> weak_valid_sched_action s"
+                    in hoare_post_imp)
+        apply (fastforce simp: pred_tcb_at_def obj_at_def)
+       apply (wpsimp wp: tcb_dequeue_not_queued)
+      apply (rule_tac Q'="\<lambda>_ s. invs' s \<and> obj_at' (Not \<circ> tcbQueued) tptr s \<and> sch_act_simple s
+                                 \<and>  tcb_at' tptr s"
+                   in hoare_strengthen_post[rotated])
+       apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def sch_act_simple_def)
+       apply (clarsimp simp: valid_tcb'_def obj_at'_def)
+       apply (drule (1) bspec)
+       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
+               simp: valid_sched_def valid_sched_action_def)
   done
 
 lemma performInvocation_corres:
   "\<lbrakk> inv_relation i i'; call \<longrightarrow> block \<rbrakk> \<Longrightarrow>
    corres (dc \<oplus> (=))
-     (einvs and valid_machine_time and valid_invocation i
+     (einvs and valid_invocation i
             and schact_is_rct
-            and current_time_bounded
             and ct_active
-            and ct_released
-            and ct_not_in_release_q
-            and (\<lambda>s. (\<exists>w w2 b c. i = Invocations_A.InvokeEndpoint w w2 b c) \<longrightarrow> st_tcb_at simple (cur_thread s) s)
-            and cur_sc_active and current_time_bounded and consumed_time_bounded
-            and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-            and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s))
+            and (\<lambda>s. (\<exists>w w2 b c. i = Invocations_A.InvokeEndpoint w w2 b c) \<longrightarrow> st_tcb_at simple (cur_thread s) s))
      (invs' and sch_act_simple and valid_invocation' i' and ct_active' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
-     (perform_invocation block call can_donate i) (performInvocation block call can_donate i')"
+     (perform_invocation block call i) (performInvocation block call i')"
   apply (simp add: performInvocation_def)
-  apply add_sym_refs
   apply (case_tac i)
-
-             apply (clarsimp simp: o_def liftE_bindE)
-             apply (rule corres_stateAssertE_add_assertion)
-              apply (rule corres_guard_imp)
-                apply (rule corres_split_norE)
-                   apply (rule corres_rel_imp, rule inv_untyped_corres)
-                    apply simp
-                   apply (case_tac x, simp_all)[1]
-                  apply (rule corres_returnOkTT, simp)
-                 apply wpsimp+
-             apply (clarsimp simp: sym_refs_asrt_def)
-
-            apply (clarsimp simp: liftE_bindE)
-            apply (rule corres_guard_imp)
-              apply (rule corres_split[OF getCurThread_corres])
-                apply simp
-                apply (rule corres_split[OF sendIPC_corres])
-                   apply simp
-                  apply (rule corres_trivial)
-                  apply simp
-                 apply wp+
-             apply (clarsimp simp: invs_def valid_sched_def valid_state_def valid_pspace_def
-                                   fault_tcbs_valid_states_to_except_set schact_is_rct_sane
-                                   ct_in_state_def released_sc_tcb_at_def active_sc_tcb_at_def2)
-
-             apply (intro conjI)
-              apply (fastforce elim!: st_tcb_ex_cap)
-             apply (clarsimp simp: pred_tcb_at_def obj_at_def)
-            apply simp
+           apply (clarsimp simp: o_def liftE_bindE)
            apply (rule corres_guard_imp)
-             apply (simp add: liftE_bindE)
-             apply (rule corres_split[OF sendSignal_corres])
-               apply (rule corres_trivial)
-               apply (simp add: returnOk_def)
-              apply wpsimp+
+             apply (rule corres_split_norE)
+                apply (rule corres_rel_imp, rule inv_untyped_corres)
+                 apply simp
+                apply (case_tac x, simp_all)[1]
+               apply (rule corres_returnOkTT)
+               apply simp
+              apply wp+
+            apply simp+
           apply (rule corres_guard_imp)
-            apply (rule corres_split_eqr[OF getCurThread_corres])
-              apply (rule corres_split_nor[OF doReplyTransfer_corres])
-                apply (rule corres_trivial, simp)
+            apply (rule corres_split[OF getCurThread_corres])
+              apply simp
+              apply (rule corres_split[OF sendIPC_corres])
+                 apply simp
+                apply (rule corres_trivial)
+                apply simp
                apply wp+
-           apply (clarsimp simp: tcb_at_invs)
-          apply simp
-         apply (clarsimp simp: liftME_def)
+           apply (clarsimp simp: ct_in_state_def)
+           apply (fastforce elim: st_tcb_ex_cap)
+          apply (clarsimp simp: pred_conj_def invs'_def cur_tcb'_def simple_sane_strg
+                                sch_act_simple_def)
          apply (rule corres_guard_imp)
-           apply (erule invokeTCB_corres)
-          apply (fastforce simp: current_time_bounded_def)+
-        \<comment> \<open>domain cap\<close>
-        apply (clarsimp simp: invoke_domain_def)
+           apply (simp add: liftE_bindE)
+           apply (rule corres_split[OF sendSignal_corres])
+             apply (rule corres_trivial)
+             apply (simp add: returnOk_def)
+            apply wp+
+          apply (simp+)[2]
+        apply simp
         apply (rule corres_guard_imp)
-          apply (rule corres_split[OF setDomain_corres])
-            apply (rule corres_trivial, simp)
-           apply (wp)+
-         apply ((clarsimp | fastforce)+)[3]
-       \<comment> \<open>SchedContext\<close>
+          apply (rule corres_split_eqr[OF getCurThread_corres])
+            apply (rule corres_split_nor[OF doReplyTransfer_corres'])
+              apply (rule corres_trivial, simp)
+             apply wp+
+         apply (clarsimp simp: tcb_at_invs)
+         apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
+         apply (erule cte_wp_at_weakenE, fastforce simp: is_reply_cap_to_def)
+        apply (clarsimp simp: tcb_at_invs')
+        apply (fastforce elim!: cte_wp_at_weakenE')
+       apply (clarsimp simp: liftME_def)
        apply (rule corres_guard_imp)
-         apply (rule corres_splitEE)
-            apply (simp)
-            apply (erule invokeSchedContext_corres)
-           apply (rule corres_trivial, simp add: returnOk_def)
-          apply (wpsimp+)[4]
-      \<comment> \<open>SchedControl\<close>
-      apply clarsimp
+         apply (erule invokeTCB_corres)
+        apply ((clarsimp dest!: schact_is_rct_simple)+)[2]
+       \<comment> \<open>domain cap\<close>
+      apply (clarsimp simp: invoke_domain_def)
       apply (rule corres_guard_imp)
-        apply (rule corres_splitEE)
-           apply (simp)
-           apply (erule invokeSchedControlConfigureFlags_corres)
-          apply (rule corres_trivial, simp add: returnOk_def)
-         apply (wpsimp+)[4]
+        apply (rule corres_split[OF setDomain_corres])
+          apply (rule corres_trivial, simp)
+         apply (wp)+
+       apply (fastforce+)[2]
      \<comment> \<open>CNodes\<close>
      apply clarsimp
-     apply (rule corres_stateAssertE_add_assertion)
-      apply (rule corres_guard_imp)
-        apply (rule corres_splitEE[OF invokeCNode_corres])
-           apply assumption
-          apply (rule corres_trivial, simp add: returnOk_def)
-         apply wp+
-       apply (clarsimp+)[2]
-     apply (clarsimp simp: sym_refs_asrt_def)
+     apply (rule corres_guard_imp)
+       apply (rule corres_splitEE[OF invokeCNode_corres])
+          apply assumption
+         apply (rule corres_trivial, simp add: returnOk_def)
+        apply wp+
+      apply ((clarsimp dest!: schact_is_rct_simple)+)[2]
     apply (clarsimp simp: liftME_def[symmetric] o_def dc_def[symmetric])
-    apply (rule corres_guard_imp, rule performIRQControl_corres; fastforce)
+    apply (rule corres_guard_imp, rule performIRQControl_corres, simp+)
    apply (clarsimp simp: liftME_def[symmetric] o_def dc_def[symmetric])
-   apply (rule corres_guard_imp, rule invokeIRQHandler_corres; fastforce)
+   apply (rule corres_guard_imp, rule invokeIRQHandler_corres, simp+)
   apply clarsimp
   apply (rule corres_guard_imp)
     apply (rule arch_performInvocation_corres, assumption)
    apply (clarsimp+)[2]
   done
 
-crunch sendSignal, setDomain
-  for tcb_at'[wp]: "tcb_at' t"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T t s)"
-  (simp: crunch_simps wp: crunch_wps)
+lemma sendSignal_tcb_at'[wp]:
+  "\<lbrace>tcb_at' t\<rbrace>
+     sendSignal ntfnptr bdg
+   \<lbrace>\<lambda>rv. tcb_at' t\<rbrace>"
+  apply (simp add: sendSignal_def
+              cong: list.case_cong Structures_H.notification.case_cong)
+  apply (wp ntfn'_cases_weak_wp list_cases_weak_wp hoare_drop_imps | wpc | simp)+
+  done
 
-crunch restart, bindNotification, performTransfer, invokeTCB, doReplyTransfer,
-         performIRQControl, InterruptDecls_H.invokeIRQHandler, sendIPC,
-         invokeSchedContext, invokeSchedControlConfigureFlags, handleFault
+lemmas checkCap_inv_typ_at'
+  = checkCap_inv[where P="\<lambda>s. P (typ_at' T p s)" for P T p]
+
+crunch restart, bindNotification, performTransfer
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (simp: crunch_simps
-   wp: crunch_wps checkCap_inv hoare_vcg_all_lift
-   ignore: checkCapAt)
 
-end
+lemma invokeTCB_typ_at'[wp]:
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace>
+     invokeTCB tinv
+   \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
+  apply (cases tinv,
+         simp_all add: invokeTCB_def
+                       getThreadBufferSlot_def locateSlot_conv
+            split del: if_split)
+   apply (simp only: cases_simp if_cancel simp_thms conj_comms pred_conj_def
+                     Let_def split_def getThreadVSpaceRoot
+          | (simp split del: if_split cong: if_cong)
+          | (wp mapM_x_wp[where S=UNIV, simplified]
+                checkCap_inv_typ_at'
+                case_options_weak_wp)[1]
+          | wpcw)+
+  done
+
+lemmas invokeTCB_typ_ats[wp] = typ_at_lifts [OF invokeTCB_typ_at']
 
-global_interpretation invokeTCB: typ_at_all_props' "invokeTCB i"
-  by typ_at_props'
-global_interpretation doReplyTransfer: typ_at_all_props' "doReplyTransfer s r g"
-  by typ_at_props'
-global_interpretation performIRQControl: typ_at_all_props' "performIRQControl i"
-  by typ_at_props'
-sublocale Arch < arch_invokeIRQHandler: typ_at_all_props' "invokeIRQHandler i"
-  by typ_at_props'
-global_interpretation invokeIRQHandler: typ_at_all_props' "InterruptDecls_H.invokeIRQHandler i"
-  by typ_at_props'
-global_interpretation sendIPC: typ_at_all_props' "sendIPC bl call bdg cg cgr cd t' ep"
-  by typ_at_props'
-global_interpretation invokeSchedContext: typ_at_all_props' "invokeSchedContext i"
-  by typ_at_props'
-global_interpretation invokeSchedControlConfigureFlags: typ_at_all_props' "invokeSchedControlConfigureFlags i"
-  by typ_at_props'
-global_interpretation handleFault: typ_at_all_props' "handleFault t ex"
-  by typ_at_props'
+crunch doReplyTransfer
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: hoare_drop_imps)
+
+lemmas doReplyTransfer_typ_ats[wp] = typ_at_lifts [OF doReplyTransfer_typ_at']
+
+crunch "performIRQControl"
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+
+lemmas invokeIRQControl_typ_ats[wp] =
+  typ_at_lifts [OF performIRQControl_typ_at']
+
+crunch InterruptDecls_H.invokeIRQHandler
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+
+lemmas invokeIRQHandler_typ_ats[wp] =
+  typ_at_lifts [OF invokeIRQHandler_typ_at']
+
+crunch setDomain
+  for tcb_at'[wp]: "tcb_at' tptr"
+  (simp: crunch_simps)
 
 lemma pinv_tcb'[wp]:
   "\<lbrace>invs' and st_tcb_at' active' tptr
           and valid_invocation' i and ct_active'\<rbrace>
-     RetypeDecls_H.performInvocation block call can_donate i
+     RetypeDecls_H.performInvocation block call i
    \<lbrace>\<lambda>rv. tcb_at' tptr\<rbrace>"
-  unfolding performInvocation_def
-  by (cases i; simp; wpsimp wp: invokeArch_tcb_at' stateAssertE_inv simp: pred_tcb_at')
+  apply (simp add: performInvocation_def)
+  apply (case_tac i, simp_all)
+          apply (wp invokeArch_tcb_at' | clarsimp simp: pred_tcb_at')+
+  done
+
+lemma sts_cte_at[wp]:
+  "\<lbrace>cte_at' p\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. cte_at' p\<rbrace>"
+  apply (simp add: setThreadState_def)
+  apply (wp|simp)+
+  done
+
+crunch setThreadState
+  for obj_at_ntfn[wp]: "obj_at' (\<lambda>ntfn. P (ntfnBoundTCB ntfn) (ntfnObj ntfn)) ntfnptr"
+  (wp: obj_at_setObject2 crunch_wps
+   simp: crunch_simps updateObject_default_def in_monad)
 
 lemma sts_mcpriority_tcb_at'[wp]:
   "\<lbrace>mcpriority_tcb_at' P t\<rbrace>
@@ -545,53 +565,49 @@ lemma sts_mcpriority_tcb_at'[wp]:
                | simp add: pred_tcb_at'_def)+
   done
 
-crunch setThreadState
-  for valid_ipc_buffer_ptr'[wp]: "valid_ipc_buffer_ptr' buf"
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 lemma sts_valid_inv'[wp]:
-  "setThreadState st t \<lbrace>valid_invocation' i\<rbrace>"
-  apply (case_tac i; simp)
-             apply (wpsimp wp: sts_valid_untyped_inv')
-            apply (wpsimp+)[4]
-        \<comment>\<open>start InvokeTCB\<close>
-        apply (rename_tac tcbinvocation)
-        apply (case_tac tcbinvocation; simp)
-              apply (wpsimp wp: hoare_case_option_wp2 hoare_case_option_wp sts_mcpriority_tcb_at'
-                     | clarsimp split: option.splits)+
-        \<comment>\<open>end InvokeTCB\<close>
-       \<comment>\<open>start InvokeSchedContext\<close>
-       apply (rename_tac schedcontextinvocation)
-       apply (case_tac schedcontextinvocation; simp)
-           apply (wpsimp wp: hoare_case_option_wp)
-          apply (rename_tac bindCap, case_tac bindCap; wpsimp)
-         apply (rename_tac bindCap, case_tac bindCap; wpsimp)
-        apply wpsimp
-       apply ((wpsimp wp: hoare_case_option_wp| wps)+)[1]
-       \<comment>\<open>end InvokeSchedContext\<close>
-      apply (rename_tac schedcontrolinvocation)
-      apply (case_tac schedcontrolinvocation; wpsimp wp: hoare_vcg_ex_lift)
+  "\<lbrace>valid_invocation' i\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_invocation' i\<rbrace>"
+  apply (case_tac i, simp_all add: sts_valid_untyped_inv' sts_valid_arch_inv')
+         apply (wp | simp)+
+     defer
      apply (rename_tac cnode_invocation)
-     apply (case_tac cnode_invocation; wpsimp simp: cte_wp_at_ctes_of)
+     apply (case_tac cnode_invocation, simp_all add: cte_wp_at_ctes_of)
+           apply (wp | simp)+
     apply (rename_tac irqcontrol_invocation)
-    apply (case_tac irqcontrol_invocation; simp)
+    apply (case_tac irqcontrol_invocation, simp_all)
      apply (rename_tac arch_irqhandler_issue)
-     apply (case_tac arch_irqhandler_issue; wpsimp simp: irq_issued'_def)
-    apply (wpsimp simp: irq_issued'_def)
+     apply (case_tac arch_irqhandler_issue)
+     apply (wp | simp add: irq_issued'_def)+
    apply (rename_tac irqhandler_invocation)
-   apply (case_tac irqhandler_invocation; wpsimp wp: hoare_vcg_ex_lift simp: comp_def)
-  apply (wpsimp wp: sts_valid_arch_inv')
+   apply (case_tac irqhandler_invocation, simp_all)
+     apply (wp hoare_vcg_ex_lift ex_cte_cap_to'_pres | simp)+
+  apply (rename_tac tcbinvocation)
+  apply (case_tac tcbinvocation,
+      simp_all add: setThreadState_tcb',
+      auto  intro!: hoare_vcg_conj_lift hoare_vcg_disj_lift
+      simp only: imp_conv_disj simp_thms pred_conj_def,
+      auto  intro!: hoare_vcg_prop
+      sts_cap_to' sts_cte_cap_to'
+      setThreadState_typ_ats
+      split: option.splits)[1]
+    apply (wp sts_bound_tcb_at' hoare_vcg_all_lift hoare_vcg_const_imp_lift)+
   done
 
-crunch decodeDomainInvocation, decodeSchedContextInvocation, decodeSchedControlInvocation
+(* FIXME: move to TCB *)
+crunch decodeDomainInvocation
   for inv[wp]: P
   (wp: crunch_wps simp: crunch_simps)
 
 lemma decode_inv_inv'[wp]:
-  "\<lbrace>P\<rbrace> decodeInvocation label args cap_index slot cap excaps first_phase buffer \<lbrace>\<lambda>rv. P\<rbrace>"
-  unfolding decodeInvocation_def Let_def
-  by (wpsimp split: capability.split_asm simp: isCap_defs)
+  "\<lbrace>P\<rbrace> decodeInvocation label args cap_index slot cap excaps \<lbrace>\<lambda>rv. P\<rbrace>"
+  apply (simp add: decodeInvocation_def Let_def
+              split del: if_split
+              cong: if_cong)
+  apply (rule hoare_pre)
+   apply (wp decodeTCBInvocation_inv |
+          simp only: o_def |
+          clarsimp split: capability.split_asm simp: isCap_defs)+
+  done
 
 (* FIXME: move to TCB *)
 lemma dec_dom_inv_wf[wp]:
@@ -615,7 +631,6 @@ lemma decode_inv_wf'[wp]:
   "\<lbrace>valid_cap' cap and invs' and sch_act_simple
           and cte_wp_at' ((=) cap \<circ> cteCap) slot and real_cte_at' slot
           and (\<lambda>s. \<forall>r\<in>zobj_refs' cap. ex_nonz_cap_to' r s)
-          and case_option \<top> valid_ipc_buffer_ptr' buffer
           and (\<lambda>s. \<forall>r\<in>cte_refs' cap (irq_node' s). ex_cte_cap_to' r s)
           and (\<lambda>s. \<forall>cap \<in> set excaps. \<forall>r\<in>cte_refs' (fst cap) (irq_node' s). ex_cte_cap_to' r s)
           and (\<lambda>s. \<forall>cap \<in> set excaps. \<forall>r\<in>zobj_refs' (fst cap). ex_nonz_cap_to' r s)
@@ -625,18 +640,16 @@ lemma decode_inv_wf'[wp]:
           and (\<lambda>s. \<forall>x \<in> set excaps. ex_cte_cap_wp_to' isCNodeCap (snd x) s)
           and (\<lambda>s. \<forall>x \<in> set excaps. cte_wp_at' (badge_derived' (fst x) \<circ> cteCap) (snd x) s)
           and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))\<rbrace>
-     decodeInvocation label args cap_index slot cap excaps first_phase buffer
+     decodeInvocation label args cap_index slot cap excaps
    \<lbrace>valid_invocation'\<rbrace>,-"
   apply (case_tac cap,
          simp_all add: decodeInvocation_def Let_def isCap_defs uncurry_def split_def
             split del: if_split
                  cong: if_cong)
              apply ((rule hoare_pre,
-                     ((wpsimp wp: decodeTCBInv_wf decodeSchedControlInvocation_wf
-                                  decodeSchedContextInvocation_wf
-                              simp: o_def)+)[1],
+                     ((wpsimp wp: decodeTCBInv_wf simp: o_def)+)[1],
                      clarsimp simp: valid_cap'_def cte_wp_at_ctes_of)
-                    | intro exI conjI | simp | drule sym)+
+                    | intro exI conjI | simp)+
   done
 
 lemma ct_active_imp_simple'[elim!]:
@@ -657,8 +670,16 @@ lemma active_ex_cap'[elim]:
 crunch handleFaultReply
   for it[wp]: "\<lambda>s. P (ksIdleThread s)"
 
+lemma handleFaultReply_invs[wp]:
+  "\<lbrace>invs' and tcb_at' t\<rbrace> handleFaultReply x t label msg \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: handleFaultReply_def)
+  apply (case_tac x, simp_all)
+     apply (wp | clarsimp simp: handleArchFaultReply_def
+                          split: arch_fault.split)+
+  done
+
 crunch handleFaultReply
- for sch_act_simple[wp]: sch_act_simple
+  for sch_act_simple[wp]: sch_act_simple
   (wp: crunch_wps)
 
 lemma transferCaps_non_null_cte_wp_at':
@@ -680,6 +701,9 @@ proof -
     done
 qed
 
+crunch setMessageInfo
+  for cte_wp_at'[wp]: "cte_wp_at' P p"
+
 lemma copyMRs_cte_wp_at'[wp]:
   "\<lbrace>cte_wp_at' P ptr\<rbrace> copyMRs sender sendBuf receiver recvBuf n \<lbrace>\<lambda>_. cte_wp_at' P ptr\<rbrace>"
   unfolding copyMRs_def
@@ -696,9 +720,17 @@ lemma doNormalTransfer_non_null_cte_wp_at':
   apply (wp transferCaps_non_null_cte_wp_at' | simp add:PUC)+
   done
 
-crunch doFaultTransfer, setMRs
-  for cte_wp_at'[wp]: "cte_wp_at' P ptr"
-  (wp: crunch_wps simp: zipWithM_x_mapM)
+lemma setMRs_cte_wp_at'[wp]:
+  "\<lbrace>cte_wp_at' P ptr\<rbrace> setMRs thread buffer messageData \<lbrace>\<lambda>_. cte_wp_at' P ptr\<rbrace>"
+  by (simp add: setMRs_def zipWithM_x_mapM split_def, wp crunch_wps)
+
+lemma doFaultTransfer_cte_wp_at'[wp]:
+  "\<lbrace>cte_wp_at' P ptr\<rbrace>
+   doFaultTransfer badge sender receiver receiverIPCBuffer
+   \<lbrace>\<lambda>_. cte_wp_at' P ptr\<rbrace>"
+  unfolding doFaultTransfer_def
+  apply (wp | wpc | simp add: split_def)+
+  done
 
 lemma doIPCTransfer_non_null_cte_wp_at':
   assumes PUC: "\<And>cap. P cap \<Longrightarrow> \<not> isUntypedCap cap"
@@ -738,77 +770,80 @@ lemma st_tcb_at'_eqD:
 
 lemma isReply_awaiting_reply':
   "isReply st = awaiting_reply' st"
-  by (case_tac st, (clarsimp simp add: isReply_def isBlockedOnReply_def)+)
+  by (case_tac st, (clarsimp simp add: isReply_def)+)
 
-lemma handleTimeout_invs':
-  "\<lbrace>invs' and st_tcb_at' active' tptr and sch_act_not tptr and ex_nonz_cap_to' tptr\<rbrace>
-   handleTimeout tptr timeout
+lemma doReply_invs[wp]:
+  "\<lbrace>tcb_at' t and tcb_at' t' and
+    cte_wp_at' (\<lambda>cte. \<exists>grant. cteCap cte = ReplyCap t False grant) slot and
+    invs' and sch_act_simple\<rbrace>
+   doReplyTransfer t' t slot grant
    \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: handleTimeout_def)
-  apply wpsimp
-      apply (rename_tac tcb)
-      apply (rule_tac Q'="\<lambda>_. invs'"
-                  and E'="\<lambda>_. invs' and valid_idle' and st_tcb_at' active' tptr and sch_act_not tptr
-                             and (\<lambda>s. False \<longrightarrow> bound_sc_tcb_at' (\<lambda>a. a \<noteq> None) tptr s)
-                             and ex_nonz_cap_to' tptr
-                             and (\<lambda>s. \<exists>n\<in>dom tcb_cte_cases. cte_wp_at' (\<lambda>cte. cteCap cte
-                                                                               = cteCap (tcbTimeoutHandler tcb))
-                                                                        (tptr + n) s)"
-                   in hoare_strengthen_postE)
-        apply (rule sfi_invs_plus')
-       apply (wpsimp wp: getTCB_wp
-                   simp: isValidTimeoutHandler_def)+
-  apply (clarsimp simp: cte_wp_at'_obj_at' tcb_cte_cases_def  projectKOs obj_at'_def valid_idle'_asrt_def)
-  done
-
-crunch isValidTimeoutHandler
-  for inv[wp]: P
-
-crunch ifCondRefillUnblockCheck
-  for sch_act_simple[wp]: sch_act_simple
-  (simp: crunch_simps sch_act_simple_def)
-
-lemma doReplyTransfer_invs'[wp]:
-  "\<lbrace>invs' and tcb_at' sender and reply_at' replyPtr and sch_act_simple\<rbrace>
-   doReplyTransfer sender replyPtr grant
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  (is "valid ?pre _ _")
   apply (simp add: doReplyTransfer_def liftM_def)
-  apply (rule bind_wp[OF _ get_reply_sp'], rename_tac reply)
-  apply (case_tac "replyTCB reply"; clarsimp)
-   apply wpsimp
-  apply (rename_tac receiver)
-  apply (rule bind_wp[OF _ gts_sp'])
-  apply (rule hoare_if)
-   apply wpsimp
-  apply (rule_tac Q'="\<lambda>_. ?pre and st_tcb_at' ((=) Inactive) receiver and ex_nonz_cap_to' receiver"
-               in bind_wp_fwd)
-   apply (wpsimp wp: replyRemove_invs')
-   apply (clarsimp simp: pred_tcb_at'_def)
-   apply (fastforce intro: if_live_then_nonz_capE'
-                     simp: ko_wp_at'_def obj_at'_def projectKOs isReply_def)
-  apply simp
-  apply (rule bind_wp[OF _ threadGet_sp])
-  apply (rule_tac Q'="\<lambda>_. ?pre and st_tcb_at' ((=) Inactive) receiver and tcb_at' receiver and ex_nonz_cap_to' receiver"
-         in bind_wp_fwd, wpsimp)
-  apply (rule bind_wp[OF _ threadGet_sp], rename_tac fault)
-  apply (rule_tac Q'="\<lambda>_. ?pre and tcb_at' receiver and ex_nonz_cap_to' receiver"
-         in bind_wp)
-   apply (wpsimp wp: possibleSwitchTo_invs' handleTimeout_invs' threadGet_wp hoare_drop_imps refillReady_wp)
-   apply (fastforce simp: runnable_eq_active' obj_at'_def)
-  apply (case_tac fault; clarsimp)
-   apply (wpsimp wp: doIPCTransfer_invs setThreadState_Running_invs')
-   apply (fastforce simp: pred_tcb_at'_def obj_at'_def)
-  apply (rule_tac P'="?pre and st_tcb_at' ((=) Inactive) receiver and ex_nonz_cap_to' receiver"
-               in hoare_weaken_pre[rotated])
-  using global'_no_ex_cap apply fastforce
-  apply (rule bind_wp_fwd_skip, solves \<open>wpsimp wp: threadSet_fault_invs' threadSet_st_tcb_at2\<close>)+
-  apply clarsimp
-  apply (intro conjI impI)
-   apply (wpsimp wp: setThreadState_Restart_invs')
-   apply (fastforce simp: pred_tcb_at'_def obj_at'_def)
-  apply (wpsimp wp: sts_invs_minor')
-  apply (fastforce simp: pred_tcb_at'_def obj_at'_def)
+  apply (rule bind_wp [OF _ gts_sp'])
+  apply (rule bind_wp [OF _ assert_sp])
+  apply (rule bind_wp [OF _ getCTE_sp])
+  apply (wp, wpc)
+        apply wp
+          apply (wp (once) sts_invs_minor'')
+          apply simp
+          apply (wp (once) sts_st_tcb')
+          apply wp
+         apply (rule_tac Q'="\<lambda>_ s. invs' s \<and> t \<noteq> ksIdleThread s \<and> st_tcb_at' awaiting_reply' t s"
+                 in hoare_post_imp)
+          apply clarsimp
+          apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+          apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def)
+          apply (drule(1) pred_tcb_at_conj')
+          apply (subgoal_tac "st_tcb_at' (\<lambda>_. False) (ksCurThread s) s")
+           apply clarsimp
+          apply (erule_tac P="\<lambda>st. awaiting_reply' st \<and> activatable' st"
+                  in pred_tcb'_weakenE)
+          apply (case_tac st, clarsimp+)
+         apply (wp cteDeleteOne_reply_pred_tcb_at)+
+        apply clarsimp
+        apply (rule_tac Q'="\<lambda>_. (\<lambda>s. t \<noteq> ksIdleThread s)
+                               and cte_wp_at' (\<lambda>cte. \<exists>grant. cteCap cte
+                                                             = capability.ReplyCap t False grant) slot"
+                     in hoare_strengthen_post [rotated])
+         apply (fastforce simp: cte_wp_at'_def)
+        apply wp
+        apply (rule hoare_strengthen_post [OF doIPCTransfer_non_null_cte_wp_at'])
+         apply (erule conjE)
+         apply assumption
+        apply (erule cte_wp_at_weakenE')
+        apply (fastforce)
+       apply (wp sts_invs_minor'' sts_st_tcb' hoare_weak_lift_imp)
+             apply (rule_tac Q'="\<lambda>_ s. invs' s \<and> sch_act_simple s
+                                      \<and> st_tcb_at' awaiting_reply' t s
+                                      \<and> t \<noteq> ksIdleThread s"
+                          in hoare_post_imp)
+              apply clarsimp
+              apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+)
+              apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def)
+              apply (drule(1) pred_tcb_at_conj')
+              apply (subgoal_tac "st_tcb_at' (\<lambda>_. False) (ksCurThread s) s")
+               apply clarsimp
+              apply (erule_tac P="\<lambda>st. awaiting_reply' st \<and> activatable' st"
+                            in pred_tcb'_weakenE)
+              apply (case_tac st, clarsimp+)
+             apply (wp threadSet_invs_trivial threadSet_st_tcb_at2 hoare_weak_lift_imp
+                    | clarsimp simp add: inQ_def)+
+           apply (rule_tac Q'="\<lambda>_. invs' and tcb_at' t
+                                 and sch_act_simple and st_tcb_at' awaiting_reply' t"
+                   in hoare_strengthen_post [rotated])
+            apply clarsimp
+            apply (rule conjI)
+             apply (clarsimp simp: invs'_def valid_state'_def valid_idle'_def obj_at'_def
+                                   idle_tcb'_def pred_tcb_at'_def)
+            apply clarsimp
+            apply (rule conjI)
+             apply (clarsimp simp: invs'_def valid_state'_def valid_idle'_def)
+             apply (erule pred_tcb'_weakenE, clarsimp)
+             apply (clarsimp simp : invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def
+                                    obj_at'_def idle_tcb'_def)
+           apply (wp cteDeleteOne_reply_pred_tcb_at hoare_drop_imp hoare_allI)+
+  apply (clarsimp simp add: isReply_awaiting_reply' cte_wp_at_ctes_of)
+  apply (auto dest!: st_tcb_idle'[rotated] simp:isCap_simps)
   done
 
 lemma ct_active_runnable' [simp]:
@@ -827,25 +862,67 @@ lemma tcbSchedEnqueue_valid_action:
   apply clarsimp
   done
 
-lemma threadSet_tcbDomain_update_invs':
-  "\<lbrace>invs' and  tcb_at' t and (\<lambda>s. (\<forall>p. t \<notin> set (ksReadyQueues s p))) and K (ds \<le> maxDomain) \<rbrace>
-   threadSet (tcbDomain_update (\<lambda>_. ds)) t
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
+abbreviation (input) "all_invs_but_sch_extra \<equiv>
+    \<lambda>s. valid_pspace' s \<and>
+    sym_refs (state_refs_of' s) \<and>
+    if_live_then_nonz_cap' s \<and>
+    sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_bitmaps s \<and>
+    if_unsafe_then_cap' s \<and>
+    valid_idle' s \<and>
+    valid_global_refs' s \<and>
+    valid_arch_state' s \<and>
+    valid_irq_node' (irq_node' s) s \<and>
+    valid_irq_handlers' s \<and>
+    valid_irq_states' s \<and>
+    irqs_masked' s \<and>
+    valid_machine_state' s \<and>
+    cur_tcb' s \<and>
+    untyped_ranges_zero' s \<and>
+    valid_pde_mappings' s \<and> pspace_domain_valid s \<and>
+    ksCurDomain s \<le> maxDomain \<and> valid_dom_schedule' s \<and>
+    (\<forall>x. ksSchedulerAction s = SwitchToThread x \<longrightarrow> st_tcb_at' runnable' x s)"
+
+
+lemma rescheduleRequired_all_invs_but_extra:
+  "\<lbrace>\<lambda>s. all_invs_but_sch_extra s\<rbrace>
+    rescheduleRequired \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def)
+  apply (wpsimp wp: rescheduleRequired_ct_not_inQ rescheduleRequired_sch_act'
+                    valid_irq_node_lift valid_irq_handlers_lift'')
+  apply auto
+  done
+
+lemma threadSet_all_invs_but_sch_extra:
+  shows      "\<lbrace> tcb_at' t and
+                all_invs_but_sch_extra and sch_act_simple and
+                K (ds \<le> maxDomain) \<rbrace>
+                threadSet (tcbDomain_update (\<lambda>_. ds)) t
+              \<lbrace>\<lambda>rv. all_invs_but_sch_extra \<rbrace>"
   apply (rule hoare_gen_asm)
   apply (rule hoare_pre)
-  apply (clarsimp simp: invs'_def)
   apply (wp threadSet_valid_pspace'T_P[where P = False and Q = \<top> and Q' = \<top>])
-  apply (simp add: tcb_cte_cases_def)+
-   apply (wp threadSet_valid_pspace'T_P
-             threadSet_state_refs_of'T_P[where f'=id and P'=False and Q=\<top> and g'=id and Q'=\<top>]
-             threadSet_idle'T threadSet_global_refsT threadSet_cur irqs_masked_lift
-             valid_irq_node_lift valid_irq_handlers_lift'' threadSet_ctes_ofT threadSet_not_inQ
-             threadSet_valid_queues'_no_state threadSet_valid_queues threadSet_valid_dom_schedule'
-             threadSet_iflive'T threadSet_ifunsafe'T untyped_ranges_zero_lift
-             threadSet_valid_release_queue threadSet_valid_release_queue'
-          | simp add: tcb_cte_cases_def cteCaps_of_def o_def invs'_def
-          | intro allI)+
-  by (fastforce simp: sch_act_simple_def o_def cteCaps_of_def valid_release_queue'_def obj_at'_def)
+  apply (simp add:tcb_cte_cases_def cteSizeBits_def)+
+   apply (wp
+     threadSet_valid_pspace'T_P
+     threadSet_state_refs_of'T_P[where f'=id and P'=False and Q=\<top> and g'=id and Q'=\<top>]
+     threadSet_idle'T
+     threadSet_global_refsT
+     threadSet_cur
+     irqs_masked_lift
+     valid_irq_node_lift
+     valid_irq_handlers_lift''
+     threadSet_ctes_ofT
+     threadSet_not_inQ
+     threadSet_valid_dom_schedule'
+     threadSet_iflive'T
+     threadSet_ifunsafe'T
+     untyped_ranges_zero_lift threadSet_sched_pointers threadSet_valid_sched_pointers
+     | simp add:tcb_cte_cases_def cteSizeBits_def cteCaps_of_def o_def)+
+   apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift threadSet_pred_tcb_no_state | simp)+
+  apply (clarsimp simp:sch_act_simple_def o_def cteCaps_of_def)
+  apply (intro conjI)
+   apply fastforce+
+  done
 
 lemma threadSet_not_curthread_ct_domain:
   "\<lbrace>\<lambda>s. ptr \<noteq> ksCurThread s \<and> ct_idle_or_in_cur_domain' s\<rbrace> threadSet f ptr \<lbrace>\<lambda>rv. ct_idle_or_in_cur_domain'\<rbrace>"
@@ -854,209 +931,46 @@ lemma threadSet_not_curthread_ct_domain:
   apply clarsimp
   done
 
-lemma schedContextBindNtfn_invs':
-  "\<lbrace>invs' and ex_nonz_cap_to' scPtr and ex_nonz_cap_to' ntfnPtr\<rbrace>
-   schedContextBindNtfn scPtr ntfnPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: schedContextBindNtfn_def)
-  apply (wpsimp wp: setSchedContext_invs' setNotification_invs' hoare_vcg_imp_lift'
-                    hoare_vcg_all_lift getNotification_wp)
-  apply (rule conjI)
-   apply (fastforce dest: ntfn_ko_at_valid_objs_valid_ntfn'
-                    simp: valid_ntfn'_def
-                   split: ntfn.splits)
-  apply (fastforce dest: sc_ko_at_valid_objs_valid_sc'
-                   simp: valid_sched_context'_def valid_sched_context_size'_def objBits_simps)
-  done
-
-lemma contextYieldToUpdateQueues_invs'_helper:
-   "\<lbrace>\<lambda>s. invs' s \<and> sc_at' scPtr s \<and> valid_sched_context' sc s \<and> valid_sched_context_size' sc
-         \<and> ex_nonz_cap_to' scPtr s \<and> ex_nonz_cap_to' ctPtr s \<and> tcb_at' ctPtr s\<rbrace>
-    do y \<leftarrow> threadSet (tcbYieldTo_update (\<lambda>_. Some scPtr)) ctPtr;
-       setSchedContext scPtr (scYieldFrom_update (\<lambda>_. Some ctPtr) sc)
-    od
-    \<lbrace>\<lambda>_. invs'\<rbrace>"
-   apply (clarsimp simp: invs'_def valid_pspace'_def valid_dom_schedule'_def)
-   apply (wp threadSet_valid_objs' threadSet_mdb' threadSet_iflive' threadSet_cap_to
-             threadSet_ifunsafe'T   threadSet_ctes_ofT threadSet_valid_queues_new
-             threadSet_valid_queues' threadSet_valid_release_queue threadSet_valid_release_queue'
-             untyped_ranges_zero_lift valid_irq_node_lift valid_irq_handlers_lift''
-             hoare_vcg_const_imp_lift hoare_vcg_imp_lift' threadSet_valid_replies'
-          | clarsimp simp: tcb_cte_cases_def cteCaps_of_def)+
-   apply (fastforce simp: obj_at_simps valid_tcb'_def tcb_cte_cases_def comp_def
-                          valid_sched_context'_def valid_sched_context_size'_def
-                          valid_release_queue'_def inQ_def)
-   done
-
-crunch schedContextResume
-  for bound_scTCB[wp]: "obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma schedContextCancelYieldTo_bound_scTCB[wp]:
-  "schedContextCancelYieldTo tptr \<lbrace>obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr\<rbrace>"
-  apply (clarsimp simp: schedContextCancelYieldTo_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule hoare_when_cases, simp)
-  apply (wpsimp wp: set_sc'.obj_at' simp: updateSchedContext_def)
-  apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def split: if_split)
-  done
-
-lemma schedContextUpdateConsumed_bound_scTCB[wp]:
-  "schedContextUpdateConsumed tptr \<lbrace>obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr\<rbrace>"
-  apply (clarsimp simp: schedContextUpdateConsumed_def)
-  apply (wpsimp wp: set_sc'.obj_at' simp: updateSchedContext_def)
-  apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def split: if_split)
-  done
-
-crunch schedContextCompleteYieldTo
-  for bound_scTCB[wp]: "obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr"
-
-lemma contextYieldToUpdateQueues_invs':
-  "\<lbrace>invs' and (\<lambda>s. obj_at' (\<lambda>a. \<exists>y. scTCB a = Some y) scPtr s) and ct_active'
-    and ex_nonz_cap_to' scPtr and (\<lambda>s. tcb_at' (ksCurThread s) s)\<rbrace>
-   contextYieldToUpdateQueues scPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: contextYieldToUpdateQueues_def)
-  apply (rule bind_wp[OF _ get_sc_sp'], rename_tac sc)
-  apply (rule bind_wp[OF _ isSchedulable_sp])
-  apply (rule hoare_if; (solves wpsimp)?)
-  apply (rule bind_wp[OF _ getCurThread_sp], rename_tac ctPtr)
-  apply (rule bind_wp_fwd_skip, solves wpsimp)+
-  apply (rule hoare_if)
-   apply wpsimp
-   apply (erule isSchedulable_bool_runnableE)
-   apply (frule sc_ko_at_valid_objs_valid_sc')
-    apply fastforce
-   apply (clarsimp simp: valid_sched_context'_def valid_bound_obj'_def obj_at_simps opt_map_def)
-  apply (subst bind_dummy_ret_val[symmetric])
-  apply (subst bind_assoc[symmetric])
-  apply (rule_tac Q'="\<lambda>_. invs' and ct_active' and (\<lambda>s. st_tcb_at' runnable' (the (scTCB sc)) s)
-                         and (\<lambda>s. ctPtr = ksCurThread s)"
-               in bind_wp_fwd)
-   apply (clarsimp simp: pred_conj_def)
-   apply (intro hoare_vcg_conj_lift_pre_fix)
-       apply (rule hoare_weaken_pre)
-        apply (rule contextYieldToUpdateQueues_invs'_helper)
-       apply (fastforce dest: sc_ko_at_valid_objs_valid_sc'
-                        simp: valid_sched_context'_def valid_sched_context_size'_def)
-      apply (wpsimp wp: threadSet_ct_in_state' setSchedContext_ct_in_state')
-     apply (wpsimp wp: threadSet_st_tcb_at2)
-     apply (erule isSchedulable_bool_runnableE)
-     apply (frule sc_ko_at_valid_objs_valid_sc')
-      apply fastforce
-     apply (frule sc_ko_at_valid_objs_valid_sc')
-      apply fastforce
-     apply (clarsimp simp: valid_sched_context'_def scBits_simps obj_at_simps)
-    apply (wpsimp | wps)+
-  apply (clarsimp simp: ct_in_state'_def st_tcb_at'_def obj_at_simps runnable_eq_active')
-  done
-
-crunch schedContextResume
-  for st_tcb_at'[wp]: "\<lambda>s. Q (st_tcb_at' P tptr s)"
-  (wp: crunch_wps threadSet_wp mapM_wp_inv simp: crunch_simps)
-
-crunch schedContextResume
-  for scTCBs_of[wp]: "\<lambda>s. P (scTCBs_of s)"
-  (wp: crunch_wps threadSet_st_tcb_at2 mapM_wp_inv)
-
-crunch schedContextCompleteYieldTo
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' ptr"
-  (simp: crunch_simps tcb_cte_cases_def wp: crunch_wps threadSet_cap_to)
-
-lemma schedContextYiedTo_invs':
-  "\<lbrace>invs' and ct_active' and ex_nonz_cap_to' scPtr
-    and (\<lambda>s. obj_at' (\<lambda>sc. \<exists>t. scTCB sc = Some t) scPtr s)\<rbrace>
-   schedContextYieldTo scPtr buffer
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: schedContextYieldTo_def)
-  apply (wpsimp wp: contextYieldToUpdateQueues_invs' setConsumed_invs'
-              simp: ct_in_state'_def
-         | wps)+
-  done
-
-lemma invokeSchedContext_invs':
-  "\<lbrace>invs' and  ct_active' and valid_sc_inv' iv\<rbrace>
-   invokeSchedContext iv
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: invokeSchedContext_def)
-  apply (cases iv; clarsimp)
-      apply (wpsimp wp: setConsumed_invs')
-     apply (rename_tac scPtr cap)
-     apply (case_tac cap; clarsimp)
-      apply (wpsimp wp: schedContextBindTCB_invs')
-      apply (clarsimp simp: pred_tcb_at'_def obj_at_simps)
-     apply (wpsimp wp: schedContextBindNtfn_invs')
-    apply (rename_tac scPtr cap)
-    apply (case_tac cap; clarsimp)
-     apply wpsimp
-     using global'_sc_no_ex_cap apply fastforce
-    apply wpsimp
-   apply wpsimp
-   using global'_sc_no_ex_cap apply fastforce
-  apply (wpsimp wp: schedContextYiedTo_invs')
-  apply (fastforce simp: obj_at_simps)
-  done
-
 lemma setDomain_invs':
-  "\<lbrace>invs' and tcb_at' ptr and K (domain \<le> maxDomain)\<rbrace>
-   setDomain ptr domain
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  (is "\<lbrace>?P\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (simp add: setDomain_def)
-  apply (rule bind_wp[OF _ getCurThread_sp])
-  apply (rule_tac Q'="\<lambda>_ s. ?P s \<and> (\<forall>p. ptr \<notin> set (ksReadyQueues s p))" in bind_wp_fwd)
-   apply (wpsimp wp: tcbSchedDequeue_nonq hoare_vcg_all_lift)
-  apply (rule bind_wp_fwd_skip, wpsimp wp: threadSet_tcbDomain_update_invs')
-  apply (wpsimp wp: tcbSchedEnqueue_invs' isSchedulable_wp)
-  apply (clarsimp simp: isSchedulable_bool_def pred_map_simps st_tcb_at'_def obj_at_simps
-                 elim!: opt_mapE)
-  done
-
-crunch refillNew, refillUpdate, commitTime
-  for pred_tcb_at''[wp]: "\<lambda>s. Q (pred_tcb_at' proj P tcbPtr s)"
-  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  and ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' ptr"
-  (simp: crunch_simps wp: crunch_wps)
-
-lemma scSBadge_update_invs'[wp]:
-  "updateSchedContext scPtr (scBadge_update f) \<lbrace>invs'\<rbrace>"
-  apply (wpsimp wp: updateSchedContext_invs')
-  apply (fastforce elim!: live_sc'_ko_ex_nonz_cap_to' dest: invs'_ko_at_valid_sched_context'
-                    simp: live_sc'_def)
-  done
-
-lemma scSporadic_update_invs'[wp]:
-  "updateSchedContext scPtr (scSporadic_update f) \<lbrace>invs'\<rbrace>"
-  apply (wpsimp wp: updateSchedContext_invs')
-  apply (fastforce elim!: live_sc'_ko_ex_nonz_cap_to' dest: invs'_ko_at_valid_sched_context'
-                    simp: live_sc'_def)
-  done
-
-lemma invokeSchedControlConfigureFlags_invs':
-  "\<lbrace>invs' and valid_sc_ctrl_inv' iv\<rbrace>
-   invokeSchedControlConfigureFlags iv
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  (is "\<lbrace>?pre\<rbrace> _ \<lbrace>_\<rbrace>")
-  apply (clarsimp simp: invokeSchedControlConfigureFlags_def)
-  apply (cases iv; clarsimp)
-  apply (rule bind_wp[OF _ get_sc_sp'])
-  apply (rule_tac Q'="\<lambda>_. ?pre" in bind_wp_fwd)
-   apply (wpsimp wp: commitTime_invs' tcbReleaseRemove_invs' hoare_vcg_ex_lift)
-  apply (wpsimp wp: hoare_vcg_if_lift refillNew_invs' refillUpdate_invs' hoare_vcg_imp_lift')
-  by (fastforce simp: valid_refills_number'_def)
+  "\<lbrace>invs' and sch_act_simple and ct_active' and
+  (tcb_at' ptr and
+  (\<lambda>s. sch_act_not ptr s) and
+  (\<lambda>y. domain \<le> maxDomain))\<rbrace>
+  setDomain ptr domain \<lbrace>\<lambda>y. invs'\<rbrace>"
+  apply (simp add:setDomain_def )
+  apply (wp add: when_wp hoare_weak_lift_imp hoare_weak_lift_imp_conj rescheduleRequired_all_invs_but_extra
+    tcbSchedEnqueue_valid_action hoare_vcg_if_lift2)
+     apply (rule_tac Q'="\<lambda>r s. all_invs_but_sch_extra s \<and> curThread = ksCurThread s
+      \<and> (ptr \<noteq> curThread \<longrightarrow> ct_not_inQ s \<and> sch_act_wf (ksSchedulerAction s) s \<and> ct_idle_or_in_cur_domain' s)"
+      in hoare_strengthen_post[rotated])
+      apply (clarsimp simp:invs'_def valid_state'_def st_tcb_at'_def[symmetric] valid_pspace'_def)
+       apply simp
+     apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift])
+       apply (rule threadSet_all_invs_but_sch_extra)
+      prefer 2
+      apply clarsimp
+      apply assumption
+     apply (wp hoare_weak_lift_imp threadSet_pred_tcb_no_state threadSet_not_curthread_ct_domain
+               threadSet_tcbDomain_update_ct_not_inQ | simp)+
+    apply (rule_tac Q'="\<lambda>r s. invs' s \<and> curThread = ksCurThread s \<and> sch_act_simple s
+                             \<and> domain \<le> maxDomain
+                             \<and> (ptr \<noteq> curThread \<longrightarrow> ct_not_inQ s \<and> sch_act_not ptr s)"
+      in hoare_strengthen_post[rotated])
+     apply (clarsimp simp:invs'_def valid_state'_def)
+    apply (wp hoare_vcg_imp_lift)+
+  apply (clarsimp simp:invs'_def valid_pspace'_def valid_state'_def)+
+  done
 
 lemma performInv_invs'[wp]:
-  "\<lbrace>invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-          and ct_active' and valid_invocation' i
-          and (\<lambda>s. can_donate \<longrightarrow> bound_sc_tcb_at' bound (ksCurThread s) s)\<rbrace>
-   performInvocation block call can_donate i
+  "\<lbrace>invs' and sch_act_simple and ct_active' and valid_invocation' i\<rbrace>
+   RetypeDecls_H.performInvocation block call i
    \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: performInvocation_def)
+  unfolding performInvocation_def
   apply (cases i)
-  by (clarsimp simp: sym_refs_asrt_def ct_in_state'_def sch_act_simple_def
-      | wp tcbinv_invs' arch_performInvocation_invs' setDomain_invs' stateAssertE_inv
-           stateAssertE_wp invokeSchedControlConfigureFlags_invs' invokeSchedContext_invs'
-      | erule active_ex_cap'[simplified ct_in_state'_def])+
+  apply (clarsimp simp: simple_sane_strg sch_act_simple_def sch_act_sane_def
+         | wp tcbinv_invs' arch_performInvocation_invs' setDomain_invs'
+         | rule conjI | erule active_ex_cap')+
+  done
 
 lemma getSlotCap_to_refs[wp]:
   "\<lbrace>\<top>\<rbrace> getSlotCap ref \<lbrace>\<lambda>rv s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s\<rbrace>"
@@ -1196,6 +1110,10 @@ lemma st_tcb_at_idle_thread':
 crunch replyFromKernel
   for tcb_at'[wp]: "tcb_at' t"
 
+lemma invs_weak_sch_act_wf_strg:
+  "invs' s \<longrightarrow> weak_sch_act_wf (ksSchedulerAction s) s"
+  by clarsimp
+
 (* FIXME: move *)
 lemma rct_sch_act_simple[simp]:
   "ksSchedulerAction s = ResumeCurrentThread \<Longrightarrow> sch_act_simple s"
@@ -1208,42 +1126,43 @@ lemma rct_sch_act_sane[simp]:
 
 lemma lookupCapAndSlot_real_cte_at'[wp]:
   "\<lbrace>valid_objs'\<rbrace> lookupCapAndSlot thread ptr \<lbrace>\<lambda>rv. real_cte_at' (snd rv)\<rbrace>, -"
-  apply (simp add: lookupCapAndSlot_def lookupSlotForThread_def)
-  apply (wp resolveAddressBits_real_cte_at' | simp add: split_def)+
-  done
+apply (simp add: lookupCapAndSlot_def lookupSlotForThread_def)
+apply (wp resolveAddressBits_real_cte_at' | simp add: split_def)+
+done
 
 lemmas set_thread_state_active_valid_sched =
   set_thread_state_runnable_valid_sched[simplified runnable_eq_active]
 
 lemma setTCB_valid_duplicates'[wp]:
-  "setObject a (tcb::tcb) \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
+ "\<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>
+  setObject a (tcb::tcb) \<lbrace>\<lambda>rv s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   apply (clarsimp simp: setObject_def split_def valid_def in_monad
                         projectKOs pspace_aligned'_def ps_clear_upd
                         objBits_def[symmetric] lookupAround2_char1
                  split: if_split_asm)
   apply (frule pspace_storable_class.updateObject_type[where v = tcb,simplified])
-  apply (clarsimp simp: updateObject_default_def assert_def bind_def
-                        alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
-                        assert_opt_def return_def fail_def typeError_def
-                  split: if_splits option.splits Structures_H.kernel_object.splits)
+  apply (clarsimp simp:updateObject_default_def assert_def bind_def
+    alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
+    assert_opt_def return_def fail_def typeError_def
+    split:if_splits option.splits Structures_H.kernel_object.splits)
      apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+
   done
 
 crunch threadSet
- for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (wp: updateObject_default_inv)
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+  (wp: setObject_ksInterrupt updateObject_default_inv)
 
 crunch addToBitmap
- for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (wp: updateObject_default_inv)
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+  (wp: setObject_ksInterrupt updateObject_default_inv)
 
 lemma tcbSchedEnqueue_valid_duplicates'[wp]:
  "tcbSchedEnqueue tcbPtr \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
   by (wpsimp simp: tcbSchedEnqueue_def tcbQueuePrepend_def unless_def setQueue_def)
 
 crunch rescheduleRequired
- for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  (wp: setObject_ksInterrupt updateObject_default_inv crunch_wps)
+  for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
+  (wp: setObject_ksInterrupt updateObject_default_inv)
 
 crunch setThreadState
   for valid_duplicates'[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
@@ -1251,141 +1170,97 @@ crunch setThreadState
 crunch reply_from_kernel
   for pspace_aligned[wp]: pspace_aligned
   and pspace_distinct[wp]: pspace_distinct
-  and valid_objs[wp]: valid_objs
-  (simp: crunch_simps wp: crunch_wps)
 
-crunch replyFromKernel
-  for valid_objs'[wp]: valid_objs'
-  and valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-  (simp: crunch_simps wp: crunch_wps)
-
-(* Note: the preconditions on the abstract side are based on those of performInvocation_corres. *)
 lemma handleInvocation_corres:
-  "call \<longrightarrow> blocking \<Longrightarrow>
-   cptr = to_bl cptr' \<Longrightarrow>
+  "c \<longrightarrow> b \<Longrightarrow>
    corres (dc \<oplus> dc)
-          (einvs and valid_machine_time and schact_is_rct and ct_active and ct_released
-           and (\<lambda>s. active_sc_tcb_at (cur_thread s) s) and ct_not_in_release_q
-           and cur_sc_active and current_time_bounded and consumed_time_bounded
-           and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-           and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s))
-          (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
-          (handle_invocation call blocking can_donate first_phase cptr)
-          (handleInvocation call blocking can_donate first_phase cptr')"
-  apply add_cur_tcb'
-  apply add_ct_not_inQ
-  apply add_valid_idle'
-  apply (rule_tac Q="\<lambda>s'. bound_sc_tcb_at' bound (ksCurThread s') s'" in corres_cross_add_guard)
-   apply (fastforce intro: ct_released_cross_weak)
+          (einvs and schact_is_rct and ct_active)
+          (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
+           (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and ct_active')
+          (handle_invocation c b)
+          (handleInvocation c b)"
   apply (simp add: handle_invocation_def handleInvocation_def liftE_bindE)
-  apply (rule corres_stateAssertE_add_assertion[rotated])
-   apply (clarsimp simp: ct_not_inQ_asrt_def)
-  apply (rule corres_stateAssertE_add_assertion[rotated])
-   apply (clarsimp simp: valid_idle'_asrt_def)
-  apply (rule stronger_corres_guard_imp)
+  apply (rule corres_guard_imp)
     apply (rule corres_split_eqr[OF getCurThread_corres])
-      apply (rule corres_split [OF getMessageInfo_corres])
-        apply (rule syscall_corres)
-                apply (rule hinv_corres_assist, simp)
-               apply (rule corres_when[OF _ handleFault_corres]; simp)
-              apply (simp only: split_def)
-              apply (rule corres_split[OF getMRs_corres])
+      apply (rule corres_split[OF getMessageInfo_corres])
+        apply clarsimp
+        apply (simp add: liftM_def cap_register_def capRegister_def)
+        apply (rule corres_split_eqr[OF asUser_getRegister_corres])
+          apply (rule syscall_corres)
+                  apply (rule hinv_corres_assist, simp)
+                 apply (clarsimp simp add: when_def)
+                 apply (rule handleFault_corres)
                  apply simp
-                apply (rule decodeInvocation_corres; simp)
-                 apply (fastforce simp: list_all2_map2 list_all2_map1 elim: list_all2_mono)
-                apply (fastforce simp: list_all2_map2 list_all2_map1 elim: list_all2_mono)
-               apply (wpsimp wp: hoare_case_option_wp)
-              apply (drule sym[OF conjunct1], simp, wp)
-             apply (clarsimp simp: when_def)
-             apply (rule replyFromKernel_corres)
-            apply (rule corres_split [OF setThreadState_corres], simp)
-              apply (rule corres_splitEE)
-                 apply (rule performInvocation_corres; simp)
+                apply (simp add: split_def)
+                apply (rule corres_split[OF getMRs_corres])
+                  apply (rule decodeInvocation_corres, simp_all)[1]
+                   apply (fastforce simp: list_all2_map2 list_all2_map1 elim:  list_all2_mono)
+                  apply (fastforce simp: list_all2_map2 list_all2_map1 elim:  list_all2_mono)
+                 apply wp[1]
+                apply (drule sym[OF conjunct1])
                 apply simp
-                apply (rule corres_split [OF getThreadState_corres])
-                  apply (rename_tac state state')
-                  apply (case_tac state, simp_all)[1]
-                  apply (fold dc_def)[1]
-                  apply (rule corres_split [OF _ setThreadState_corres])
-                     apply simp
-                     apply (rule corres_when [OF refl replyFromKernel_corres])
-                    apply simp
-                   apply (clarsimp simp: pred_conj_def, strengthen valid_objs_valid_tcbs)
-                   apply wpsimp
-                  apply (clarsimp simp: pred_conj_def, strengthen valid_objs'_valid_tcbs')
-                  apply wpsimp+
-               apply (strengthen invs_valid_objs invs_psp_aligned invs_distinct)
-               apply (clarsimp cong: conj_cong)
-               apply (wpsimp wp: hoare_drop_imp)
-              apply (rule_tac Q'="tcb_at' thread and invs'" in hoare_post_imp_dc2)
-               apply wpsimp
-              apply (clarsimp simp: invs'_def)
-             apply simp
-             apply (rule_tac Q'="\<lambda>rv. einvs and valid_machine_time and schact_is_rct
-                                 and valid_invocation rve
-                                 and (\<lambda>s. thread = cur_thread s)
-                                 and st_tcb_at active thread
-                                 and ct_not_in_release_q and ct_released
-                                 and cur_sc_active and current_time_bounded
-                                 and consumed_time_bounded
-                                 and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-                                 and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s)"
-                        in hoare_post_imp)
-              apply (clarsimp simp: simple_from_active ct_in_state_def schact_is_rct_def
-                                    current_time_bounded_def
-                             elim!: st_tcb_weakenE)
-             apply (wp sts_st_tcb_at' set_thread_state_simple_sched_action
-                       set_thread_state_active_valid_sched set_thread_state_schact_is_rct_strong)
-            apply (rule_tac Q'="\<lambda>_. invs' and ct_not_inQ and valid_invocation' rve'
-                                   and (\<lambda>s. thread = ksCurThread s)
-                                   and st_tcb_at' active' thread
-                                   and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
-                                   and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
-                                   and (\<lambda>s. bound_sc_tcb_at' bound (ksCurThread s) s)"
-                   in hoare_post_imp)
-             apply (clarsimp simp: ct_in_state'_def)
-            apply ((wpsimp wp: setThreadState_nonqueued_state_update setThreadState_st_tcb
-                               setThreadState_rct setThreadState_ct_not_inQ sts_bound_sc_tcb_at'
-                    | wps)+)[1]
-           apply clarsimp
-           apply (wp | simp add: split_def liftE_bindE[symmetric]
-                              ct_in_state'_def ball_conj_distrib
-                     | rule hoare_vcg_conj_elimE)+
-          apply (rule hoare_vcg_conj_lift)
-           apply (rule hoare_strengthen_post[OF lookup_ipc_buffer_in_user_frame])
-           apply meson
-          apply (wp lookup_ipc_buffer_in_user_frame
-                 | simp add: split_def liftE_bindE[symmetric]
-                             ball_conj_distrib)+
-   apply (clarsimp simp: msg_max_length_def word_bits_def)
-   apply (frule schact_is_rct_sane)
-   apply (frule invs_valid_objs)
-   apply (frule valid_objs_valid_tcbs)
-   apply (clarsimp simp: invs_def cur_tcb_def valid_state_def current_time_bounded_def
-                         valid_sched_def valid_pspace_def ct_in_state_def simple_from_active)
+                apply wp[1]
+               apply (clarsimp simp: when_def)
+               apply (rule replyFromKernel_corres)
+              apply (rule corres_split[OF setThreadState_corres], simp)
+                apply (rule corres_splitEE[OF performInvocation_corres])
+                    apply simp+
+                  apply (rule corres_split[OF getThreadState_corres])
+                    apply (rename_tac state state')
+                    apply (case_tac state, simp_all)[1]
+                    apply (fold dc_def)[1]
+                    apply (rule corres_split)
+                       apply (rule corres_when [OF refl replyFromKernel_corres])
+                      apply (rule setThreadState_corres)
+                      apply simp
+                     apply (simp add: when_def)
+                     apply (rule conjI, rule impI)
+                      apply (wp reply_from_kernel_tcb_at)
+                     apply (rule impI, wp+)
+                     apply (wpsimp wp: hoare_drop_imps|strengthen invs_distinct invs_psp_aligned)+
+               apply (rule_tac Q'="\<lambda>rv. einvs and schact_is_rct and valid_invocation rve
+                                   and (\<lambda>s. thread = cur_thread s)
+                                   and st_tcb_at active thread"
+                          in hoare_post_imp)
+                apply (clarsimp simp: simple_from_active ct_in_state_def
+                               elim!: st_tcb_weakenE)
+               apply (wp sts_st_tcb_at' set_thread_state_schact_is_rct
+                         set_thread_state_active_valid_sched)
+              apply (rule_tac Q'="\<lambda>rv. invs' and valid_invocation' rve'
+                                      and (\<lambda>s. thread = ksCurThread s)
+                                      and st_tcb_at' active' thread
+                                      and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
+                                      and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))"
+                         in hoare_post_imp)
+               apply (clarsimp simp: ct_in_state'_def)
+               apply (clarsimp)
+              apply (wp setThreadState_nonqueued_state_update
+                        setThreadState_st_tcb setThreadState_rct)[1]
+             apply (wp lec_caps_to lsft_ex_cte_cap_to
+                    | simp add: split_def liftE_bindE[symmetric]
+                                ct_in_state'_def ball_conj_distrib
+                    | rule hoare_vcg_conj_elimE)+
+   apply (clarsimp simp: tcb_at_invs invs_valid_objs
+                         valid_tcb_state_def ct_in_state_def
+                         simple_from_active invs_mdb
+                         invs_distinct invs_psp_aligned)
+   apply (clarsimp simp: msg_max_length_def word_bits_def schact_is_rct_def)
    apply (erule st_tcb_ex_cap, clarsimp+)
    apply fastforce
-  apply (clarsimp cong: conj_cong)
-  apply (subgoal_tac "ct_schedulable s")
-   apply (clarsimp simp: invs'_def valid_pspace'_def cur_tcb'_def)
-   apply (frule valid_objs'_valid_tcbs')
-   apply (frule ct_active_cross, fastforce, fastforce, simp)
-   apply (clarsimp simp: ct_in_state'_def cong: conj_cong)
-   apply (frule pred_tcb'_weakenE [where P=active' and P'=simple'], clarsimp)
-   apply (frule(1) st_tcb_ex_cap'', fastforce)
-   apply (clarsimp simp: valid_pspace'_def schact_is_rct_def)
-   apply (frule state_relation_schact, simp)
-   apply (subgoal_tac "isSchedulable_bool (ksCurThread s') s'")
-    apply (clarsimp simp: isSchedulable_bool_def pred_map_conj[simplified pred_conj_def])
-   apply (frule curthread_relation, simp)
-   apply (frule_tac t1="cur_thread s" in cross_relF[OF _ isSchedulable_bool_cross_rel];
-          simp add: invs_def valid_state_def valid_pspace_def)
-  apply (clarsimp simp: schedulable_def2 ct_in_state_def runnable_eq_active)
+  apply (clarsimp)
+  apply (frule tcb_at_invs')
+  apply (clarsimp simp: invs'_def valid_state'_def
+                        ct_in_state'_def ct_not_inQ_def)
+  apply (frule pred_tcb'_weakenE [where P=active' and P'=simple'], clarsimp)
+  apply (frule(1) st_tcb_ex_cap'', fastforce)
+  apply (clarsimp simp: valid_pspace'_def)
+  apply (frule (1) st_tcb_at_idle_thread')
+  apply (simp)
   done
 
 lemma ts_Restart_case_helper':
-  "(case ts of Structures_H.Restart \<Rightarrow> A | _ \<Rightarrow> B) = (if ts = Structures_H.Restart then A else B)"
+  "(case ts of Structures_H.Restart \<Rightarrow> A | _ \<Rightarrow> B)
+ = (if ts = Structures_H.Restart then A else B)"
   by (cases ts, simp_all)
 
 lemma gts_imp':
@@ -1398,12 +1273,14 @@ lemma gts_imp':
   done
 
 crunch replyFromKernel
-  for st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' P' t s)"
-  and cap_to'[wp]: "ex_nonz_cap_to' p"
-  and it'[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and sch_act_simple[wp]: sch_act_simple
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  (rule: sch_act_simple_lift simp: crunch_simps wp: crunch_wps)
+  for st_tcb_at'[wp]: "st_tcb_at' P t"
+crunch replyFromKernel
+  for cap_to'[wp]: "ex_nonz_cap_to' p"
+crunch replyFromKernel
+  for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
+crunch replyFromKernel
+  for sch_act_simple[wp]: sch_act_simple
+  (rule: sch_act_simple_lift)
 
 lemma rfk_ksQ[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s p)\<rbrace> replyFromKernel t x1 \<lbrace>\<lambda>_ s. P (ksReadyQueues s p)\<rbrace>"
@@ -1413,14 +1290,13 @@ lemma rfk_ksQ[wp]:
   done
 
 lemma hinv_invs'[wp]:
-  "\<lbrace>invs' and ct_isSchedulable and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))
-    and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
-   handleInvocation calling blocking can_donate first_phase cptr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  "\<lbrace>invs' and ct_active' and
+          (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
+          (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
+     handleInvocation calling blocking
+   \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: handleInvocation_def split_def
-                   ts_Restart_case_helper' ct_not_inQ_asrt_def)
-  apply (rule validE_valid)
-  apply (intro bindE_wp[OF _ stateAssertE_sp])
+                   ts_Restart_case_helper')
   apply (wp syscall_valid' setThreadState_nonqueued_state_update rfk_invs'
             hoare_vcg_all_lift hoare_weak_lift_imp)
          apply simp
@@ -1428,66 +1304,56 @@ lemma hinv_invs'[wp]:
           apply (wp gts_imp' | simp)+
         apply (rule_tac Q'="\<lambda>rv. invs'" in hoare_strengthen_postE_R[rotated])
          apply clarsimp
+         apply (subgoal_tac "thread \<noteq> ksIdleThread s", simp_all)[1]
           apply (fastforce elim!: pred_tcb'_weakenE st_tcb_ex_cap'')
+         apply (clarsimp simp: valid_idle'_def valid_state'_def
+                               invs'_def pred_tcb_at'_def obj_at'_def idle_tcb'_def)
         apply wp+
-       apply (rule_tac Q'="\<lambda>rv'. invs' and ct_not_inQ and valid_invocation' rv
+       apply (rule_tac Q'="\<lambda>rv'. invs' and valid_invocation' rv
                                 and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
                                 and (\<lambda>s. ksCurThread s = thread)
-                                and st_tcb_at' active' thread
-                                and (\<lambda>s. bound_sc_tcb_at' bound (ksCurThread s) s)"
+                                and st_tcb_at' active' thread"
                   in hoare_post_imp)
         apply (clarsimp simp: ct_in_state'_def)
-       apply (wpsimp wp: sts_invs_minor' setThreadState_st_tcb setThreadState_rct
-                         setThreadState_ct_not_inQ hoare_vcg_imp_lift'
-              | wps)+
-  apply (fastforce simp: ct_in_state'_def simple_sane_strg sch_act_simple_def pred_map_simps
-                         obj_at_simps pred_tcb_at'_def
-                  elim!: pred_tcb'_weakenE st_tcb_ex_cap'' opt_mapE
-                   dest: st_tcb_at_idle_thread')+
-  done
-
-(* NOTE: This is a good candidate for corressimp at some point. For now there are some missing
-         lemmas regarding corresK and liftM. *)
-lemma getCapReg_corres:
-  "corres (\<lambda>x y. x = to_bl y) ct_active ct_active'
-          (get_cap_reg cap_register) (getCapReg ARM_H.capRegister)"
-  apply (simp add: get_cap_reg_def getCapReg_def cap_register_def capRegister_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getCurThread_corres], simp)
-      apply (rule corres_rel_imp)
-       apply (rule asUser_getRegister_corres)
-      apply (wpsimp simp: ct_in_state_def ct_in_state'_def)+
+       apply (wp sts_invs_minor' setThreadState_st_tcb setThreadState_rct | simp)+
+    apply (clarsimp)
+    apply (fastforce simp add: tcb_at_invs' ct_in_state'_def
+                              simple_sane_strg
+                              sch_act_simple_def
+                       elim!: pred_tcb'_weakenE st_tcb_ex_cap''
+                        dest: st_tcb_at_idle_thread')+
   done
 
+crunch handleFault
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps)
+
+lemmas handleFault_typ_ats[wp] = typ_at_lifts [OF handleFault_typ_at']
+
 lemma handleSend_corres:
   "corres (dc \<oplus> dc)
-          (einvs and valid_machine_time and schact_is_rct and ct_active
-           and ct_released and (\<lambda>s. active_sc_tcb_at (cur_thread s) s)
-           and ct_not_in_release_q and cur_sc_active and current_time_bounded
-           and  consumed_time_bounded and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-           and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s))
+          (einvs and schact_is_rct and ct_active)
           (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
            (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and ct_active')
           (handle_send blocking) (handleSend blocking)"
-  apply add_cur_tcb'
-  apply (simp add: handle_send_def handleSend_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_liftEE[OF getCapReg_corres])
-      apply (simp, rule handleInvocation_corres; simp)
-     apply (wpsimp simp: getCapReg_def)+
-  apply (clarsimp simp: cur_tcb'_def)
-  done
+  by (simp add: handle_send_def handleSend_def handleInvocation_corres)
 
 lemma hs_invs'[wp]:
-  "\<lbrace>invs' and ct_isSchedulable and
+  "\<lbrace>invs' and ct_active' and
     (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
     (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
    handleSend blocking \<lbrace>\<lambda>r. invs'\<rbrace>"
   apply (rule validE_valid)
-  apply (simp add: handleSend_def getCapReg_def)
+  apply (simp add: handleSend_def)
   apply (wp | simp)+
   done
 
+lemma getThreadCallerSlot_map:
+  "getThreadCallerSlot t = return (cte_map (t, tcb_cnode_index 3))"
+  by (simp add: getThreadCallerSlot_def locateSlot_conv
+                cte_map_def tcb_cnode_index_def tcbCallerSlot_def
+                cte_level_bits_def)
+
 lemma tcb_at_cte_at_map:
   "\<lbrakk> tcb_at' t s; offs \<in> dom tcb_cap_cases \<rbrakk> \<Longrightarrow> cte_at' (cte_map (t, offs)) s"
   apply (clarsimp simp: obj_at'_def projectKOs objBits_simps)
@@ -1495,204 +1361,178 @@ lemma tcb_at_cte_at_map:
   apply (auto elim: cte_wp_at_tcbI')
   done
 
-crunch tcbSchedEnqueue
-  for sch_act_sane[wp]: sch_act_sane
-  (rule: sch_act_sane_lift)
+lemma deleteCallerCap_corres:
+  "corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
+     (delete_caller_cap t)
+     (deleteCallerCap t)"
+  apply (simp add: delete_caller_cap_def deleteCallerCap_def
+                   getThreadCallerSlot_map)
+  apply (rule corres_guard_imp)
+    apply (rule_tac P'="cte_at' (cte_map (t, tcb_cnode_index 3))" in corres_symb_exec_r_conj)
+       apply (rule_tac F="isReplyCap rv \<or> rv = capability.NullCap"
+             and P="cte_wp_at (\<lambda>cap. is_reply_cap cap \<or> cap = cap.NullCap) (t, tcb_cnode_index 3)
+                 and einvs"
+             and P'="invs' and cte_wp_at' (\<lambda>cte. cteCap cte = rv)
+                 (cte_map (t, tcb_cnode_index 3))" in corres_req)
+        apply (clarsimp simp: cte_wp_at_caps_of_state state_relation_def)
+        apply (drule caps_of_state_cteD)
+        apply (drule(1) pspace_relation_cte_wp_at, clarsimp+)
+        apply (clarsimp simp: cte_wp_at_ctes_of is_reply_cap_relation cap_relation_NullCapI)
+       apply simp
+       apply (rule corres_guard_imp, rule cap_delete_one_corres)
+        apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps)
+        apply (auto simp: can_fast_finalise_def)[1]
+       apply (clarsimp simp: cte_wp_at_ctes_of)
+      apply ((wp getCTE_wp')+ | simp add: getSlotCap_def)+
+   apply clarsimp
+   apply (frule tcb_at_cte_at[where ref="tcb_cnode_index 3"])
+    apply clarsimp
+   apply (clarsimp simp: cte_wp_at_caps_of_state)
+   apply (frule tcb_cap_valid_caps_of_stateD, clarsimp)
+   apply (drule(1) tcb_cnode_index_3_reply_or_null)
+   apply (auto simp: can_fast_finalise_def is_cap_simps
+              intro: tcb_at_cte_at_map tcb_at_cte_at)[1]
+  apply clarsimp
+  apply (frule_tac offs="tcb_cnode_index 3" in tcb_at_cte_at_map)
+   apply (simp add: tcb_cap_cases_def)
+  apply (clarsimp simp: cte_wp_at_ctes_of)
+  done
 
-lemma possibleSwitchTo_sch_act_sane:
-  "\<lbrace> sch_act_sane and (\<lambda>s. t \<noteq> ksCurThread s) \<rbrace> possibleSwitchTo t \<lbrace>\<lambda>_. sch_act_sane \<rbrace>"
-  unfolding possibleSwitchTo_def curDomain_def  inReleaseQueue_def
-  apply (wpsimp wp: threadGet_wp crunch_wps)
-  apply (fastforce simp: obj_at'_def sch_act_sane_def)
+lemma deleteCallerCap_invs[wp]:
+  "\<lbrace>invs'\<rbrace> deleteCallerCap t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: deleteCallerCap_def getThreadCallerSlot_def
+                locateSlot_conv)
+  apply (wp cteDeleteOne_invs hoare_drop_imps)
+  done
+
+lemma deleteCallerCap_simple[wp]:
+  "\<lbrace>st_tcb_at' simple' t\<rbrace> deleteCallerCap t' \<lbrace>\<lambda>rv. st_tcb_at' simple' t\<rbrace>"
+  apply (simp add: deleteCallerCap_def getThreadCallerSlot_def
+                   locateSlot_conv)
+  apply (wp cteDeleteOne_st_tcb_at hoare_drop_imps | simp)+
+  done
+
+lemma cteDeleteOne_reply_cap_to''[wp]:
+  "\<lbrace>ex_nonz_cap_to' p and
+    cte_wp_at' (\<lambda>c. isReplyCap (cteCap c) \<or> isNullCap (cteCap c)) slot\<rbrace>
+   cteDeleteOne slot
+   \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
+  apply (simp add: cteDeleteOne_def ex_nonz_cap_to'_def unless_def)
+  apply (rule bind_wp [OF _ getCTE_sp])
+  apply (rule hoare_assume_pre)
+  apply (subgoal_tac "isReplyCap (cteCap cte) \<or> isNullCap (cteCap cte)")
+   apply (wp hoare_vcg_ex_lift emptySlot_cte_wp_cap_other isFinalCapability_inv
+        | clarsimp simp: finaliseCap_def isCap_simps | simp
+        | wp (once) hoare_drop_imps)+
+   apply (fastforce simp: cte_wp_at_ctes_of)
+  apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
+  done
+
+lemma deleteCallerCap_nonz_cap:
+  "\<lbrace>ex_nonz_cap_to' p and tcb_at' t and valid_objs'\<rbrace>
+      deleteCallerCap t
+   \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
+   apply (simp add: deleteCallerCap_def getSlotCap_def getThreadCallerSlot_map
+                    locateSlot_conv )
+  apply (rule hoare_pre)
+  apply (wp cteDeleteOne_reply_cap_to'' getCTE_wp')
+  apply clarsimp
+  apply (frule_tac offs="tcb_cnode_index 3" in tcb_at_cte_at_map)
+  apply (clarsimp simp: tcb_cap_cases_def)
+  apply (auto simp: ex_nonz_cap_to'_def isCap_simps cte_wp_at_ctes_of)
   done
 
 crunch cteDeleteOne
- for sch_act_sane[wp]: sch_act_sane
-  (wp: crunch_wps getObject_inv
+  for sch_act_sane[wp]: sch_act_sane
+  (wp: crunch_wps loadObject_default_inv getObject_inv
    simp: crunch_simps unless_def
    rule: sch_act_sane_lift)
 
-lemma getCapReg_corres_gen:
-  "corres (\<lambda>x y. x = to_bl y) cur_tcb cur_tcb'
-          (get_cap_reg rg) (getCapReg rg)"
-  apply (simp add: get_cap_reg_def getCapReg_def cap_register_def capRegister_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getCurThread_corres], simp)
-      apply (rule corres_rel_imp)
-       apply (rule asUser_getRegister_corres)
-      apply (wpsimp simp: cur_tcb_def cur_tcb'_def)+
-  done
-
-lemma lookupReply_corres:
-  "corres (fr \<oplus> cap_relation)
-     (cur_tcb and valid_objs and pspace_aligned)
-     (cur_tcb' and valid_objs' and pspace_aligned' and pspace_distinct')
-     lookup_reply lookupReply"
-  unfolding lookup_reply_def lookupReply_def withoutFailure_def
-  apply simp
-  apply (rule corres_rel_imp)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split_liftEE[OF getCapReg_corres_gen])
-       apply (rule corres_split_liftEE[OF getCurThread_corres])
-         apply simp
-         apply (rule corres_splitEE[OF corres_cap_fault[OF lookupCap_corres]])
-           apply (rename_tac cref cref' ct ct' cap cap')
-           apply (rule corres_if2)
-             apply (case_tac cap; case_tac cap'; clarsimp simp: is_reply_cap_def isReplyCap_def)
-            apply (rule corres_returnOk[where r=cap_relation])
-            apply simp
-           apply (simp add: lookup_failure_map_def)
-          apply wpsimp+
-     apply (wpsimp simp: getCapReg_def)
-    apply (clarsimp simp: cur_tcb_def, simp)
-   apply (clarsimp simp: cur_tcb'_def)
-  apply assumption
-  done
-
-lemma lookup_reply_valid [wp]:
-  "\<lbrace> valid_objs \<rbrace> lookup_reply \<lbrace> valid_cap \<rbrace>, -"
-  unfolding lookup_reply_def get_cap_reg_def
-  apply (wpsimp wp: get_cap_wp hoare_vcg_imp_liftE_R)
-       apply (rule hoare_FalseE_R)
-      apply wpsimp+
-  done
-
-lemma lookup_reply_is_reply_cap [wp]:
-  "\<lbrace> valid_objs \<rbrace> lookup_reply \<lbrace>\<lambda>rv s. is_reply_cap rv \<rbrace>, -"
-  unfolding lookup_reply_def lookup_cap_def
-  by (wpsimp wp: get_cap_wp)
-
-crunch lookupReply
-  for inv[wp]: "P"
-  (simp: crunch_simps wp: crunch_wps)
-
-crunch lookup_reply
-  for valid_cap[wp]: "valid_cap c"
-  and cte_wp_at[wp]: "\<lambda>s. Q (cte_wp_at P p s)"
-
-lemma lookupReply_valid [wp]:
-  "\<lbrace> valid_objs' \<rbrace> lookupReply \<lbrace> valid_cap' \<rbrace>, -"
-  unfolding lookupReply_def getCapReg_def
-  apply (wpsimp wp: get_cap_wp hoare_vcg_imp_liftE_R)
-       apply (rule hoare_FalseE_R)
-      apply wpsimp+
-  done
-
-lemma getBoundNotification_corres:
-  "corres (=) (ntfn_at nptr) (ntfn_at' nptr)
-          (get_ntfn_obj_ref ntfn_bound_tcb nptr) (liftM ntfnBoundTCB (getNotification nptr))"
-  apply (simp add: get_sk_obj_ref_def)
-  apply (rule corres_bind_return2)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getNotification_corres])
-      apply (simp add: ntfn_relation_def)
-     apply wpsimp+
-  done
+crunch deleteCallerCap
+  for sch_act_sane[wp]: sch_act_sane
+  (wp: crunch_wps)
+
+lemma delete_caller_cap_valid_ep_cap:
+  "\<lbrace>valid_cap (cap.EndpointCap r a b)\<rbrace> delete_caller_cap thread \<lbrace>\<lambda>rv. valid_cap (cap.EndpointCap r a b)\<rbrace>"
+  apply (clarsimp simp: delete_caller_cap_def cap_delete_one_def valid_cap_def)
+  apply (rule hoare_pre)
+   by (wp get_cap_wp fast_finalise_typ_at abs_typ_at_lifts(1)
+       | simp add: unless_def valid_cap_def)+
 
 lemma handleRecv_isBlocking_corres':
-   "corres dc (einvs and ct_in_state active and current_time_bounded
-               and scheduler_act_sane and ct_not_queued and ct_not_in_release_q
-               and (\<lambda>s. ex_nonz_cap_to (cur_thread s) s))
+   "corres dc (einvs and ct_in_state active
+                    and (\<lambda>s. ex_nonz_cap_to (cur_thread s) s))
               (invs' and ct_in_state' simple'
                      and sch_act_sane
                      and (\<lambda>s. ex_nonz_cap_to' (ksCurThread s) s))
-                    (handle_recv isBlocking canReply) (handleRecv isBlocking canReply)"
-  (is "corres dc (?pre1) (?pre2) (handle_recv _ _) (handleRecv _ _)")
-  unfolding handle_recv_def handleRecv_def Let_def
-  apply add_cur_tcb'
-  apply (rule_tac Q="ct_active'" in corres_cross_add_guard)
-   apply (fastforce elim!: ct_active_cross dest: invs_psp_aligned invs_distinct)
-  apply (simp add: cap_register_def capRegister_def liftM_bind
-             cong: if_cong cap.case_cong capability.case_cong split del: if_split)
+                    (handle_recv isBlocking) (handleRecv isBlocking)"
+  (is "corres dc (?pre1) (?pre2) (handle_recv _) (handleRecv _)")
+  apply (simp add: handle_recv_def handleRecv_def liftM_bind Let_def
+                   cap_register_def capRegister_def
+             cong: if_cong cap.case_cong capability.case_cong bool.case_cong)
   apply (rule corres_guard_imp)
     apply (rule corres_split_eqr[OF getCurThread_corres])
       apply (rule corres_split_eqr[OF asUser_getRegister_corres])
         apply (rule corres_split_catch)
-           apply (rule corres_splitEE[OF corres_cap_fault[OF lookupCap_corres]])
+           apply (rule corres_cap_fault)
+           apply (rule corres_splitEE[OF lookupCap_corres])
              apply (rule_tac P="?pre1 and tcb_at thread
                                 and (\<lambda>s. (cur_thread s) = thread  )
                                 and valid_cap rv"
-                        and P'="?pre2 and cur_tcb' and tcb_at' thread and valid_cap' epCap" in corres_inst)
+                        and P'="?pre2 and tcb_at' thread and valid_cap' rv'" in corres_inst)
              apply (clarsimp split: cap_relation_split_asm arch_cap.split_asm split del: if_split
                               simp: lookup_failure_map_def whenE_def)
-              apply (rename_tac rights)
-              apply (case_tac "AllowRead \<in> rights \<and> canReply")
-               apply clarsimp
-               apply (rule corres_guard_imp)
-                 apply (rule corres_splitEE[OF lookupReply_corres])
-                   apply (rule_tac Q="\<lambda>_. is_reply_cap reply_cap" in corres_inst_add)
-                   apply (rule corres_gen_asm)
-                   apply simp
-                   apply (rule corres_guard_imp)
-                     apply (rule receiveIPC_corres)
-                        apply simp
-                       apply (clarsimp simp: cap_relation_def)
-                      apply simp+
-                  apply (wpsimp wp: typ_at_lifts)+
-                apply (clarsimp simp: ct_in_state_def invs_def valid_state_def valid_pspace_def)
-               apply (simp add: invs'_def valid_pspace'_def)
-              apply (clarsimp simp: lookup_failure_map_def)
               apply (rule corres_guard_imp)
-                apply (rule receiveIPC_corres)
-                   apply ((clarsimp simp: cap_relation_def ct_in_state_def)+)[6]
-             apply (rename_tac rights)
-             apply (simp add: bool.case_eq_if if_swap[where P="AllowRead \<in> x" for x, symmetric] split del: if_split)
-             apply (case_tac "AllowRead \<in> rights")
-              apply clarsimp
-              apply (rule stronger_corres_guard_imp)
-                apply (rule corres_split_liftEE[OF getBoundNotification_corres])
-                  apply (case_tac "rv = Some thread \<or> rv = None")
-                   apply simp
-                   apply (rule receiveSignal_corres)
-                    apply simp
-                   apply (clarsimp simp: cap_relation_def)
-                  apply (clarsimp simp: lookup_failure_map_def)
-                 apply (wpsimp wp: get_sk_obj_ref_wp getNotification_wp)+
-               apply (clarsimp simp: valid_cap_def valid_sched_def valid_sched_action_def
-                                     current_time_bounded_def ct_in_state_def)
-              apply (clarsimp simp: valid_cap_def valid_cap'_def dest!: state_relationD)
-             apply (clarsimp simp: lookup_failure_map_def)
-            apply wpsimp+
-          apply (rule handleFault_corres, clarsimp)
-         apply (wpsimp wp: get_sk_obj_ref_wp)
-         apply (rule_tac Q="\<lambda>_. ?pre1 and (\<lambda>s. cur_thread s = thread)
-                                 and K (valid_fault (ExceptionTypes_A.fault.CapFault x True
-                                        (ExceptionTypes_A.lookup_failure.MissingCapability 0)))"
-                     and E=E and F=E for E
-                in hoare_strengthen_postE[rotated])
-           apply (fastforce simp: valid_sched_valid_sched_action valid_sched_active_scs_valid ct_in_state_def)
+                apply (rename_tac rights)
+                apply (case_tac "AllowRead \<in> rights"; simp)
+                 apply (rule corres_split_nor[OF deleteCallerCap_corres])
+                   apply (rule receiveIPC_corres)
+                    apply (clarsimp)+
+                  apply (wp delete_caller_cap_nonz_cap delete_caller_cap_valid_ep_cap)+
+                apply (clarsimp)+
+                apply (clarsimp simp: lookup_failure_map_def)+
+              apply (clarsimp simp: valid_cap'_def capAligned_def)
+             apply (rule corres_guard_imp)
+               apply (rename_tac rights)
+               apply (case_tac "AllowRead \<in> rights"; simp)
+                apply (rule_tac r'=ntfn_relation in corres_splitEE)
+                   apply clarsimp
+                   apply (rule getNotification_corres)
+                  apply (rule corres_if)
+                    apply (clarsimp simp: ntfn_relation_def)
+                   apply (clarsimp, rule receiveSignal_corres)
+                    prefer 3
+                    apply (rule corres_trivial)
+                    apply (clarsimp simp: lookup_failure_map_def)+
+                 apply (wp get_simple_ko_wp getNotification_wp | wpcw | simp)+
+               apply (clarsimp simp: lookup_failure_map_def)
+              apply (clarsimp simp: valid_cap_def ct_in_state_def)
+             apply (clarsimp simp: valid_cap'_def capAligned_def)
+            apply wp+
+          apply (rule handleFault_corres)
           apply simp
-         apply (wpsimp wp: resolve_address_bits_valid_fault2 simp: lookup_cap_def lookup_cap_and_slot_def lookup_slot_for_thread_def)
-        apply wp
-         apply (case_tac epCap; simp split del: if_split)
-                      apply wpsimp
-                     apply wpsimp
-                    apply (rename_tac readright; case_tac readright; simp)
-                     apply wp
-                       apply simp
-                       apply wp
-                      apply (wp getNotification_wp)
-                     apply clarsimp
-                    apply (wpsimp wp: hoare_vcg_imp_lift' simp: valid_fault_def)+
-   apply (clarsimp simp: invs_def cur_tcb_def valid_state_def valid_pspace_def ct_in_state_def
-                         valid_sched_valid_sched_action valid_sched_active_scs_valid
-                  dest!: get_tcb_SomeD)
-   apply (erule (1) valid_objsE)
-   apply (clarsimp simp: valid_obj_def valid_tcb_def tcb_cap_cases_def)
-  apply (clarsimp simp: invs'_def cur_tcb'_def valid_pspace'_def sch_act_sane_def ct_in_state'_def)
+         apply (wp get_simple_ko_wp | wpcw | simp)+
+         apply (rule hoare_vcg_conj_elimE)
+          apply (simp add: lookup_cap_def lookup_slot_for_thread_def)
+          apply wp
+           apply (simp add: split_def)
+           apply (wp resolve_address_bits_valid_fault2)+
+         apply (wp getNotification_wp | wpcw | simp add: valid_fault_def whenE_def split del: if_split)+
+   apply (clarsimp simp add: ct_in_state_def  ct_in_state'_def conj_comms invs_valid_tcb_ctable
+                             invs_valid_objs tcb_at_invs invs_psp_aligned invs_cur)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def
+                        ct_in_state'_def sch_act_sane_not)
   done
 
 lemma handleRecv_isBlocking_corres:
-  "corres dc (einvs and ct_active and scheduler_act_sane and current_time_bounded
-              and ct_not_queued and ct_not_in_release_q)
-             (invs' and ct_active' and sch_act_sane and
-                    (\<lambda>s. \<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
-            (handle_recv isBlocking canReply) (handleRecv isBlocking canReply)"
+  "corres dc (einvs and ct_active)
+             (invs' and ct_active' and sch_act_sane)
+            (handle_recv isBlocking) (handleRecv isBlocking)"
   apply (rule corres_guard_imp)
     apply (rule handleRecv_isBlocking_corres')
    apply (clarsimp simp: ct_in_state_def)
    apply (fastforce elim!: st_tcb_weakenE st_tcb_ex_cap)
-  apply (clarsimp simp: ct_in_state'_def invs'_def)
+  apply (clarsimp simp: ct_in_state'_def invs'_def valid_state'_def)
   apply (frule(1) st_tcb_ex_cap'')
   apply (auto elim: pred_tcb'_weakenE)
   done
@@ -1702,540 +1542,90 @@ lemma lookupCap_refs[wp]:
   by (simp add: lookupCap_def split_def | wp | simp add: o_def)+
 
 lemma hw_invs'[wp]:
-  "\<lbrace>invs' and ct_in_state' active'\<rbrace>
-   handleRecv isBlocking canReply
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: handleRecv_def cong: if_cong split del: if_split)
-  apply (rule bind_wp[OF _ getCurThread_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule catch_wp; (solves wpsimp)?)
-  apply (rule_tac P=P and
-                  Q'="\<lambda>rv. P and (\<lambda>s. \<forall>r\<in>zobj_refs' rv. ex_nonz_cap_to' r s)
-                          and (\<lambda>s. ex_nonz_cap_to' (ksCurThread s) s)
-                          and (\<lambda>s. st_tcb_at' active' (ksCurThread s) s)"
-         for P in bindE_wp_fwd)
-   apply wpsimp
-   apply (fastforce simp: ct_in_state'_def)
-  apply (rename_tac epCap)
-  apply (case_tac epCap; clarsimp split del: if_split; (wpsimp; fail)?)
-   apply (rename_tac readright; case_tac readright; (wp getNotification_wp |simp)+)
-   apply (clarsimp simp: obj_at_simps isNotificationCap_def)
-  by (wpsimp simp: lookupReply_def getCapReg_def
-      | wp (once) hoare_drop_imps)+
-     (clarsimp simp: obj_at_simps ct_in_state'_def pred_tcb_at'_def)
+  "\<lbrace>invs' and ct_in_state' simple' and sch_act_sane
+          and (\<lambda>s. ex_nonz_cap_to' (ksCurThread s) s)
+          and (\<lambda>s. ksCurThread s \<noteq> ksIdleThread s)\<rbrace>
+   handleRecv isBlocking \<lbrace>\<lambda>r. invs'\<rbrace>"
+  apply (simp add: handleRecv_def cong: if_cong)
+  apply (rule hoare_pre)
+   apply ((wp getNotification_wp | wpc | simp)+)[1]
+                apply (clarsimp simp: ct_in_state'_def)
+                apply ((wp deleteCallerCap_nonz_cap hoare_vcg_all_lift
+                           hoare_lift_Pf2[OF deleteCallerCap_simple
+                           deleteCallerCap_ct']
+                      | wpc | simp)+)[1]
+               apply simp
+               apply (wp deleteCallerCap_nonz_cap hoare_vcg_all_lift
+                         hoare_lift_Pf2[OF deleteCallerCap_simple
+                         deleteCallerCap_ct']
+                    | wpc | simp add: ct_in_state'_def whenE_def split del: if_split)+
+     apply (rule validE_validE_R)
+     apply (rule_tac Q'="\<lambda>rv s. invs' s
+                             \<and> sch_act_sane s
+                             \<and> thread = ksCurThread s
+                             \<and> ct_in_state' simple' s
+                             \<and> ex_nonz_cap_to' thread s
+                             \<and> thread \<noteq> ksIdleThread s
+                            \<and> (\<forall>x \<in> zobj_refs' rv. ex_nonz_cap_to' x s)"
+              and E'="\<lambda>_ _. True"
+           in hoare_strengthen_postE[rotated])
+        apply (clarsimp simp: isCap_simps ct_in_state'_def pred_tcb_at' invs_valid_objs'
+                              sch_act_sane_not obj_at'_def projectKOs pred_tcb_at'_def)
+      apply (assumption)
+     apply (wp)+
+  apply (clarsimp)
+  apply (auto elim: st_tcb_ex_cap'' pred_tcb'_weakenE
+             dest!: st_tcb_at_idle_thread'
+              simp: ct_in_state'_def sch_act_sane_def)
+  done
 
 lemma setSchedulerAction_obj_at'[wp]:
   "\<lbrace>obj_at' P p\<rbrace> setSchedulerAction sa \<lbrace>\<lambda>rv. obj_at' P p\<rbrace>"
   unfolding setSchedulerAction_def
   by (wp, clarsimp elim!: obj_at'_pspaceI)
 
-lemma live_sc'_ex_cap:
-  "if_live_then_nonz_cap' s \<Longrightarrow>
-   \<forall>ko. ko_at' ko scPtr s \<longrightarrow> live_sc' ko \<longrightarrow> ex_nonz_cap_to' scPtr s"
-  by (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs
-              elim!: if_live_then_nonz_capE')
-
-lemma valid_sc_strengthen:
-  "valid_objs' s \<Longrightarrow>
-   \<forall>ko. ko_at' ko scPtr s \<longrightarrow>
-                valid_sched_context' ko s \<and> valid_sched_context_size' ko"
-  by (clarsimp elim!: sc_ko_at_valid_objs_valid_sc')
-
-lemma endTimeslice_corres: (* called when ct_schedulable *)
-  "corres dc
-     (invs and valid_list and valid_sched_action and active_scs_valid and valid_release_q
-      and valid_ready_qs and cur_sc_active and ct_active and current_time_bounded
-      and ct_not_queued
-      and cur_sc_tcb_are_bound and scheduler_act_sane)
-     invs'
-     (end_timeslice canTimeout) (endTimeslice canTimeout)"
-  (is "corres _ ?pre ?pre' _ _")
-  unfolding end_timeslice_def endTimeslice_def isValidTimeoutHandler_def bind_assoc
-  apply (rule_tac Q="\<lambda>s. sc_at' (ksCurSc s) s" in corres_cross_add_guard)
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
-                  dest!: state_relationD)
-   apply (erule (2) sc_at_cross)
-   apply (fastforce simp: cur_sc_tcb_def sc_tcb_sc_at_def obj_at_def is_sc_obj
-                    dest: valid_sched_context_size_objsI)
-  apply (rule_tac Q="\<lambda>s. is_active_sc' (ksCurSc s) s" in corres_cross_add_guard)
-   apply (prop_tac "cur_sc s = ksCurSc s'", clarsimp dest!: state_relationD)
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-   apply (fastforce dest: valid_sched_context_size_objsI elim!: is_active_sc'2_cross
-                    simp: invs_def valid_state_def valid_pspace_def cur_sc_tcb_def sc_tcb_sc_at_def
-                          obj_at_def is_sc_obj)
-  apply add_cur_tcb'
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_eqr[OF getCurThread_corres])
-      apply (rule_tac P="?pre and (\<lambda>s. ct = cur_thread s)"
-                 and P'="?pre' and (\<lambda>s. is_active_sc' (ksCurSc s) s) and cur_tcb'
-                         and (\<lambda>s. sc_at' (ksCurSc s) s) and (\<lambda>s. ct = ksCurThread s)" in corres_inst)
-      apply (rule corres_guard_imp)
-        apply (rule corres_split_eqr[OF getCurSc_corres])
-          apply (rule_tac P="?pre and (\<lambda>s. ct = cur_thread s) and (\<lambda>s. sc_ptr = cur_sc s)"
-                     and P'="?pre' and (\<lambda>s. is_active_sc' (ksCurSc s) s) and cur_tcb'
-                             and (\<lambda>s. sc_at' (ksCurSc s) s) and (\<lambda>s. ct = ksCurThread s) and (\<lambda>s. sc_ptr = ksCurSc s)" in corres_inst)
-          apply (rule corres_guard_imp)
-            apply (rule corres_split[OF get_sc_corres])
-              apply (rule corres_split_eqr[OF refillReady_corres])
-                apply (rule corres_split_eqr[OF refillSufficient_corres])
-                   apply simp
-                  apply (rule_tac P="?pre and (\<lambda>s. ct = cur_thread s) and (\<lambda>s. sc_ptr = cur_sc s)
-                                     and (\<lambda>s. ready = is_refill_ready sc_ptr s)
-                                     and (\<lambda>s. sufficient = is_refill_sufficient 0 sc_ptr s)"
-                             and P'="?pre' and (\<lambda>s. is_active_sc' (ksCurSc s) s) and cur_tcb'
-                                     and (\<lambda>s. sc_at' (ksCurSc s) s) and (\<lambda>s. sc_ptr = ksCurSc s) and (\<lambda>s. ct = ksCurThread s)" in corres_inst)
-                  apply (simp split del: if_split)
-                  apply (rule corres_guard_imp)
-                    apply (rule corres_split[OF getObject_TCB_corres])
-                      apply (rename_tac tcb tcb')
-                      apply (rule_tac F="cap_relation (tcb_timeout_handler tcb) (cteCap (tcbTimeoutHandler tcb'))"
-                             in corres_req)
-                       apply (clarsimp simp: tcb_relation_def)
-                      apply (rule_tac F="is_ep_cap (tcb_timeout_handler tcb)
-                                         = isEndpointCap (cteCap (tcbTimeoutHandler tcb'))"
-                             in corres_req)
-                       apply (case_tac "tcb_timeout_handler tcb";
-                              case_tac "cteCap (tcbTimeoutHandler tcb')";
-                              clarsimp simp: cap_relation_def isEndpointCap_def)
-                      apply (rule corres_symb_exec_r)
-                         apply (rule_tac P="?pre and (\<lambda>s. ct = cur_thread s) and (\<lambda>s. sc_ptr = cur_sc s)
-                                            and (\<lambda>s. ready = is_refill_ready sc_ptr s) and ko_at (TCB tcb) ct
-                                            and (\<lambda>s. sufficient = is_refill_sufficient 0 sc_ptr s)"
-                                    and P'="?pre' and cur_tcb' and (\<lambda>s. ct = ksCurThread s)
-                                            and (\<lambda>s. sc_at' (ksCurSc s) s) and (\<lambda>s. is_active_sc' (ksCurSc s) s) and (\<lambda>s. sc_ptr = ksCurSc s) and
-                                            K (valid = isEndpointCap (cteCap (tcbTimeoutHandler tcb')))"
-                                in corres_inst)
-                         apply (rule corres_gen_asm2')
-                         apply (rule corres_guard_imp)
-                           apply (rule corres_if2)
-                             apply clarsimp
-                            apply simp
-                            apply (rule handleTimeout_corres)
-                            apply clarsimp
-                            apply (clarsimp simp: sc_relation_def)
-                           apply (rule corres_if2, simp)
-                            apply (rule tcbSchedAppend_corres)
-                           apply (rule postpone_corres)
-                          apply (clarsimp cong: conj_cong imp_cong)
-                          apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_def
-                                                valid_fault_def valid_fault_handler_def)
-                          apply (rule conjI impI; clarsimp)
-                           apply (clarsimp simp: ct_in_state_def cte_wp_at_def cur_tcb_def)
-                           apply (clarsimp simp: get_cap_caps_of_state obj_at_def is_tcb
-                                                 caps_of_state_tcb_index_trans[OF get_tcb_rev]
-                                                 tcb_cnode_map_def)
-                          apply (frule (1) cur_sc_tcb_are_bound_sym)
-                          apply (clarsimp simp: vs_all_heap_simps sc_tcb_sc_at_def obj_at_def is_tcb_def)
-                         apply (clarsimp simp: invs'_def valid_pspace'_def cur_tcb'_def)
-                        apply (wpsimp wp: getTCB_wp)+
-                   apply (clarsimp dest!: invs_cur simp: cur_tcb_def)
-                  apply (clarsimp simp: cur_tcb'_def isEndpointCap_def)
-                 apply (wpsimp wp: get_sc_refill_sufficient_wp refillReady_wp)+
-           apply (clarsimp dest!: valid_sched_active_scs_valid
-                            simp: invs_def cur_sc_tcb_def valid_state_def valid_pspace_def
-                                  sc_tcb_sc_at_def obj_at_def is_sc_obj opt_map_red vs_all_heap_simps
-                                  sc_refills_sc_at_def opt_pred_def)
-           apply (drule (1) valid_sched_context_size_objsI, clarsimp)
-           apply (drule active_scs_validE[rotated])
-            apply (fastforce simp: vs_all_heap_simps)
-           apply (clarsimp simp: vs_all_heap_simps rr_valid_refills_def valid_refills_def split: if_split_asm)
-          apply (clarsimp simp: cur_tcb'_def invs'_def valid_pspace'_def
-                         elim!: valid_objs'_valid_refills')
-         apply wpsimp+
-  done
-
-crunch end_timeslice, refill_reset_rr
-  for pspace_aligned[wp]: pspace_aligned
-  and pspace_distinct[wp]: pspace_distinct
-  and valid_list[wp]: valid_list
-  and cur_sc_active[wp]: cur_sc_active
-  (wp: crunch_wps set_simple_ko_valid_tcbs cur_sc_active_lift
-   ignore: set_object)
-
-crunch refill_reset_rr
-  for cte_wp_at[wp]: "cte_wp_at P c"
-
-lemma handle_timeout_valid_sched_action:
-  "\<lbrace>\<lambda>s. valid_sched_action s \<and> released_ipc_queues s \<and> scheduler_act_not tptr s
-      \<and> active_scs_valid s
-      \<and> (is_timeout_fault ex \<and> active_sc_tcb_at tptr s \<or> released_if_bound_sc_tcb_at tptr s)\<rbrace>
-   handle_timeout tptr ex
-   \<lbrace>\<lambda>_. valid_sched_action :: det_state \<Rightarrow> _\<rbrace>"
-  unfolding handle_timeout_def
-  apply (wpsimp wp: send_fault_ipc_valid_sched_action)
-  done
-
-lemma end_timeslice_valid_sched_action:
-  "\<lbrace>valid_sched_action and released_ipc_queues and active_scs_valid and scheduler_act_sane
-    and cur_sc_tcb_are_bound and cur_sc_active and (\<lambda>s. sym_refs (state_refs_of s))\<rbrace>
-   end_timeslice canTimeout
-   \<lbrace>\<lambda>_. valid_sched_action :: det_state \<Rightarrow> _\<rbrace>"
-  unfolding end_timeslice_def
-  apply (wpsimp wp: handle_timeout_valid_sched_action postpone_valid_sched_action)
-  apply (frule (1) cur_sc_tcb_are_bound_sym)
-  apply (intro conjI; clarsimp simp: is_timeout_fault_def del: disjCI)
-   apply (rule disjI1)
-   apply (fastforce simp: active_sc_tcb_at_def2 tcb_at_kh_simps pred_map_eq_normalise
-                   dest!: get_tcb_SomeD)
-  apply (clarsimp simp: sc_at_kh_simps pred_map_eq_def[symmetric])
-  apply (clarsimp simp: pred_map_simps)
-  done
-
-lemma sendFaultIPC_invs':
-  "\<lbrace>invs' and valid_idle' and st_tcb_at' active' t
-          and (\<lambda>s. canDonate \<longrightarrow> bound_sc_tcb_at' bound t s)
-          and ex_nonz_cap_to' t
-          and (\<lambda>s. \<exists>n\<in>dom tcb_cte_cases. \<exists>cte. cte_wp_at' (\<lambda>cte. cteCap cte = cap) (t + n) s)\<rbrace>
-   sendFaultIPC t cap f canDonate
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: sendFaultIPC_def)
-  apply (wp threadSet_invs_trivial threadSet_pred_tcb_no_state
-            threadSet_cap_to' threadSet_idle'
-           | wpc | simp)+
-  apply (intro conjI impI allI; (fastforce simp: inQ_def)?)
-   apply (clarsimp simp: invs'_def valid_release_queue'_def obj_at'_def)
-  apply (fastforce simp: ex_nonz_cap_to'_def cte_wp_at'_def)
-  done
-
-lemma handleTimeout_Timeout_invs':
-  "\<lbrace>invs' and st_tcb_at' active' tptr\<rbrace>
-   handleTimeout tptr (Timeout badge)
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: handleTimeout_def)
-  apply (wpsimp wp: sendFaultIPC_invs' set_tcb'.getObject_wp' simp: isValidTimeoutHandler_def)
-  apply (clarsimp simp: valid_idle'_asrt_def)
-  apply (rule conjI; clarsimp simp: obj_at'_real_def projectKOs pred_tcb_at'_def)
-   apply (drule invs_iflive')
-   apply (erule (1) if_live_then_nonz_capD')
-   apply (fastforce simp: live_def)
-  apply (clarsimp simp: ko_wp_at'_def projectKOs opt_map_red)
-  apply (rule_tac x="0x40" in bexI)
-   apply (clarsimp simp: cte_wp_at_cases')
-   apply (drule_tac x="0x40" in spec)
-   apply (clarsimp simp: objBits_simps)
-   apply fastforce+
-  done
-
-lemma endTimeslice_invs'[wp]:
-  "\<lbrace>invs' and ct_active'\<rbrace>
-   endTimeslice timeout
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding endTimeslice_def
-  apply (wpsimp wp: handleTimeout_Timeout_invs' isValidTimeoutHandler_inv hoare_drop_imp)
-  apply (clarsimp simp: runnable_eq_active')
-  apply (frule (1) active_ex_cap'[OF _ invs_iflive'])
-  apply (clarsimp simp: ct_in_state'_def sch_act_sane_def)
-  done
-
-crunch setConsumedTime, updateSchedContext
-  for sch_act_sane[wp]: sch_act_sane
-  and ct_active'[wp]: ct_active'
-  (simp: sch_act_sane_def ct_in_state'_def ignore: setSchedContext)
-
-crunch refillResetRR, refillBudgetCheck
-  for ct_active'[wp]: ct_active'
-  and sch_act_sane[wp]: sch_act_sane
-  and ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' p"
-  and typ_at'[wp]: "\<lambda>s. Q (typ_at' P p s)"
-  and sc_at'_n[wp]: "\<lambda>s. Q (sc_at'_n n p s)"
-  (wp: crunch_wps)
-
-crunch chargeBudget
-  for typ_at'[wp]: "\<lambda>s. Q (typ_at' P p s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-end
-
-global_interpretation refillResetRR: typ_at_all_props' "refillResetRR scPtr"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
-
-lemma refillResetRR_invs'[wp]:
-  "refillResetRR scp \<lbrace>invs'\<rbrace>"
-  unfolding refillResetRR_def
-  apply (wpsimp wp: updateSchedContext_invs')
-  apply (intro conjI; clarsimp elim!: live_sc'_ex_cap[OF invs_iflive'])
-  by (fastforce dest!: valid_sc_strengthen[OF invs_valid_objs']
-                 simp: valid_sched_context'_def valid_sched_context_size'_def scBits_simps objBits_simps')
-
-lemmas refill_reset_rr_typ_ats [wp] =
-  abs_typ_at_lifts [OF refill_reset_rr_typ_at]
-
-crunch refillResetRR
-  for ksCurSc[wp]: "\<lambda>s. P (ksCurSc s)"
-
-crunch setConsumedTime, refillResetRR
-  for cur_tcb'[wp]: cur_tcb'
-  (simp: cur_tcb'_def)
-
-lemma chargeBudget_corres:
-  "corres dc
-     (invs and valid_list and valid_sched_action and active_scs_valid and valid_release_q
-      and valid_ready_qs and released_ipc_queues and cur_sc_active
-      and current_time_bounded and cur_sc_chargeable and scheduler_act_sane
-      and ct_not_queued and ct_not_in_release_q and ct_not_blocked
-      and cur_sc_offset_ready 0)
-     invs'
-     (charge_budget consumed canTimeout) (chargeBudget consumed canTimeout True)"
-  (is "corres _ (?pred and _ and cur_sc_offset_ready 0) _ _ _")
-  unfolding chargeBudget_def charge_budget_def ifM_def bind_assoc
-  apply (rule_tac Q="\<lambda>s. sc_at' (ksCurSc s) s" in corres_cross_add_guard)
-   apply clarsimp
-   apply (frule (1) cur_sc_tcb_sc_at_cur_sc[OF invs_valid_objs invs_cur_sc_tcb])
-   apply (drule state_relationD, clarsimp)
-   apply (erule sc_at_cross; fastforce simp: invs_def valid_state_def valid_pspace_def)
-  apply (rule_tac Q="\<lambda>s. is_active_sc' (ksCurSc s) s" in corres_cross_add_guard)
-   apply (fastforce intro: valid_objs_valid_sched_context_size
-                     simp: sc_at_pred_n_def obj_at_def is_sc_obj_def state_relation_def vs_all_heap_simps
-                    intro: is_active_sc'2_cross)
-  apply (rule_tac Q="\<lambda>s. sc_at (cur_sc s) s" in corres_cross_add_abs_guard)
-   apply (fastforce intro: cur_sc_tcb_sc_at_cur_sc)
-  apply add_cur_tcb'
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurSc_sp])
-   apply (corresKsimp corres: getCurSc_corres)
-  apply (rule corres_symb_exec_r[rotated, OF getIdleSC_sp]; wpsimp simp: getIdleSC_def)
-  apply (rule_tac F="idle_sc_ptr = idleSCPtr" in corres_req)
-   apply (clarsimp simp: state_relation_def)
-  apply (rule_tac Q="\<lambda>_. ?pred"
-              and Q'="\<lambda>_. invs' and cur_tcb'"
-               in corres_underlying_split)
-     apply (clarsimp simp: when_def split del: if_split)
-     apply (rule corres_if_split; (solves corresKsimp)?)
-     apply (rule corres_guard_imp)
-       apply (rule corres_split_eqr[OF isRoundRobin_corres])
-         apply (rule corres_split[OF corres_if2], simp)
-             apply (rule refillResetRR_corres)
-            apply (rule refillBudgetCheck_corres, simp)
-           apply (rule updateSchedContext_corres)
-             apply (fastforce simp: sc_relation_def obj_at'_def projectKOs obj_at_def is_sc_obj
-                                    opt_map_red opt_pred_def
-                             dest!: state_relation_sc_relation)
-            apply (fastforce simp: sc_relation_def obj_at'_def projectKOs obj_at_def is_sc_obj opt_map_red
-                            dest!: state_relation_sc_replies_relation elim: sc_replies_relation_prevs_list)
-           apply (clarsimp simp: objBits_simps)
-          apply (wpsimp wp: is_round_robin_wp isRoundRobin_wp)+
-      apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-      apply (drule (1) active_scs_validE, clarsimp)
-      apply (clarsimp simp: round_robin_def vs_all_heap_simps obj_at_def)
-     apply (clarsimp simp: obj_at'_def projectKOs invs'_def valid_pspace'_def elim!: valid_objs'_valid_refills')
-    apply (rule corres_guard_imp)
-      apply (rule corres_split[OF setConsumedTime_corres], simp)
-        apply (simp add: andM_def whenM_def ifM_def when_def[symmetric] bind_assoc)
-        apply (rule corres_split_eqr[OF getCurThread_corres _ gets_sp getCurThread_sp])
-        apply (rule corres_guard_imp)
-          apply (rule corres_split_eqr[OF isSchedulable_corres _ is_schedulable_sp' isSchedulable_sp])
-          apply (rename_tac sched)
-          apply (rule corres_guard_imp)
-            apply (rule corres_when2, simp)
-            apply (rule corres_split[OF endTimeslice_corres])
-              apply (rule corres_split[OF rescheduleRequired_corres])
-                apply (rule setReprogramTimer_corres)
-               apply wpsimp
-              apply wpsimp
-             apply (rule hoare_strengthen_post
-                              [where Q'="\<lambda>_. invs and active_scs_valid
-                                            and valid_sched_action", rotated])
-              apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_objs_valid_tcbs
-                                    valid_sched_action_def)
-             apply (wpsimp wp: end_timeslice_invs end_timeslice_valid_sched_action)
-            apply (rule hoare_strengthen_post[where Q'="\<lambda>_. invs'", rotated])
-             apply (clarsimp simp: invs'_def valid_pspace'_def)
-            apply wpsimp
-           apply simp+
-       apply wpsimp
-      apply (rule hoare_strengthen_post
-                     [where Q'="\<lambda>_. invs' and cur_tcb'", rotated])
-       apply (clarsimp simp: invs'_def valid_pspace'_def valid_objs'_valid_tcbs' cur_tcb'_def
-                             isSchedulable_bool_def runnable_eq_active' pred_map_def
-                             obj_at'_def projectKOs pred_tcb_at'_def ct_in_state'_def
-                      elim!: opt_mapE)
-      apply wpsimp
-     apply (clarsimp simp: schedulable_def2 ct_in_state_def runnable_eq_active current_time_bounded_def
-                           invs_def valid_state_def valid_pspace_def cur_tcb_def
-                           valid_objs_valid_tcbs state_refs_of_def
-                    dest!: cur_sc_chargeable_when_ct_active_sc)
-    apply clarsimp
-   apply wpsimp
-      apply (clarsimp simp: consumed_time_update_arch.state_refs_update sc_consumed_update_eq[symmetric])
-      apply ((wpsimp wp: hoare_vcg_conj_lift; (solves wpsimp)?
-             | strengthen valid_objs_valid_tcbs | wps)+)[1]
-     apply wpsimp
-      apply (wpsimp wp: sc_at_typ_at refill_reset_rr_valid_sched_action)
-     apply (wpsimp wp: sc_at_typ_at refill_reset_rr_valid_sched_action hoare_vcg_disj_lift
-                       refill_budget_check_valid_sched_action_act_not
-                       refill_budget_check_active_scs_valid
-                        refill_budget_check_valid_release_q
-                        refill_budget_check_valid_ready_qs_not_queued)
-     apply ((wpsimp wp: refill_budget_check_released_ipc_queues
-            | strengthen live_sc'_ex_cap[OF invs_iflive'] valid_sc_strengthen[OF invs_valid_objs'])+)[1]
-    apply (wpsimp wp: hoare_vcg_disj_lift)
-    apply (wpsimp wp: is_round_robin_wp isRoundRobin_wp)+
-   apply (rule conjI; clarsimp)
-   apply (prop_tac "sc_scheduler_act_not (cur_sc s) s")
-    apply (clarsimp simp: vs_all_heap_simps)
-    apply (clarsimp simp: cur_sc_chargeable_def)
-    apply (rotate_tac -1)
-    apply (drule_tac x=t in spec)
-    apply (prop_tac "heap_ref_eq (cur_sc s) t (tcb_scps_of s)")
-     apply (clarsimp simp: vs_all_heap_simps)
-    apply (simp only: scheduler_act_not_def, rule notI)
-    apply (drule (1) valid_sched_action_switch_thread_is_schedulable)
-    apply (clarsimp simp: is_schedulable_opt_def tcb_at_kh_simps[symmetric] pred_tcb_at_def obj_at_def
-                   split: option.split_asm dest!: get_tcb_SomeD)
-   apply (frule ct_not_blocked_cur_sc_not_blocked, clarsimp)
-   apply (rule conjI; clarsimp)
-    apply (drule (1) active_scs_validE, clarsimp)
-    apply (clarsimp simp: vs_all_heap_simps obj_at_def sc_refills_sc_at_def
-                          sc_valid_refills_def rr_valid_refills_def)
-   apply (clarsimp simp: vs_all_heap_simps)
-   apply (clarsimp simp: cur_sc_chargeable_def)
-   apply (rotate_tac -1)
-   apply (intro conjI; clarsimp?)
-    apply (drule_tac x=t in spec)
-    apply (prop_tac "heap_ref_eq (cur_sc s) t (tcb_scps_of s)")
-     apply (clarsimp simp: vs_all_heap_simps)
-    apply (clarsimp simp: valid_release_q_def)
-    apply (drule_tac x=t in bspec, simp add: in_queue_2_def)
-    apply (fastforce simp: tcb_at_kh_simps[symmetric] pred_tcb_at_def obj_at_def)
-   apply (drule_tac x=t in spec)
-   apply (prop_tac "heap_ref_eq (cur_sc s) t (tcb_scps_of s)")
-    apply (clarsimp simp: vs_all_heap_simps)
-   apply (clarsimp simp: valid_ready_qs_def in_ready_q_def)
-   apply (drule_tac x=d and y=p in spec2, clarsimp)
-   apply (drule_tac x=t in bspec, simp)
-   apply clarsimp
-   apply (clarsimp simp: tcb_at_kh_simps[symmetric] pred_tcb_at_def obj_at_def)
-   apply (drule_tac x=d and y=p in spec2)
-   apply fastforce
-  apply (wpsimp wp: updateSchedContext_invs')
-     apply (wpsimp wp: typ_at_lifts
-           | strengthen live_sc'_ex_cap[OF invs_iflive'] valid_sc_strengthen[OF invs_valid_objs'])+
-  done
-
-lemma checkBudget_corres: (* called when ct_schedulable or in checkBudgetRestart *)
-  "corres (=)
-     (einvs and current_time_bounded and cur_sc_offset_ready 0 and cur_sc_chargeable
-      and cur_sc_active and ct_not_blocked
-      and ct_not_queued and ct_not_in_release_q and scheduler_act_sane)
-     invs'
-     check_budget checkBudget"
-  unfolding check_budget_def checkBudget_def
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_eqr[OF getCurSc_corres])
-      apply (rule corres_split_eqr[OF getConsumedTime_corres])
-        apply (rule corres_split_eqr[OF refillSufficient_corres], simp)
-          apply (rule corres_if2, simp)
-           apply (rule corres_split_eqr[OF isCurDomainExpired_corres])
-             apply simp
-            apply wpsimp+
-          apply (rule corres_split_eqr[OF getConsumedTime_corres])
-            apply (rule corres_split[OF chargeBudget_corres])
-              apply simp
-             apply (wpsimp wp: hoare_drop_imp)+
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-   apply (clarsimp simp: sc_refills_sc_at_def obj_at_def cur_sc_tcb_def sc_tcb_sc_at_def valid_sched_def)
-   apply (drule (1) active_scs_validE[rotated])
-   apply (clarsimp simp: valid_refills_def vs_all_heap_simps rr_valid_refills_def
-                  split: if_split_asm)
-  apply clarsimp
-  done
-
 lemma handleYield_corres:
   "corres dc
-     (einvs and ct_active and cur_sc_active and schact_is_rct and scheduler_act_sane
-      and current_time_bounded and cur_sc_offset_ready 0
-      and ct_not_queued and ct_not_in_release_q)
-     invs'
+     (einvs and ct_active)
+     (invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
      handle_yield handleYield"
-  (is "corres _ ?pre ?pre' _ _")
-  apply (rule_tac Q=ct_active' in corres_cross_add_guard)
-   apply (fastforce intro!: ct_active_cross simp: invs_def valid_state_def valid_pspace_def)
-  apply (rule_tac Q="\<lambda>s. sc_at' (ksCurSc s) s" in corres_cross_add_guard)
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
-                  dest!: state_relationD schact_is_rct)
-   apply (erule (2) sc_at_cross)
-   apply (fastforce simp: cur_sc_tcb_def sc_tcb_sc_at_def obj_at_def is_sc_obj
-                    dest: valid_sched_context_size_objsI)
   apply (clarsimp simp: handle_yield_def handleYield_def)
   apply (rule corres_guard_imp)
-    apply (rule corres_split_eqr[OF getCurSc_corres])
-      apply (rule corres_split[OF get_sc_corres])
-        apply (erule exE)
-        apply (rename_tac cursc sc sc' n)
-        apply (rule_tac P="(\<lambda>s. scs_of2 s cursc = Some sc) and ?pre
-                            and (\<lambda>s. cur_sc s = cursc)"
-                   and P'="?pre' and ko_at' sc' cursc"
-               in corres_inst)
-        apply (rule_tac Q="\<lambda>rv. (\<lambda>s. scs_of2 s cursc = Some sc) and ?pre
-                                and (\<lambda>s. cur_sc s = cursc) and K (sc_refills sc = rv)"
-                   and P'="?pre' and ko_at' sc' cursc"
-               in corres_symb_exec_l)
-           apply (rename_tac refills)
-           apply (rule corres_gen_asm')
-           apply (rule_tac F="r_amount (hd refills) = rAmount (refillHd sc')" in corres_req)
-            apply (clarsimp dest!: invs_valid_objs' invs_valid_objs simp: obj_at_def obj_at'_def projectKOs
-                            split: Structures_A.kernel_object.splits elim!: opt_mapE)
-            apply (erule (1) valid_objsE', clarsimp simp: valid_obj'_def)
-            apply (frule (1) refill_hd_relation2[rotated -1])
-             apply (drule (1) active_scs_validE[OF _ valid_sched_active_scs_valid])
-             apply (clarsimp simp: valid_refills_def vs_all_heap_simps rr_valid_refills_def
-                            split: if_split_asm)
-            apply clarsimp
-           apply simp
-           apply (rule corres_guard_imp)
-             apply (rule corres_split[OF chargeBudget_corres])
-               apply (rule updateSchedContext_corres)
-                 apply clarsimp
-                 apply (drule (2) state_relation_sc_relation)
-                 apply (clarsimp simp: sc_relation_def obj_at_simps is_sc_obj opt_map_red opt_pred_def)
-                apply clarsimp
-                apply (frule (2) state_relation_sc_relation)
-                apply (drule state_relation_sc_replies_relation)
-                apply (fastforce simp: sc_relation_def obj_at_simps is_sc_obj opt_map_red
-                                 elim: sc_replies_relation_prevs_list)
-               apply (clarsimp simp: objBits_simps)
-              apply (rule sc_at_typ_at, wp)
-             apply (wpsimp wp: typ_at_lifts)
-            apply (clarsimp simp: valid_sched_def opt_map_def obj_at_def is_sc_obj
-                           split: option.split_asm Structures_A.kernel_object.split_asm)
-            apply (frule (1) valid_sched_context_size_objsI[OF invs_valid_objs], clarsimp)
-            apply (frule (1) invs_cur_sc_chargeableE)
-            apply fastforce
-           apply clarsimp
-          apply wpsimp
-           apply (fastforce intro: cur_sc_tcb_sc_at_cur_sc)
-          apply simp
-         apply (wpsimp wp: get_refills_wp)
-         apply (clarsimp simp: obj_at_def is_sc_obj elim!: opt_mapE)
-        apply (wpsimp simp: get_refills_def split: Structures_A.kernel_object.splits)
-        apply (fastforce simp: obj_at_def cur_sc_tcb_def sc_tcb_sc_at_def
-                        dest!: invs_cur_sc_tcb)
-       apply wpsimp+
-   apply (frule invs_valid_objs)
-   apply (fastforce simp: obj_at_def is_sc_obj cur_sc_tcb_def sc_tcb_sc_at_def opt_map_red
-                   dest!: invs_cur_sc_tcb schact_is_rct elim: valid_sched_context_size_objsI)
-  apply clarsimp
+    apply (rule corres_split[OF getCurThread_corres])
+      apply simp
+      apply (rule corres_split[OF tcbSchedDequeue_corres], simp)
+        apply (rule corres_split[OF tcbSchedAppend_corres], simp)
+          apply (rule rescheduleRequired_corres)
+         apply (wpsimp wp: weak_sch_act_wf_lift_linear
+                | 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)
+  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
+
+lemma tcbSchedAppend_ct_in_state'[wp]:
+  "tcbSchedAppend t \<lbrace>ct_in_state' test\<rbrace>"
+  apply (simp add: ct_in_state'_def)
+  apply (rule hoare_lift_Pf [where f=ksCurThread]; wp)
   done
 
-lemma chargeBudget_invs'[wp]:
-  "chargeBudget consumed canTimeout Flag \<lbrace>invs'\<rbrace>"
-  unfolding chargeBudget_def ifM_def bind_assoc
-  apply (rule bind_wp[OF _ getCurSc_sp])
-  apply (wpsimp wp: isSchedulable_wp)
-     apply (rule hoare_strengthen_post[where Q'="\<lambda>_. invs'"])
-      apply wpsimp
-     apply (clarsimp simp: isSchedulable_bool_def obj_at'_def projectKOs
-                           pred_map_def ct_in_state'_def pred_tcb_at'_def runnable_eq_active'
-                    elim!: opt_mapE)
-  by (wpsimp wp: hoare_drop_imp updateSchedContext_invs'
-      | strengthen live_sc'_ex_cap[OF invs_iflive'] valid_sc_strengthen[OF invs_valid_objs'])+
-
 lemma hy_invs':
-  "handleYield \<lbrace>invs'\<rbrace>"
+  "\<lbrace>invs' and ct_active'\<rbrace> handleYield \<lbrace>\<lambda>r. invs' and ct_active'\<rbrace>"
   apply (simp add: handleYield_def)
-  by (wpsimp wp: updateSchedContext_invs' ct_in_state_thread_state_lift'
-    | strengthen live_sc'_ex_cap[OF invs_iflive'] valid_sc_strengthen[OF invs_valid_objs'])+
+  apply (wpsimp wp: ct_in_state_thread_state_lift' rescheduleRequired_all_invs_but_ct_not_inQ)
+     apply (rule_tac Q'="\<lambda>_. all_invs_but_ct_not_inQ' and ct_active'" in hoare_post_imp)
+      apply clarsimp
+     apply (subst pred_conj_def)
+     apply (rule hoare_vcg_conj_lift)
+      apply (rule tcbSchedAppend_all_invs_but_ct_not_inQ')
+     apply wpsimp
+    apply wpsimp
+   apply wpsimp
+  apply (simp add:ct_active_runnable'[unfolded ct_in_state'_def])
+  done
 
 lemma getDFSR_invs'[wp]:
   "valid invs' (doMachineOp getDFSR) (\<lambda>_. invs')"
@@ -2281,46 +1671,118 @@ lemma simple_from_running':
   by (clarsimp elim!: pred_tcb'_weakenE
                simp: ct_in_state'_def)+
 
+lemma handleReply_corres:
+  "corres dc (einvs and ct_running) (invs' and ct_running')
+         handle_reply handleReply"
+  apply (simp add: handle_reply_def handleReply_def
+                   getThreadCallerSlot_map
+                   getSlotCap_def)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split_eqr[OF getCurThread_corres])
+      apply (rule corres_split[OF get_cap_corres])
+        apply (rule_tac P="einvs and cte_wp_at ((=) caller_cap) (thread, tcb_cnode_index 3)
+                                and K (is_reply_cap caller_cap \<or> caller_cap = cap.NullCap)
+                                and tcb_at thread and st_tcb_at active thread
+                                and valid_cap caller_cap"
+                    and P'="invs' and tcb_at' thread
+                              and valid_cap' (cteCap rv')
+                              and cte_at' (cte_map (thread, tcb_cnode_index 3))"
+                    in corres_inst)
+        apply (auto split: cap_relation_split_asm arch_cap.split_asm bool.split
+                   intro!: corres_guard_imp [OF deleteCallerCap_corres]
+                           corres_guard_imp [OF doReplyTransfer_corres]
+                           corres_fail
+                     simp: valid_cap_def valid_cap'_def is_cap_simps assert_def is_reply_cap_to_def)[1]
+        apply (fastforce simp: invs_def valid_state_def
+                              cte_wp_at_caps_of_state st_tcb_def2
+                        dest: valid_reply_caps_of_stateD)
+       apply (wp get_cap_cte_wp_at get_cap_wp | simp add: cte_wp_at_eq_simp)+
+   apply (intro conjI impI allI,
+          (fastforce simp: invs_def valid_state_def
+                   intro: tcb_at_cte_at)+)
+      apply (clarsimp, frule tcb_at_invs)
+      apply (fastforce dest: tcb_caller_cap simp: cte_wp_at_def)
+     apply clarsimp
+    apply (clarsimp simp: ct_in_state_def elim!: st_tcb_weakenE)
+   apply (fastforce intro: cte_wp_valid_cap elim: cte_wp_at_weakenE)
+  apply (fastforce intro: tcb_at_cte_at_map)
+  done
 
-crunch cteDeleteOne
- for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps
-   simp: crunch_simps unless_def)
+lemma hr_invs'[wp]:
+  "\<lbrace>invs' and sch_act_simple\<rbrace> handleReply \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: handleReply_def getSlotCap_def
+                   getThreadCallerSlot_map getCurThread_def)
+  apply (wp getCTE_wp | wpc | simp)+
+  apply (clarsimp simp: cte_wp_at_ctes_of)
+  apply (drule ctes_of_valid', clarsimp+)
+  apply (simp add: valid_cap'_def)
+  apply (simp add: invs'_def cur_tcb'_def)
+  done
+
+crunch handleReply
+  for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
+  (wp: crunch_wps transferCapsToSlots_pres1 setObject_ep_ct
+       setObject_ntfn_ct
+        simp: unless_def crunch_simps
+   ignore: transferCapsToSlots)
 
 lemmas cteDeleteOne_st_tcb_at_simple'[wp] =
     cteDeleteOne_st_tcb_at[where P=simple', simplified]
 
+crunch handleReply
+  for st_tcb_at_simple'[wp]: "st_tcb_at' simple' t'"
+  (wp: hoare_TrueI crunch_wps sts_st_tcb_at'_cases
+       threadSet_pred_tcb_no_state
+     ignore: setThreadState)
+
+lemmas handleReply_ct_in_state_simple[wp] =
+    ct_in_state_thread_state_lift' [OF handleReply_ksCurThread
+                                     handleReply_st_tcb_at_simple']
+
+
+(* FIXME: move *)
+lemma doReplyTransfer_st_tcb_at_active:
+  "\<lbrace>st_tcb_at' active' t and tcb_at' t' and K (t \<noteq> t') and
+    cte_wp_at' (\<lambda>cte. cteCap cte = (capability.ReplyCap t' False g)) sl\<rbrace>
+    doReplyTransfer t t' sl g
+   \<lbrace>\<lambda>rv. st_tcb_at' active' t\<rbrace>"
+  apply (simp add: doReplyTransfer_def liftM_def)
+  apply (wp setThreadState_st_tcb sts_pred_tcb_neq' cteDeleteOne_reply_pred_tcb_at
+            hoare_drop_imps threadSet_pred_tcb_no_state hoare_exI
+            doIPCTransfer_non_null_cte_wp_at2' | wpc | clarsimp simp:isCap_simps)+
+  apply (fastforce)
+  done
+
+lemma hr_ct_active'[wp]:
+  "\<lbrace>invs' and ct_active'\<rbrace> handleReply \<lbrace>\<lambda>rv. ct_active'\<rbrace>"
+  apply (simp add: handleReply_def getSlotCap_def getCurThread_def
+                   getThreadCallerSlot_def locateSlot_conv)
+  apply (rule bind_wp, rename_tac cur_thread)
+   apply (rule_tac t=cur_thread in ct_in_state'_decomp)
+    apply (wpsimp wp: getCTE_wp)
+    apply (fastforce simp: cte_wp_at_ctes_of)
+   apply (wpsimp wp: getCTE_wp doReplyTransfer_st_tcb_at_active)+
+  apply (fastforce simp: ct_in_state'_def cte_wp_at_ctes_of valid_cap'_def
+                   dest: ctes_of_valid')
+  done
+
 lemma handleCall_corres:
-  "corres (dc \<oplus> dc) (einvs and valid_machine_time and schact_is_rct and ct_active
-                     and ct_released and (\<lambda>s. active_sc_tcb_at (cur_thread s) s)
-                     and ct_not_in_release_q and cur_sc_active and current_time_bounded
-                     and consumed_time_bounded
-                     and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-                     and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s))
+  "corres (dc \<oplus> dc) (einvs and schact_is_rct and ct_active)
               (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
                 (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
                 ct_active')
          handle_call handleCall"
-  apply add_cur_tcb'
-  apply (simp add: handle_call_def handleCall_def liftE_bindE handleInvocation_corres)
-  apply (rule corres_stateAssertE_add_assertion[rotated])
-   apply (clarsimp simp: cur_tcb'_asrt_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getCapReg_corres])
-      apply (simp, rule handleInvocation_corres; simp)
-     apply wpsimp+
-  done
+  by (simp add: handle_call_def handleCall_def liftE_bindE handleInvocation_corres)
 
 lemma hc_invs'[wp]:
   "\<lbrace>invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
       (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
-      ct_isSchedulable\<rbrace>
-   handleCall
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (clarsimp simp: handleCall_def)
-  apply (rule validE_valid)
-  apply (rule bindE_wp[OF _ stateAssertE_sp])
-  apply wpsimp
+      ct_active'\<rbrace>
+     handleCall
+   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: handleCall_def)
+  apply (wp)
+  apply (clarsimp)
   done
 
 lemma cteInsert_sane[wp]:
@@ -2330,13 +1792,84 @@ lemma cteInsert_sane[wp]:
             hoare_convert_imp [OF cteInsert_nosch cteInsert_ct])
   done
 
-crunch setExtraBadge, transferCaps, handleFaultReply, doIPCTransfer
-  for sch_act_sane [wp]: sch_act_sane
-  (wp: crunch_wps simp: crunch_simps)
+crunch setExtraBadge
+  for sane[wp]: sch_act_sane
+
+crunch transferCaps
+  for sane[wp]: "sch_act_sane"
+  (wp: transferCapsToSlots_pres1 crunch_wps
+   simp: crunch_simps
+   ignore: transferCapsToSlots)
+
+lemma possibleSwitchTo_sane:
+  "\<lbrace>\<lambda>s. sch_act_sane s \<and> t \<noteq> ksCurThread s\<rbrace> possibleSwitchTo t \<lbrace>\<lambda>_. sch_act_sane\<rbrace>"
+  apply (simp add: possibleSwitchTo_def setSchedulerAction_def curDomain_def
+              cong: if_cong)
+  apply (wp hoare_drop_imps | wpc)+
+  apply (simp add: sch_act_sane_def)
+  done
+
+crunch handleFaultReply
+  for sane[wp]: sch_act_sane
+  (  wp: threadGet_inv hoare_drop_imps crunch_wps
+   simp: crunch_simps
+   ignore: setSchedulerAction)
+
+crunch doIPCTransfer
+  for sane[wp]: sch_act_sane
+  (  wp: threadGet_inv hoare_drop_imps crunch_wps
+   simp: crunch_simps
+   ignore: setSchedulerAction)
+
+lemma doReplyTransfer_sane:
+  "\<lbrace>\<lambda>s. sch_act_sane s \<and> t' \<noteq> ksCurThread s\<rbrace>
+  doReplyTransfer t t' callerSlot g \<lbrace>\<lambda>rv. sch_act_sane\<rbrace>"
+  apply (simp add: doReplyTransfer_def liftM_def)
+  apply (wp possibleSwitchTo_sane hoare_drop_imps hoare_vcg_all_lift|wpc)+
+  apply simp
+  done
+
+lemma handleReply_sane:
+  "\<lbrace>sch_act_sane\<rbrace> handleReply \<lbrace>\<lambda>rv. sch_act_sane\<rbrace>"
+  apply (simp add: handleReply_def getSlotCap_def getThreadCallerSlot_def locateSlot_conv)
+  apply (rule hoare_pre)
+   apply (wp doReplyTransfer_sane getCTE_wp'| wpc)+
+  apply (clarsimp simp: cte_wp_at_ctes_of)
+  done
+
+lemma handleReply_nonz_cap_to_ct:
+  "\<lbrace>ct_active' and invs' and sch_act_simple\<rbrace>
+     handleReply
+   \<lbrace>\<lambda>rv s. ex_nonz_cap_to' (ksCurThread s) s\<rbrace>"
+  apply (rule_tac Q'="\<lambda>rv. ct_active' and invs'"
+               in hoare_post_imp)
+   apply (auto simp: ct_in_state'_def elim: st_tcb_ex_cap'')[1]
+  apply (wp | simp)+
+  done
 
 crunch handleFaultReply
   for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s p)"
 
+crunch possible_switch_to, 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))
+         (do x \<leftarrow> handle_reply; handle_recv True od)
+         (do x \<leftarrow> handleReply; handleRecv True od)"
+  apply (rule corres_guard_imp)
+    apply (rule corres_split_nor[OF handleReply_corres])
+      apply (rule handleRecv_isBlocking_corres')
+     apply (wp handle_reply_nonz_cap_to_ct handleReply_sane
+               handleReply_nonz_cap_to_ct handle_reply_valid_sched)+
+   apply (fastforce simp: ct_in_state_def ct_in_state'_def simple_sane_strg
+                    elim!: st_tcb_weakenE st_tcb_ex_cap')
+  apply (clarsimp simp: ct_in_state'_def)
+  apply (fastforce elim: pred_tcb'_weakenE)
+  done
+
 lemma handleHypervisorFault_corres:
   "corres dc (einvs and  st_tcb_at active thread and ex_nonz_cap_to thread
                    and (%_. valid_fault f))
@@ -2347,6 +1880,108 @@ lemma handleHypervisorFault_corres:
   apply (cases fault; clarsimp simp add: handleHypervisorFault_def returnOk_def2)
   done
 
+(* FIXME: move *)
+lemma handleEvent_corres:
+  "corres (dc \<oplus> dc) (einvs and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running s) and
+                       schact_is_rct)
+                      (invs' and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running' s) and
+                       (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
+                       (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
+                      (handle_event event) (handleEvent event)"
+  (is "?handleEvent_corres")
+proof -
+  have hw:
+    "\<And>isBlocking. corres dc (einvs and ct_running and schact_is_rct)
+               (invs' and ct_running'
+                      and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
+               (handle_recv isBlocking) (handleRecv isBlocking)"
+    apply (rule corres_guard_imp [OF handleRecv_isBlocking_corres])
+     apply (clarsimp simp: ct_in_state_def ct_in_state'_def
+                     elim!: st_tcb_weakenE pred_tcb'_weakenE)+
+    done
+    show ?thesis
+      apply (case_tac event)
+           apply (simp_all add: handleEvent_def)
+
+           apply (rename_tac syscall)
+           apply (case_tac syscall)
+                  apply (auto intro: corres_guard_imp[OF handleSend_corres]
+                                     corres_guard_imp[OF hw]
+                                     corres_guard_imp [OF handleReply_corres]
+                                     corres_guard_imp[OF handleReply_handleRecv_corres]
+                                     corres_guard_imp[OF handleCall_corres]
+                                     corres_guard_imp[OF handleYield_corres]
+                                     active_from_running active_from_running'
+                              simp: simple_sane_strg schact_is_rct_def)[8]
+          apply (rule corres_underlying_split)
+             apply (rule corres_guard_imp[OF getCurThread_corres], simp+)
+            apply (rule handleFault_corres)
+            apply simp
+           apply (simp add: valid_fault_def)
+           apply wp
+           apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE
+                            simp: ct_in_state_def)
+          apply wp
+          apply (clarsimp)
+          apply (auto simp: ct_in_state'_def sch_act_simple_def
+                            sch_act_sane_def
+                      elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
+         apply (rule corres_underlying_split)
+            apply (rule corres_guard_imp, rule getCurThread_corres, simp+)
+           apply (rule handleFault_corres)
+           apply (simp add: valid_fault_def)
+          apply wp
+          apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE
+                           simp: ct_in_state_def valid_fault_def)
+         apply wp
+         apply clarsimp
+         apply (auto simp: ct_in_state'_def sch_act_simple_def
+                           sch_act_sane_def
+                     elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
+        apply (rule corres_guard_imp)
+          apply (rule corres_split_eqr[where R="\<lambda>_. einvs"
+                                       and R'="\<lambda>rv s. \<forall>x. rv = Some x \<longrightarrow> R'' x s"
+                                       for R''])
+             apply (rule corres_machine_op)
+             apply (rule corres_Id, simp+)
+             apply wp
+            apply (case_tac rv, simp_all add: doMachineOp_return)[1]
+            apply (rule handleInterrupt_corres)
+           apply (wp hoare_vcg_all_lift
+                     doMachineOp_getActiveIRQ_IRQ_active'
+                    | simp add: imp_conjR | wp (once) hoare_drop_imps)+
+        apply (simp add: invs'_def valid_state'_def)
+       apply (rule_tac corres_underlying_split)
+          apply (rule corres_guard_imp, rule getCurThread_corres, simp+)
+         apply (rule corres_split_catch)
+            apply (rule handleVMFault_corres)
+           apply (erule handleFault_corres)
+          apply (rule hoare_elim_pred_conjE2)
+          apply (rule hoare_vcg_conj_liftE_E, rule valid_validE_E, wp)
+          apply (wp handle_vm_fault_valid_fault)
+         apply (rule hv_inv_ex')
+        apply wp
+        apply (clarsimp simp: simple_from_running tcb_at_invs)
+        apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
+       apply wp
+       apply (clarsimp)
+       apply (fastforce simp: simple_sane_strg sch_act_simple_def ct_in_state'_def
+                   elim: st_tcb_ex_cap'' pred_tcb'_weakenE)
+      apply (rule corres_underlying_split)
+         apply (rule corres_guard_imp[OF getCurThread_corres], simp+)
+        apply (rule handleHypervisorFault_corres)
+       apply (simp add: valid_fault_def)
+       apply wp
+       apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE
+                        simp: ct_in_state_def)
+      apply wp
+      apply (clarsimp)
+      apply (auto simp: ct_in_state'_def sch_act_simple_def
+                        sch_act_sane_def
+                  elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1]
+      done
+  qed
+
 crunch handleVMFault,handleHypervisorFault
   for st_tcb_at'[wp]: "st_tcb_at' P t"
   and cap_to'[wp]: "ex_nonz_cap_to' t"
@@ -2385,601 +2020,81 @@ proof
 qed
 
 lemma ct_running_not_idle'[simp]:
-  "\<lbrakk>valid_idle' s; ct_running' s\<rbrakk> \<Longrightarrow> ksCurThread s \<noteq> ksIdleThread s"
+  "\<lbrakk>invs' s; ct_running' s\<rbrakk> \<Longrightarrow> ksCurThread s \<noteq> ksIdleThread s"
   apply (rule ct_not_idle')
-   apply (fastforce simp: ct_in_state'_def
+   apply (fastforce simp: invs'_def valid_state'_def ct_in_state'_def
                    elim: pred_tcb'_weakenE)+
   done
 
 lemma ct_active_not_idle'[simp]:
-  "\<lbrakk>valid_idle' s; ct_active' s\<rbrakk> \<Longrightarrow> ksCurThread s \<noteq> ksIdleThread s"
+  "\<lbrakk>invs' s; ct_active' s\<rbrakk> \<Longrightarrow> ksCurThread s \<noteq> ksIdleThread s"
   apply (rule ct_not_idle')
-   apply (fastforce simp: ct_in_state'_def
+   apply (fastforce simp: invs'_def valid_state'_def ct_in_state'_def
                    elim: pred_tcb'_weakenE)+
   done
 
 crunch handleFault, receiveSignal, receiveIPC, asUser
   for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps hoare_vcg_all_lift simp: crunch_simps)
-
-lemma checkBudget_true:
-  "\<lbrace>P\<rbrace> checkBudget \<lbrace>\<lambda>rv s. rv \<longrightarrow> P s\<rbrace>"
-  unfolding checkBudget_def
-  by (wpsimp | rule hoare_drop_imp)+
-
-lemma checkBudgetRestart_true:
-  "\<lbrace>P\<rbrace> checkBudgetRestart \<lbrace>\<lambda>rv s. rv \<longrightarrow> P s\<rbrace>"
-  unfolding checkBudgetRestart_def
-  apply (wpsimp wp: checkBudget_true)
-   apply (rule hoare_drop_imp)
-   apply (wpsimp wp: checkBudget_true)
-  by clarsimp
-
-lemma checkBudgetRestart_false:
-  "\<lbrace>P\<rbrace> checkBudgetRestart \<lbrace>\<lambda>rv s. Q s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> checkBudgetRestart \<lbrace>\<lambda>rv s. \<not> rv \<longrightarrow> Q s\<rbrace>"
-  by (wpsimp wp: hoare_drop_imp)
-
-crunch checkBudget
-  for invs'[wp]: invs'
-
-lemma checkBudgetRestart_invs'[wp]:
-  "checkBudgetRestart \<lbrace>invs'\<rbrace>"
-  unfolding checkBudgetRestart_def
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: setThreadState_Restart_invs')
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def)
-  apply (intro conjI)
-    apply (erule ko_wp_at'_weakenE, clarsimp)
-   apply (drule invs_iflive')
-   apply (erule (1) if_live_then_nonz_capD')
-  by (fastforce simp: live_def ko_wp_at'_def projectKOs opt_map_red is_BlockedOnReply_def)+
-
-lemma setEndpoint_valid_duplicates'[wp]:
-  "setObject a (ep::endpoint) \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (clarsimp simp: setObject_def split_def valid_def in_monad
-                        projectKOs pspace_aligned'_def ps_clear_upd
-                        objBits_def[symmetric] lookupAround2_char1
-                 split: if_split_asm)
-  apply (frule pspace_storable_class.updateObject_type[where v = ep,simplified])
-  apply (clarsimp simp: updateObject_default_def assert_def bind_def
-                        alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
-                        assert_opt_def return_def fail_def typeError_def
-                 split: if_splits option.splits Structures_H.kernel_object.splits)
-     apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+
-  done
-
-lemma setSchedContext_valid_duplicates'[wp]:
-  "setObject a (sc::sched_context) \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (clarsimp simp: setObject_def split_def valid_def in_monad
-                        projectKOs pspace_aligned'_def ps_clear_upd
-                        objBits_def[symmetric] lookupAround2_char1
-                 split: if_split_asm)
-  apply (frule pspace_storable_class.updateObject_type[where v = sc,simplified])
-  apply (clarsimp simp: updateObject_default_def assert_def bind_def
-                        alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
-                        assert_opt_def return_def fail_def typeError_def
-                 split: if_splits option.splits Structures_H.kernel_object.splits)
-     apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+
-  done
-
-lemma setReply_valid_duplicates'[wp]:
-  "setObject a (r::reply) \<lbrace>\<lambda>s. vs_valid_duplicates' (ksPSpace s)\<rbrace>"
-  apply (clarsimp simp: setObject_def split_def valid_def in_monad
-                        projectKOs pspace_aligned'_def ps_clear_upd
-                        objBits_def[symmetric] lookupAround2_char1
-                 split: if_split_asm)
-  apply (frule pspace_storable_class.updateObject_type[where v = r,simplified])
-  apply (clarsimp simp: updateObject_default_def assert_def bind_def
-                        alignCheck_def in_monad when_def alignError_def magnitudeCheck_def
-                        assert_opt_def return_def fail_def typeError_def
-                 split: if_splits option.splits Structures_H.kernel_object.splits)
-     apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+
-  done
-
-crunch check_budget
-  for cur_tcb[wp]: cur_tcb
-  and pspace_aligned[wp]: pspace_aligned
-  and pspace_distinct[wp]: pspace_distinct
-  (wp: crunch_wps simp: crunch_simps)
-
-crunch checkBudgetRestart
-  for valid_duplicates''[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma getCurrentTime_invs'[wp]:
-  "doMachineOp getCurrentTime \<lbrace>invs'\<rbrace>"
-  apply (simp add: getCurrentTime_def modify_def)
-  apply (wpsimp wp: dmo_invs' simp: modify_def)
-  by (simp add: in_get put_def gets_def in_bind in_return)
-
-lemma invs'_ksCurTime_update[iff]:
-  "invs' (ksCurTime_update f s) = invs' s"
-  by (clarsimp simp: invs'_def valid_pspace'_def valid_mdb'_def
-                     valid_queues_def valid_queues_no_bitmap_def valid_bitmapQ_def bitmapQ_def
-                     bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def valid_irq_node'_def
-                     valid_machine_state'_def valid_queues'_def valid_release_queue_def
-                     valid_release_queue'_def valid_dom_schedule'_def)
-
-crunch setDomainTime, setCurTime, setConsumedTime, setExtraBadge, setReleaseQueue, setQueue,
-  modifyReadyQueuesL1Bitmap, modifyReadyQueuesL2Bitmap, setReprogramTimer
-  for ct_in_state'[wp]: "ct_in_state' P"
-  and isSchedulable[wp]: "isSchedulable_bool p"
-  and scs_of'_ct[wp]: "\<lambda>s. P (scs_of' s) (ksCurThread s)"
-  and isScActive_ct[wp]: "\<lambda>s. P (isScActive p s) (tcbSCs_of s) (ksCurThread s)"
-  and pred_map_sc_active_ct[wp]: "\<lambda>s. pred_map (\<lambda>p. isScActive p s) (tcbSCs_of s) (ksCurThread s)"
-  (simp: ct_in_state'_def isScActive_def isSchedulable_bool_def)
-
-crunch updateTimeStamp, tcbSchedAppend, postpone
-  for invs'[wp]: invs'
-  and ct_in_state'[wp]: "ct_in_state' P"
-  and ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  and valid_duplicates''[wp]: "\<lambda>s. vs_valid_duplicates' (ksPSpace s)"
-  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
-  (ignore: doMachineOp wp: crunch_wps)
-
-crunch updateTimeStamp
-  for tcbSCs_of_scTCBs_of[wp]: "\<lambda>s. P (tcbSCs_of s) (scTCBs_of s)"
-  and tcbs_of'_ct[wp]: "\<lambda>s. P (tcbs_of' s) (ksCurThread s)"
-  and tcbSCs_of_ct[wp]: "\<lambda>s. P (tcbSCs_of s) (ksCurThread s)"
-  and isScActive_ct[wp]: "\<lambda>s. P (isScActive p s) (tcbSCs_of s) (ksCurThread s)"
-  and pred_map_sc_active_ct[wp]: "\<lambda>s. pred_map (\<lambda>p. isScActive p s) (tcbSCs_of s) (ksCurThread s)"
-  and typ_at[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and pred_tcb_at'[wp]: "\<lambda>s. P (pred_tcb_at' proj Q p s)"
-
-lemma installThreadBuffer_ksCurThread[wp]:
-  "installThreadBuffer target slot buffer \<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> "
-  unfolding installThreadBuffer_def
-  by (wpsimp wp: checkCap_inv hoare_drop_imp cteDelete_preservation)
-
-crunch ARM_H.performInvocation
-  for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (simp: crunch_simps wp: crunch_wps getObject_inv)
-
-crunch resetUntypedCap
-  for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (simp: crunch_simps wp: mapME_x_inv_wp preemptionPoint_inv crunch_wps)
-
-crunch performInvocation
-  for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps cteRevoke_preservation filterM_preserved cteDelete_preservation
-       hoare_drop_imps hoare_vcg_all_lift
-   simp: crunch_simps)
+  (wp: hoare_drop_imps crunch_wps simp: crunch_simps)
 
 lemma he_invs'[wp]:
   "\<lbrace>invs' and
       (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running' s) and
-      (\<lambda>s. ct_running' s \<longrightarrow> ct_isSchedulable s) and
       (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
       (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)\<rbrace>
    handleEvent event
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
 proof -
-  have nidle: "\<And>s. valid_idle' s \<and> ct_active' s \<longrightarrow> ksCurThread s \<noteq> ksIdleThread s"
+  have nidle: "\<And>s. invs' s \<and> ct_active' s \<longrightarrow> ksCurThread s \<noteq> ksIdleThread s"
     by (clarsimp)
   show ?thesis
     apply (case_tac event, simp_all add: handleEvent_def)
-         apply (rename_tac syscall)
-         apply (case_tac syscall,
-                (wpsimp wp: checkBudgetRestart_true checkBudgetRestart_false hoare_vcg_if_lift2
-                 | clarsimp simp: active_from_running' simple_from_running' simple_sane_strg
-                                  stateAssertE_def stateAssert_def
-                        simp del: split_paired_All
-                 | rule hoare_strengthen_postE_R[where Q'="\<lambda>_. invs'", rotated],
-                   clarsimp simp: ct_active'_asrt_def
-                 | rule conjI active_ex_cap'
-                 | drule ct_not_ksQ[rotated]
-                 | strengthen nidle)+)
-                  apply (rule hoare_strengthen_post,
-                         rule hoare_weaken_pre,
-                         rule hy_invs')
-                   apply (simp add: active_from_running')
-                  apply simp
-                 apply (wp hv_inv' hh_inv' hoare_vcg_if_lift2 checkBudgetRestart_true checkBudgetRestart_false
-                           updateTimeStamp_ct_in_state'[simplified ct_in_state'_def]
-                        | strengthen active_ex_cap'[OF _ invs_iflive']
-                        | clarsimp simp: ct_in_state'_def
-                        | wpc)+
-    done
-qed
-
-lemma released_imp_active_sc_tcb_at:
-  "released_sc_tcb_at t s \<Longrightarrow> active_sc_tcb_at t s"
-  by (clarsimp simp: vs_all_heap_simps)
-
-lemma checkBudgetRestart_corres:
-  "corres (=)
-     (einvs and current_time_bounded and cur_sc_offset_ready 0
-      and cur_sc_active and ct_in_state activatable and schact_is_rct
-      and ct_not_queued and ct_not_in_release_q)
-     invs'
-     check_budget_restart checkBudgetRestart"
-  unfolding check_budget_restart_def checkBudgetRestart_def
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_eqr[OF checkBudget_corres])
-      apply (rule corres_split_eqr[OF getCurThread_corres])
-        apply (rule corres_split[OF isRunnable_corres'])
-           apply simp
-          apply (clarsimp simp add: when_def)
-          apply (rule corres_split[OF setThreadState_corres])
-             apply clarsimp
-            apply clarsimp
-           apply ((wpsimp simp: cur_tcb_def[symmetric] cong: conj_cong | strengthen valid_objs_valid_tcbs)+)[6]
-     apply (rule hoare_strengthen_post[where Q'="\<lambda>_. invs and cur_tcb"])
-      apply wpsimp
-     apply (clarsimp simp: cur_tcb_def invs_def valid_state_def valid_pspace_def)
-    apply (rule hoare_strengthen_post[where Q'="\<lambda>_. invs'"])
-     apply wpsimp
-    apply (fastforce simp: invs'_def valid_pspace'_def valid_objs'_valid_tcbs'
-                    dest!: invs_strengthen_cur_sc_tcb_are_bound)
-   apply (clarsimp simp: invs_cur_sc_chargeableE invs_cur ct_activatable_ct_not_blocked)+
+        apply (rename_tac syscall)
+        apply (case_tac syscall,
+               (wp handleReply_sane handleReply_nonz_cap_to_ct handleReply_ksCurThread
+                | clarsimp simp: active_from_running' simple_from_running' simple_sane_strg simp del: split_paired_All
+                | rule conjI active_ex_cap'
+                | strengthen nidle)+)
+        apply (rule hoare_strengthen_post,
+               rule hoare_weaken_pre,
+               rule hy_invs')
+         apply (simp add: active_from_running')
+        apply simp
+       apply (wp hv_inv' hh_inv'
+                 | rule conjI
+                 | erule pred_tcb'_weakenE st_tcb_ex_cap''
+                 | clarsimp simp: tcb_at_invs ct_in_state'_def simple_sane_strg sch_act_simple_def
+                 | drule st_tcb_at_idle_thread'
+                 | wpc | wp (once) hoare_drop_imps)+
   done
+qed
 
-lemma handleInv_handleRecv_corres:
-  "corres (dc \<oplus> dc)
-     (einvs and ct_running and (\<lambda>s. scheduler_action s = resume_cur_thread) and
-      valid_machine_time and
-      current_time_bounded and
-      consumed_time_bounded and
-      cur_sc_active and
-      ct_released and
-      ct_not_in_release_q and
-      ct_not_queued and
-      (\<lambda>s. cur_sc_offset_ready (consumed_time s) s) and
-      (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s))
-     (invs' and ct_running' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-      (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
-     (doE reply_cptr <- liftE (get_cap_reg reg);
-          y <- handle_invocation False False True True reply_cptr;
-          liftE (handle_recv True canReply)
-      odE)
-     (doE replyCptr <- liftE (getCapReg reg);
-          y <- handleInvocation False False True True replyCptr;
-          y \<leftarrow> stateAssertE sch_act_sane_asrt [];
-          y \<leftarrow> stateAssertE ct_not_ksQ_asrt [];
-          y \<leftarrow> stateAssertE ct_active'_asrt [];
-          liftE (handleRecv True canReply)
-      odE)"
-  apply add_cur_tcb'
-  apply (rule_tac Q="\<lambda>s'. pred_map (\<lambda>scPtr. isScActive scPtr s') (tcbSCs_of s') (ksCurThread s')"
-         in corres_cross_add_guard)
-   apply (clarsimp simp: released_sc_tcb_at_def active_sc_tcb_at_def2)
-   apply (prop_tac "scp = cur_sc s")
-    apply (drule invs_cur_sc_tcb_symref, clarsimp simp: schact_is_rct_def)
-    apply (clarsimp simp: pred_tcb_at_def obj_at_def)
-   apply (prop_tac "sc_at (cur_sc s) s")
-    apply (frule invs_cur_sc_tcb)
-    apply (fastforce simp: cur_sc_tcb_def sc_tcb_sc_at_def obj_at_def is_sc_obj
-                     dest: valid_sched_context_size_objsI[OF invs_valid_objs])
-   apply (frule (4) active_sc_at'_cross[OF _ invs_psp_aligned invs_distinct])
-   apply (clarsimp simp: active_sc_at'_def obj_at'_def projectKOs cur_tcb'_def pred_tcb_at_def
-                         is_sc_obj obj_at_def)
-   apply (clarsimp simp: pred_map_def isScActive_def)
-   apply (rule_tac x="cur_sc s" in exI)
-   apply (clarsimp simp: opt_map_red dest!: state_relationD)
-   apply (frule_tac x="ksCurThread s'" in pspace_relation_absD, simp)
-   apply (fastforce simp: other_obj_relation_def tcb_relation_def)
-  apply (rule_tac Q="\<lambda>s'. pred_map (\<lambda>tcb. \<not> tcbInReleaseQueue tcb) (tcbs_of' s') (ksCurThread s')"
-         in corres_cross_add_guard)
-   apply (clarsimp, frule tcb_at_invs)
-   apply (fastforce simp: not_in_release_q_def release_queue_relation_def pred_map_def opt_map_red obj_at'_def
-                          invs'_def valid_pspace'_def projectKOs valid_release_queue'_def cur_tcb'_def
-                   dest!: state_relationD)
-  apply (rule corres_rel_imp)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split_liftEE[OF getCapReg_corres_gen])
-       apply (rule corres_splitEE[OF handleInvocation_corres])
-           apply simp
-          apply simp
-         apply (rule_tac P="(einvs and ct_active and scheduler_act_sane and current_time_bounded
-                            and ct_not_queued and ct_not_in_release_q)"
-                    and P'="(invs')"
-                in corres_inst)
-         apply (rule corres_stateAssertE_add_assertion)
-          apply simp
-          apply (rule corres_stateAssertE_add_assertion)
-           apply (rule corres_stateAssertE_add_assertion)
-            apply simp
-            apply (clarsimp simp: sch_act_sane_asrt_def ct_not_ksQ_asrt_def ct_active'_asrt_def)
-            apply (rule corres_guard_imp)
-              apply (rule handleRecv_isBlocking_corres)
-             apply simp
-            apply simp
-           apply (fastforce simp: ct_active'_asrt_def invs_psp_aligned invs_distinct
-                           dest!: ct_active_cross)
-          apply (clarsimp simp: ct_not_ksQ_asrt_def not_queued_2_def ready_queues_relation_def
-                         dest!: state_relationD)
-         apply (clarsimp simp: sch_act_sane_asrt_def scheduler_act_not_def sch_act_sane_def sched_act_relation_def
-                         dest!: state_relationD)
-         apply (case_tac "scheduler_action s"; simp)
-        apply (wpsimp wp: handle_invocation_valid_sched)
-       apply wpsimp
-      apply wpsimp
-     apply wpsimp
-    apply (clarsimp simp: invs_def valid_state_def valid_pspace_def active_from_running
-                          schedulable_def2 released_sc_tcb_at_def)
-    apply (clarsimp simp: ct_in_state_def st_tcb_weakenE)
-   apply (clarsimp simp: active_from_running')
-  apply simp
+lemma inv_irq_IRQInactive:
+  "\<lbrace>\<top>\<rbrace> performIRQControl irqcontrol_invocation
+  -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply (simp add: performIRQControl_def)
+  apply (rule hoare_pre)
+   apply (wpc|wp|simp add: ARM_H.performIRQControl_def)+
   done
 
-(* these two appreviations are for the two helper lemmas below, which should be identical
-   except that they are in different monads *)
-abbreviation (input)
-  "a_pre \<equiv> (einvs and ct_running and
-         (\<lambda>s. scheduler_action s = resume_cur_thread) and
-         valid_machine_time and
-         current_time_bounded and
-         consumed_time_bounded and
-         cur_sc_active and (ct_active or ct_idle) and
-         ct_not_in_release_q and
-         ct_not_queued and
-         (\<lambda>s. cur_sc_offset_ready (consumed_time s) s) and
-         (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s) and
-         ct_released)"
-
-abbreviation (input)
-  "c_pre \<equiv> (invs' and ct_running' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-         (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))"
-
-lemma updateTimeStamp_checkBudgetRestart_helper:
-  assumes H: "corres dc a_pre c_pre f f'"
-  shows "corres dc a_pre c_pre
-           (do y <- update_time_stamp;
-               restart <- check_budget_restart;
-               when restart f
-            od)
-           (do y <- updateTimeStamp;
-               restart <- checkBudgetRestart;
-               when restart f'
-            od)"
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF updateTimeStamp_corres])
-      apply (rule_tac P="\<lambda> s. (cur_sc_active s \<longrightarrow> cur_sc_offset_ready (consumed_time s) s)
-                               \<and> cur_sc_active s \<and> ct_running s \<and> valid_machine_time s
-                               \<and> ct_released s \<and> ct_not_in_release_q s \<and> ct_not_queued s
-                               \<and> current_time_bounded s \<and> consumed_time_bounded s \<and> einvs s
-                               \<and> scheduler_action s = resume_cur_thread"
-                 and P'=c_pre in corres_inst)
-      apply (rule corres_guard_imp)
-        apply (rule corres_split[OF checkBudgetRestart_corres])
-          apply (simp add: when_def split del: if_split)
-          apply (rule corres_if2)
-            apply simp
-           apply (rule_tac P="\<lambda>s. (cur_sc_offset_ready (consumed_time s) s \<and> einvs s
-                                   \<and> cur_sc_active s \<and> valid_machine_time s \<and> ct_running s
-                                   \<and> ct_released s \<and> ct_not_in_release_q s \<and> ct_not_queued s
-                                   \<and> current_time_bounded s \<and> consumed_time_bounded s
-                                   \<and> scheduler_action s = resume_cur_thread)
-                                   \<and> cur_sc_offset_sufficient (consumed_time s) s"
-                      and P'=c_pre in corres_inst)
-           apply (rule corres_guard_imp)
-             apply (rule H)
-            apply (clarsimp simp: active_from_running)
-           apply simp
-          apply (simp add: corres_return[where P=cur_sc_more_than_ready])
-         apply (wpsimp wp: check_budget_restart_false check_budget_restart_true')
-        apply (wpsimp wp: checkBudgetRestart_false checkBudgetRestart_true)
-       apply (clarsimp dest!: active_from_running
-                        simp: cur_sc_offset_ready_def pred_map_def
-                              ct_in_state_weaken[OF _ active_activatable])
-      apply clarsimp
-     apply (wpsimp wp: update_time_stamp_current_time_bounded
-                       update_time_stamp_cur_sc_offset_ready_cs)
-    apply wpsimp
-   apply clarsimp+
+lemma inv_arch_IRQInactive:
+  "\<lbrace>\<top>\<rbrace> Arch.performInvocation invocation
+  -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply (simp add: ARM_H.performInvocation_def performARMMMUInvocation_def)
+  apply wp
   done
 
-lemma updateTimeStamp_checkBudgetRestart_helperE:
-  assumes H: "corres (dc \<oplus> dc) a_pre c_pre f f'"
-  shows "corres (dc \<oplus> dc) a_pre c_pre
-           (doE y <- liftE update_time_stamp;
-               restart <- liftE check_budget_restart;
-               whenE restart f
-            odE)
-           (doE y <- liftE updateTimeStamp;
-               restart <- liftE checkBudgetRestart;
-               whenE restart f'
-            odE)"
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_liftEE[OF updateTimeStamp_corres])
-      apply (rule_tac P="\<lambda> s. (cur_sc_active s \<longrightarrow> cur_sc_offset_ready (consumed_time s) s)
-                               \<and> cur_sc_active s \<and> ct_running s \<and> valid_machine_time s
-                               \<and> ct_released s \<and> ct_not_in_release_q s \<and> ct_not_queued s
-                               \<and> current_time_bounded s \<and> consumed_time_bounded s \<and> einvs s
-                               \<and> scheduler_action s = resume_cur_thread"
-                 and P'=c_pre in corres_inst)
-      apply (rule corres_guard_imp)
-        apply (rule corres_split_liftEE[OF checkBudgetRestart_corres])
-          apply (simp add: whenE_def split del: if_split)
-          apply (rule corres_if2)
-            apply simp
-           apply (rule_tac P="\<lambda>s. (cur_sc_offset_ready (consumed_time s) s \<and> einvs s
-                                   \<and> cur_sc_active s \<and> valid_machine_time s \<and> ct_running s
-                                   \<and> ct_released s \<and> ct_not_in_release_q s \<and> ct_not_queued s
-                                   \<and> current_time_bounded s \<and> consumed_time_bounded s
-                                   \<and> scheduler_action s = resume_cur_thread)
-                                   \<and> cur_sc_offset_sufficient (consumed_time s) s"
-                      and P'=c_pre in corres_inst)
-           apply (rule corres_guard_imp)
-             apply (rule H)
-            apply (clarsimp simp: active_from_running)
-           apply simp
-          apply (rule corres_returnOk[where P=cur_sc_more_than_ready])
-          apply simp
-         apply (wpsimp wp: check_budget_restart_false check_budget_restart_true')
-        apply (wpsimp wp: checkBudgetRestart_false checkBudgetRestart_true)
-       apply (clarsimp dest!: active_from_running
-                        simp: cur_sc_offset_ready_def pred_map_def
-                              ct_in_state_weaken[OF _ active_activatable])
-      apply clarsimp
-     apply (wpsimp wp: update_time_stamp_current_time_bounded
-                       update_time_stamp_cur_sc_offset_ready_cs)
-    apply wpsimp
-   apply clarsimp+
+lemma retype_pi_IRQInactive:
+  "\<lbrace>valid_irq_states'\<rbrace> RetypeDecls_H.performInvocation blocking call v
+   -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply (simp add: Retype_H.performInvocation_def)
+  apply (rule hoare_pre)
+   apply (wpc |
+          wp inv_tcb_IRQInactive inv_cnode_IRQInactive inv_irq_IRQInactive
+             inv_untyped_IRQInactive inv_arch_IRQInactive |
+          simp)+
   done
 
-lemma handleEvent_corres:
-  "corres (dc \<oplus> dc)
-     (einvs and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running s)
-      and (\<lambda>s. scheduler_action s = resume_cur_thread)
-      and valid_machine_time and current_time_bounded
-      and consumed_time_bounded and cur_sc_active and (ct_active or ct_idle)
-      and ct_not_in_release_q and ct_not_queued
-      and (\<lambda>s. cur_sc_offset_ready (consumed_time s) s)
-      and (\<lambda>s. cur_sc_offset_sufficient (consumed_time s) s))
-     (invs' and (\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_running' s) and
-      (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-      (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
-     (handle_event event) (handleEvent event)"
-  (is "corres _ (?P and ?ready and _) ?P' _ _")
-proof -
-  have hw:
-    "\<And>isBlocking canGrant.
-     corres dc (einvs and ct_running and valid_machine_time and current_time_bounded
-                and ct_released and (\<lambda>s. scheduler_action s = resume_cur_thread)
-                and ct_not_in_release_q and ct_not_queued)
-               (invs' and ct_running'
-                      and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread))
-               (handle_recv isBlocking canGrant) (handleRecv isBlocking canGrant)"
-    apply add_cur_tcb'
-    apply add_ct_not_inQ
-    apply (rule corres_guard_imp [OF handleRecv_isBlocking_corres])
-     apply (fastforce simp: ct_in_state_def ct_in_state'_def
-                     elim!: st_tcb_weakenE pred_tcb'_weakenE
-                      dest: ct_not_ksQ)+
-    done
-  show ?thesis
-    apply (rule corres_cross_add_abs_guard[where Q="\<lambda>s. event \<noteq> Interrupt \<longrightarrow> ct_released s"])
-     apply (simp only: schact_is_rct_def[symmetric])
-     apply clarsimp
-     apply (frule (1) invs_strengthen_cur_sc_tcb_are_bound[OF _ invs_cur_sc_tcb])
-      apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-     apply (erule (5) schact_is_rct_ct_released)
-     apply (erule (2) cur_sc_not_idle_sc_ptr')
-    apply (case_tac event)
-         apply (simp_all add: handleEvent_def)
-         apply (rename_tac syscall)
-         apply (rule updateTimeStamp_checkBudgetRestart_helperE)
-         apply (case_tac syscall; simp)
-                   apply (auto intro: corres_guard_imp[OF handleSend_corres]
-                                      corres_guard_imp[OF hw]
-                                      corres_guard_imp[OF handleCall_corres]
-                                      corres_guard_imp[OF handleInv_handleRecv_corres]
-                                      corres_guard_imp[OF handleYield_corres]
-                                      active_from_running active_from_running' released_imp_active_sc_tcb_at
-                               simp: simple_sane_strg
-                              dest!: schact_is_rct)[11]
-        apply (rule updateTimeStamp_checkBudgetRestart_helper)
-        apply (rule corres_underlying_split)
-           apply (rule corres_guard_imp[OF getCurThread_corres], simp+)
-          apply (rule handleFault_corres)
-          apply simp
-         apply wpsimp
-         apply (clarsimp simp: valid_fault_def valid_sched_def current_time_bounded_def
-                        dest!: active_from_running)
-         apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
-        apply wp
-        apply (fastforce simp: ct_in_state'_def sch_act_simple_def
-                         elim: pred_tcb'_weakenE st_tcb_ex_cap'')
-
-       apply (rule updateTimeStamp_checkBudgetRestart_helper)
-       apply (rule corres_underlying_split)
-          apply (rule corres_guard_imp[OF getCurThread_corres], simp+)
-         apply (rule handleFault_corres)
-         apply simp
-        apply wpsimp
-        apply (clarsimp simp: valid_fault_def valid_sched_def current_time_bounded_def
-                       dest!: active_from_running)
-        apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
-       apply wp
-       apply (fastforce simp: ct_in_state'_def sch_act_simple_def
-                        elim: pred_tcb'_weakenE st_tcb_ex_cap'')
-
-      apply (rule corres_guard_imp)
-        apply (rule corres_split_eqr[OF corres_machine_op])
-           apply (rule corres_Id, simp+)
-           apply wp
-          apply (rename_tac active)
-          apply (rule corres_split[OF updateTimeStamp_corres])
-            apply (rule_tac P="\<lambda> s. (cur_sc_active s \<longrightarrow> cur_sc_offset_ready (consumed_time s) s)
-                                     \<and> cur_sc_active s \<and> valid_machine_time s \<and> (ct_active s \<or> ct_idle s)
-                                     \<and> ct_not_in_release_q s \<and> ct_not_queued s
-                                     \<and> current_time_bounded s \<and> consumed_time_bounded s \<and> einvs s
-                                     \<and> scheduler_action s = resume_cur_thread"
-                       and P'="(invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
-                                (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)) and
-                                (\<lambda>s. \<forall>x. active = Some x \<longrightarrow>
-                                            intStateIRQTable (ksInterruptState s) x \<noteq> irqstate.IRQInactive)"
-                   in corres_inst)
-            apply (rule corres_guard_imp)
-              apply (rule corres_split[OF checkBudget_corres])
-                apply (rule_tac P="einvs and current_time_bounded"
-                           and P'="invs' and (\<lambda>s. \<forall>x. active = Some x \<longrightarrow> intStateIRQTable (ksInterruptState s) x \<noteq> irqstate.IRQInactive)"
-                       in corres_inst)
-                apply (case_tac active; simp)
-                apply (rule handleInterrupt_corres)
-               apply (wpsimp wp: check_budget_valid_sched)
-              apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift)
-             apply (wpsimp wp: update_time_stamp_current_time_bounded hoare_vcg_disj_lift
-                               update_time_stamp_cur_sc_offset_ready_cs)
-             apply (clarsimp simp: cur_sc_offset_ready_weaken_zero active_from_running current_time_bounded_def)
-             apply (frule invs_cur_sc_chargeableE)
-              apply (clarsimp simp: schact_is_rct_def)
-             apply clarsimp
-             apply (rule conjI)
-              apply (erule cur_sc_offset_ready_weaken_zero)
-             apply (rule conjI)
-              apply (fastforce simp: ct_in_state_def pred_tcb_at_def obj_at_def cur_tcb_def is_tcb dest!: invs_cur)
-             apply (erule ct_not_blocked_cur_sc_not_blocked)
-             apply (rule ct_activatable_ct_not_blocked)
-             apply (fastforce simp: ct_in_state_def pred_tcb_at_def obj_at_def dest!: active_activatable)
-            apply clarsimp
-           apply (wpsimp wp: update_time_stamp_current_time_bounded hoare_vcg_disj_lift
-                             update_time_stamp_cur_sc_offset_ready_cs)
-          apply wpsimp
-         apply wpsimp
-        apply (clarsimp simp: ct_in_state_def)
-        apply (wpsimp wp: doMachineOp_getActiveIRQ_IRQ_active' hoare_vcg_all_lift)
-       apply (clarsimp elim!: active_from_running)
-      apply clarsimp
-      apply (simp add: invs'_def)
-     apply (rule updateTimeStamp_checkBudgetRestart_helper)
-     apply (rule corres_underlying_split)
-        apply (rule corres_guard_imp[OF getCurThread_corres], simp+)
-       apply (rule corres_split_catch)
-          apply (rule handleVMFault_corres)
-         apply (erule handleFault_corres)
-        apply (rule hoare_elim_pred_conjE2)
-        apply (rule hoare_vcg_conj_liftE_E, rule valid_validE_E, wp)
-        apply (wpsimp wp: handle_vm_fault_valid_fault)
-       apply (rule hv_inv_ex')
-      apply wp
-      apply (clarsimp simp: active_from_running tcb_at_invs valid_sched_def current_time_bounded_def)
-      apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def)
-     apply wp
-     apply clarsimp
-     apply (fastforce simp: simple_sane_strg sch_act_simple_def ct_in_state'_def
-                      elim: st_tcb_ex_cap'' pred_tcb'_weakenE)
-    apply add_ct_not_inQ
-    apply (rule corres_underlying_split)
-       apply (rule corres_guard_imp[OF getCurThread_corres], simp+)
-      apply (rule handleHypervisorFault_corres)
-     apply (simp add: valid_fault_def)
-     apply wp
-     apply clarsimp
-     apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE
-                      simp: ct_in_state_def)
-    apply wp
-    apply (clarsimp simp: active_from_running' invs'_def valid_pspace'_def)
-    apply (frule (2) ct_not_ksQ)
-    apply (fastforce simp: ct_in_state'_def sch_act_simple_def
-                           sch_act_sane_def
-                     elim: pred_tcb'_weakenE st_tcb_ex_cap'')
-    done
-  qed
-
 end
 
 end
diff --git a/proof/refine/ARM/TcbAcc_R.thy b/proof/refine/ARM/TcbAcc_R.thy
index a40ce993bf..d9ef04af4d 100644
--- a/proof/refine/ARM/TcbAcc_R.thy
+++ b/proof/refine/ARM/TcbAcc_R.thy
@@ -1,25 +1,20 @@
 (*
- * Copyright 2022, Proofcraft Pty Ltd
  * Copyright 2014, General Dynamics C4 Systems
  *
  * SPDX-License-Identifier: GPL-2.0-only
  *)
 
 theory TcbAcc_R
-imports CSpace_R
+imports CSpace_R ArchMove_R
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 declare if_weak_cong [cong]
 declare hoare_in_monad_post[wp]
 declare trans_state_update'[symmetric,simp]
 declare storeWordUser_typ_at' [wp]
 
-lemma threadRead_SomeD:
-  "threadRead f t s = Some y \<Longrightarrow> \<exists>tcb. ko_at' tcb t s \<and> y = f tcb"
-  by (fastforce simp: threadRead_def oliftM_def dest!: readObject_misc_ko_at')
-
 (* Auxiliaries and basic properties of priority bitmap functions *)
 
 lemma countLeadingZeros_word_clz[simp]:
@@ -87,43 +82,86 @@ lemma l1IndexToPrio_wordRadix_mask[simp]:
   unfolding l1IndexToPrio_def
   by (simp add: wordRadix_def')
 
-definition
-  (* when in the middle of updates, a particular queue might not be entirely valid *)
-  valid_queues_no_bitmap_except :: "word32 \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
- "valid_queues_no_bitmap_except t' \<equiv> \<lambda>s.
-   (\<forall>d p. (\<forall>t \<in> set (ksReadyQueues s (d, p)). t \<noteq> t' \<longrightarrow> obj_at' (inQ d p) t s)
-    \<and> (d > maxDomain \<or> p > maxPriority \<longrightarrow> ksReadyQueues s (d,p) = []))"
-
-lemma valid_queues_no_bitmap_exceptI[intro]:
-  "valid_queues_no_bitmap s \<Longrightarrow> valid_queues_no_bitmap_except t s"
-  unfolding valid_queues_no_bitmap_except_def valid_queues_no_bitmap_def
-  by simp
-
-crunch setThreadState, threadSet
-  for replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
-  and reply_at'[wp]: "\<lambda>s. P (reply_at' p s)"
-  and tcb_at'[wp]: "\<lambda>s. P (tcb_at' p s)"
-  and obj_at'_reply[wp]: "\<lambda>s. P (obj_at' (Q :: reply \<Rightarrow> bool) p s)"
-  and obj_at'_ep[wp]: "\<lambda>s. P (obj_at' (Q :: endpoint \<Rightarrow> bool) p s)"
-  and obj_at'_ntfn[wp]: "\<lambda>s. P (obj_at' (Q :: notification \<Rightarrow> bool) p s)"
-  and obj_at'_sc[wp]: "\<lambda>s. Q (obj_at' (P :: sched_context \<Rightarrow> bool) p s)"
-  (wp: crunch_wps set_tcb'.set_preserves_some_obj_at')
-
-crunch tcbSchedDequeue, tcbSchedEnqueue
-  for replies_of'[wp]: "\<lambda>s. P (replies_of' s)"
-
-crunch tcbSchedDequeue, tcbSchedEnqueue, tcbReleaseRemove
-  for obj_at'_reply[wp]: "\<lambda>s. P (obj_at' (Q :: reply \<Rightarrow> bool) p s)"
-  and obj_at'_ep[wp]: "\<lambda>s. P (obj_at' (Q :: endpoint \<Rightarrow> bool) p s)"
-  and obj_at'_sc[wp]: "\<lambda>s. Q (obj_at' (P :: sched_context \<Rightarrow> bool) p s)"
-
-lemma valid_objs_valid_tcbE':
-  assumes "valid_objs' s"
-          "tcb_at' t s"
-          "\<And>tcb. ko_at' tcb t s \<Longrightarrow> valid_tcb' tcb s \<Longrightarrow> R s tcb"
-  shows "obj_at' (R s) t s"
+lemma st_tcb_at_coerce_abstract:
+  assumes t: "st_tcb_at' P t c"
+  assumes sr: "(a, c) \<in> state_relation"
+  shows "st_tcb_at (\<lambda>st. \<exists>st'. thread_state_relation st st' \<and> P st') t a"
+  using assms
+  apply (clarsimp simp: state_relation_def pred_tcb_at'_def obj_at'_def
+                        projectKOs)
+  apply (erule (1) pspace_dom_relatedE)
+  apply (erule (1) obj_relation_cutsE, simp_all)
+  by (fastforce simp: st_tcb_at_def obj_at_def other_obj_relation_def tcb_relation_def
+               split: Structures_A.kernel_object.split_asm if_split_asm
+                      arch_kernel_obj.split_asm)+
+
+lemma st_tcb_at_runnable_coerce_concrete:
+  assumes t: "st_tcb_at runnable t a"
+  assumes sr: "(a, c) \<in> state_relation"
+  assumes tcb: "tcb_at' t c"
+  shows "st_tcb_at' runnable' t c"
+  using t
+  apply -
+  apply (rule ccontr)
+  apply (drule pred_tcb_at'_Not[THEN iffD2, OF conjI, OF tcb])
+  apply (drule st_tcb_at_coerce_abstract[OF _ sr])
+  apply (clarsimp simp: st_tcb_def2)
+  apply (case_tac "tcb_state tcb"; simp)
+  done
+
+lemma pspace_relation_tcb_at':
+  assumes p: "pspace_relation (kheap a) (ksPSpace c)"
+  assumes t: "tcb_at t a"
+  assumes aligned: "pspace_aligned' c"
+  assumes distinct: "pspace_distinct' c"
+  shows "tcb_at' t c"
   using assms
+  apply (clarsimp simp: obj_at_def)
+  apply (drule(1) pspace_relation_absD)
+  apply (clarsimp simp: is_tcb tcb_relation_cut_def)
+  apply (simp split: kernel_object.split_asm)
+  apply (drule(2) aligned_distinct_obj_atI'[where 'a=tcb], simp)
+  apply (erule obj_at'_weakenE)
+  apply simp
+  done
+
+lemma tcb_at_cross:
+  "\<lbrakk>tcb_at t s; pspace_aligned s; pspace_distinct s; pspace_relation (kheap s) (ksPSpace s')\<rbrakk>
+   \<Longrightarrow> tcb_at' t s'"
+  apply (drule (2) pspace_distinct_cross)
+  apply (drule (1) pspace_aligned_cross)
+  apply (erule (3) pspace_relation_tcb_at')
+  done
+
+lemma tcb_at'_cross:
+  assumes p: "pspace_relation (kheap s) (ksPSpace s')"
+  assumes t: "tcb_at' ptr s'"
+  shows "tcb_at ptr s"
+  using assms
+  apply (clarsimp simp: obj_at'_def)
+  apply (erule (1) pspace_dom_relatedE)
+  by (clarsimp simp: obj_relation_cuts_def2 obj_at_def cte_relation_def
+                     other_obj_relation_def pte_relation_def pde_relation_def is_tcb_def projectKOs
+              split: Structures_A.kernel_object.split_asm if_split_asm arch_kernel_obj.split_asm)
+
+lemma st_tcb_at_runnable_cross:
+  "\<lbrakk> st_tcb_at runnable t s; pspace_aligned s; pspace_distinct s; (s, s') \<in> state_relation \<rbrakk>
+  \<Longrightarrow> st_tcb_at' runnable' t s'"
+  apply (frule (1) pspace_distinct_cross, fastforce simp: state_relation_def)
+  apply (frule pspace_aligned_cross, fastforce simp: state_relation_def)
+  apply (prop_tac "tcb_at t s", clarsimp simp: st_tcb_at_def obj_at_def is_tcb)
+  apply (drule (2) tcb_at_cross, fastforce simp: state_relation_def)
+  apply (erule (2) st_tcb_at_runnable_coerce_concrete)
+  done
+
+lemma cur_tcb_cross:
+  "\<lbrakk> cur_tcb s; pspace_aligned s; pspace_distinct s; (s,s') \<in> state_relation \<rbrakk> \<Longrightarrow> cur_tcb' s'"
+  apply (clarsimp simp: cur_tcb'_def cur_tcb_def state_relation_def)
+  apply (erule (3) tcb_at_cross)
+  done
+
+lemma valid_objs_valid_tcbE:
+  "\<And>s t.\<lbrakk> valid_objs' s; tcb_at' t s; \<And>tcb. valid_tcb' tcb s \<Longrightarrow> R s tcb \<rbrakk> \<Longrightarrow> obj_at' (R s) t s"
   apply (clarsimp simp add: projectKOs valid_objs'_def ran_def typ_at'_def
                             ko_wp_at'_def valid_obj'_def valid_tcb'_def obj_at'_def)
   apply (fastforce simp: projectKO_def projectKO_opt_tcb return_def valid_tcb'_def)
@@ -133,12 +171,13 @@ lemma valid_tcb'_tcbDomain_update:
   "new_dom \<le> maxDomain \<Longrightarrow>
    \<forall>tcb. valid_tcb' tcb s \<longrightarrow> valid_tcb' (tcbDomain_update (\<lambda>_. new_dom) tcb) s"
   unfolding valid_tcb'_def
-  by (clarsimp simp: tcb_cte_cases_def)
+  apply (clarsimp simp: tcb_cte_cases_def objBits_simps')
+  done
 
 lemma valid_tcb'_tcbState_update:
   "\<lbrakk>valid_tcb_state' st s; valid_tcb' tcb s\<rbrakk> \<Longrightarrow>
    valid_tcb' (tcbState_update (\<lambda>_. st) tcb) s"
-  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def valid_tcb_state'_def)
+  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def valid_tcb_state'_def objBits_simps')
   done
 
 definition valid_tcbs' :: "kernel_state \<Rightarrow> bool" where
@@ -154,14 +193,14 @@ lemma invs'_valid_tcbs'[elim!]:
 
 lemma valid_tcbs'_maxDomain:
   "\<And>s t. \<lbrakk> valid_tcbs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbDomain tcb \<le> maxDomain) t s"
-  apply (clarsimp simp: valid_tcbs'_def obj_at'_def projectKOs valid_tcb'_def)
+  apply (clarsimp simp: valid_tcbs'_def obj_at'_def valid_tcb'_def projectKOs)
   done
 
 lemmas valid_objs'_maxDomain = valid_tcbs'_maxDomain[OF valid_objs'_valid_tcbs']
 
 lemma valid_tcbs'_maxPriority:
   "\<And>s t. \<lbrakk> valid_tcbs' s; tcb_at' t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>tcb. tcbPriority tcb \<le> maxPriority) t s"
-  apply (clarsimp simp: valid_tcbs'_def obj_at'_def projectKOs valid_tcb'_def)
+  apply (clarsimp simp: valid_tcbs'_def obj_at'_def valid_tcb'_def projectKOs)
   done
 
 lemmas valid_objs'_maxPriority = valid_tcbs'_maxPriority[OF valid_objs'_valid_tcbs']
@@ -172,31 +211,25 @@ lemma valid_tcbs'_obj_at':
           "\<And>tcb. ko_at' tcb t s \<Longrightarrow> valid_tcb' tcb s \<Longrightarrow> R s tcb"
   shows "obj_at' (R s) t s"
   using assms
-  apply (clarsimp simp add: projectKOs valid_tcbs'_def ran_def typ_at'_def
-                            ko_wp_at'_def valid_obj'_def valid_tcb'_def obj_at'_def)
+  apply (clarsimp simp add: valid_tcbs'_def ran_def typ_at'_def
+                            ko_wp_at'_def valid_obj'_def valid_tcb'_def obj_at'_def projectKOs)
   done
 
 lemma update_valid_tcb'[simp]:
-  "\<And>f. valid_tcb' tcb (ksReleaseQueue_update f s) = valid_tcb' tcb s"
-  "\<And>f. valid_tcb' tcb (ksReprogramTimer_update f s) = valid_tcb' tcb s"
   "\<And>f. valid_tcb' tcb (ksReadyQueuesL1Bitmap_update f s) = valid_tcb' tcb s"
   "\<And>f. valid_tcb' tcb (ksReadyQueuesL2Bitmap_update f s) = valid_tcb' tcb s"
   "\<And>f. valid_tcb' tcb (ksReadyQueues_update f s) = valid_tcb' tcb s"
   "\<And>f. valid_tcb' tcb (ksSchedulerAction_update f s) = valid_tcb' tcb s"
-  by (auto simp: valid_tcb'_def valid_tcb_state'_def valid_bound_obj'_def
+  "\<And>f. valid_tcb' tcb (ksDomainTime_update f s) = valid_tcb' tcb s"
+  by (auto simp: valid_tcb'_def valid_tcb_state'_def valid_bound_tcb'_def valid_bound_ntfn'_def
           split: option.splits thread_state.splits)
 
-lemma update_tcbInReleaseQueue_False_valid_tcb'[simp]:
-  "valid_tcb' (tcbInReleaseQueue_update a tcb) s = valid_tcb' tcb s"
-  by (auto simp: valid_tcb'_def tcb_cte_cases_def)
-
 lemma update_valid_tcbs'[simp]:
-  "\<And>f. valid_tcbs' (ksReleaseQueue_update f s) = valid_tcbs' s"
-  "\<And>f. valid_tcbs' (ksReprogramTimer_update f s) = valid_tcbs' s"
   "\<And>f. valid_tcbs' (ksReadyQueuesL1Bitmap_update f s) = valid_tcbs' s"
   "\<And>f. valid_tcbs' (ksReadyQueuesL2Bitmap_update f s) = valid_tcbs' s"
   "\<And>f. valid_tcbs' (ksReadyQueues_update f s) = valid_tcbs' s"
   "\<And>f. valid_tcbs' (ksSchedulerAction_update f s) = valid_tcbs' s"
+  "\<And>f. valid_tcbs' (ksDomainTime_update f s) = valid_tcbs' s"
   by (simp_all add: valid_tcbs'_def)
 
 lemma doMachineOp_irq_states':
@@ -227,6 +260,22 @@ lemma dmo_invs':
   apply assumption
   done
 
+lemma dmo_invs_no_cicd':
+  assumes masks: "\<And>P. \<lbrace>\<lambda>s. P (irq_masks s)\<rbrace> f \<lbrace>\<lambda>_ s. P (irq_masks s)\<rbrace>"
+  shows "\<lbrace>(\<lambda>s. \<forall>m. \<forall>(r,m')\<in>fst (f m). \<forall>p.
+             pointerInUserData p s \<or> pointerInDeviceData p s \<or>
+             underlying_memory m' p = underlying_memory m p) and
+          invs_no_cicd'\<rbrace> doMachineOp f \<lbrace>\<lambda>r. invs_no_cicd'\<rbrace>"
+  apply (simp add: doMachineOp_def split_def)
+  apply wp
+  apply clarsimp
+  apply (subst invs_no_cicd'_machine)
+    apply (drule use_valid)
+      apply (rule_tac P="\<lambda>m. m = irq_masks (ksMachineState s)" in masks, simp+)
+   apply (fastforce simp add: valid_machine_state'_def)
+  apply assumption
+  done
+
 lemma dmo_lift':
   assumes f: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
   shows "\<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> doMachineOp f
@@ -260,8 +309,25 @@ lemma doMachineOp_getActiveIRQ_IRQ_active':
   apply simp
   done
 
+lemma preemptionPoint_irq [wp]:
+  "\<lbrace>valid_irq_states'\<rbrace> preemptionPoint -,
+   \<lbrace>\<lambda>irq s. intStateIRQTable (ksInterruptState s) irq \<noteq> IRQInactive\<rbrace>"
+  apply (simp add: preemptionPoint_def setWorkUnits_def modifyWorkUnits_def getWorkUnits_def)
+  apply (wp whenE_wp|wpc)+
+     apply (rule hoare_post_imp)
+      prefer 2
+     apply (rule doMachineOp_getActiveIRQ_IRQ_active)
+    apply clarsimp
+   apply wp+
+  apply clarsimp
+  done
+
 lemmas doMachineOp_obj_at = doMachineOp_obj_at'
 
+lemma updateObject_tcb_inv:
+  "\<lbrace>P\<rbrace> updateObject (obj::tcb) ko p q n \<lbrace>\<lambda>rv. P\<rbrace>"
+  by simp (rule updateObject_default_inv)
+
 lemma setObject_update_TCB_corres':
   assumes tcbs: "tcb_relation tcb tcb' \<Longrightarrow> tcb_relation new_tcb new_tcb'"
   assumes tables: "\<forall>(getF, v) \<in> ran tcb_cap_cases. getF new_tcb = getF tcb"
@@ -270,45 +336,103 @@ lemma setObject_update_TCB_corres':
                           "tcbSchedNext new_tcb' = tcbSchedNext tcb'"
   assumes flag: "tcbQueued new_tcb' = tcbQueued tcb'"
   assumes r: "r () ()"
-  shows "corres r (ko_at (TCB tcb) add)
-                  (ko_at' tcb' add)
-                  (set_object add (TCB tcbu)) (setObject add tcbu')"
-  apply (rule_tac F="tcb_relation tcb tcb'" in corres_req)
+  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 (clarsimp simp: state_relation_def obj_at_def obj_at'_def)
    apply (frule(1) pspace_relation_absD)
-   apply (clarsimp simp: projectKOs other_obj_relation_def)
-  apply (rule corres_guard_imp)
-    apply (rule corres_rel_imp)
-     apply (rule setObject_other_corres[where P="(=) tcb'"])
-           apply (rule ext)+
-           apply simp
-          defer
-          apply (simp add: is_other_obj_relation_type_def
-                           projectKOs objBits_simps'
-                           other_obj_relation_def tcbs r)+
-    apply (fastforce elim!: obj_at_weakenE dest: bspec[OF tables])
-   apply (subst(asm) eq_commute, assumption)
-  apply (clarsimp simp: projectKOs 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
+   apply (clarsimp simp: tcb_relation_cut_def exst projectKOs)
+  apply (rule corres_no_failI)
+   apply (rule no_fail_pre)
+    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)
+  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)
+     apply (clarsimp simp: objBits_simps)
+    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
+  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
+                        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 (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 (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 (frule bspec, erule domI)
+   apply (rule ballI, drule(1) bspec)
+   apply (drule domD)
+   apply (clarsimp simp: 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 projectKOs
+                  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
 
 lemma setObject_update_TCB_corres:
-  "\<lbrakk> tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcbu tcbu';
-     \<forall>(getF, v) \<in> ran tcb_cap_cases. getF tcbu = getF tcb;
-     \<forall>(getF, v) \<in> ran tcb_cte_cases. getF tcbu' = getF tcb';
-     r () ()\<rbrakk>
-   \<Longrightarrow> corres r (\<lambda>s. get_tcb add s = Some tcb)
-               (\<lambda>s'. (tcb', s') \<in> fst (getObject add s'))
-               (set_object add (TCB tcbu)) (setObject add tcbu')"
+  "\<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';
+     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 (3) setObject_update_TCB_corres', force)
-  apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def
-                        loadObject_default_def projectKOs objBits_simps' in_magnitude_check
-                 dest!: readObject_misc_ko_at')
+    apply (erule (7) setObject_update_TCB_corres')
+   apply (clarsimp simp: getObject_def in_monad split_def obj_at'_def projectKOs
+                         loadObject_default_def objBits_simps' in_magnitude_check)+
   done
 
 lemma getObject_TCB_corres:
@@ -325,31 +449,31 @@ lemma getObject_TCB_corres:
 
 lemma threadGet_corres:
   assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow> r (f tcb) (f' tcb')"
-  shows      "corres r (tcb_at t) (tcb_at' t) (thread_get f t) (threadGet f' t)"
-  apply (simp add: thread_get_def threadGet_getObject)
-  apply (rule corres_split_skip)
-     apply wpsimp+
+  shows      "corres r (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+                       (thread_get f t) (threadGet f' t)"
+  apply (simp add: thread_get_def threadGet_def)
+  apply (fold liftM_def)
+  apply simp
+  apply (rule corres_rel_imp)
    apply (rule getObject_TCB_corres)
   apply (simp add: x)
   done
 
-lemmas get_tcb_obj_ref_corres
-  = threadGet_corres[where 'a="obj_ref option", folded get_tcb_obj_ref_def]
-
 lemma threadGet_inv [wp]: "\<lbrace>P\<rbrace> threadGet f t \<lbrace>\<lambda>rv. P\<rbrace>"
-  by (simp add: threadGet_def getObject_tcb_inv | wp)+
+  by (simp add: threadGet_def getObject_inv_tcb | wp)+
 
 lemma ball_tcb_cte_casesI:
   "\<lbrakk> P (tcbCTable, tcbCTable_update);
      P (tcbVTable, tcbVTable_update);
-     P (tcbIPCBufferFrame, tcbIPCBufferFrame_update);
-     P (tcbFaultHandler, tcbFaultHandler_update);
-     P (tcbTimeoutHandler, tcbTimeoutHandler_update) \<rbrakk>
+     P (tcbReply, tcbReply_update);
+     P (tcbCaller, tcbCaller_update);
+     P (tcbIPCBufferFrame, tcbIPCBufferFrame_update) \<rbrakk>
     \<Longrightarrow> \<forall>x \<in> ran tcb_cte_cases. P x"
   by (simp add: tcb_cte_cases_def)
 
 lemma all_tcbI:
-  "\<lbrakk> \<And>a b c d e f g h i j k l m n p q r. P (Thread a b c d e f g h i j k l m n p q r) \<rbrakk> \<Longrightarrow> \<forall>tcb. P tcb"
+  "\<lbrakk> \<And>a b c d e f g h i j k l m n p q r s. P (Thread a b c d e f g h i j k l m n p q r s) \<rbrakk>
+   \<Longrightarrow> \<forall>tcb. P tcb"
   by (rule allI, case_tac tcb, simp)
 
 lemma threadset_corresT:
@@ -358,18 +482,26 @@ lemma threadset_corresT:
   assumes y: "\<And>tcb. \<forall>(getF, setF) \<in> ran tcb_cap_cases. getF (f tcb) = getF tcb"
   assumes z: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases.
                  getF (f' tcb) = getF tcb"
-  shows      "corres dc (tcb_at t)
-                        (tcb_at' t)
-                    (thread_set f t) (threadSet f' t)"
+  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')"
+  shows      "corres dc (tcb_at t and pspace_aligned and pspace_distinct)
+                        \<top>
+                        (thread_set f t) (threadSet f' t)"
   apply (simp add: thread_set_def threadSet_def)
   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 simp
+             apply (erule x)
+            apply (rule y)
+           apply (clarsimp simp: bspec_split [OF spec [OF z]])
+           apply fastforce
+          apply (rule sched_pointers)
+         apply (rule sched_pointers)
+        apply (rule flag)
+       apply simp
+      apply (rule e)
      apply wp+
    apply (clarsimp simp add: tcb_at_def obj_at_def)
    apply (drule get_tcb_SomeD)
@@ -380,22 +512,37 @@ lemma threadset_corresT:
 lemmas threadset_corres =
     threadset_corresT [OF _ _ all_tcbI, OF _ ball_tcb_cap_casesI ball_tcb_cte_casesI]
 
+lemma pspace_relation_tcb_at:
+  assumes p: "pspace_relation (kheap a) (ksPSpace c)"
+  assumes t: "tcb_at' t c"
+  shows "tcb_at t a" using assms
+  apply (clarsimp simp: obj_at'_def projectKOs)
+  apply (erule(1) pspace_dom_relatedE)
+  apply (erule(1) obj_relation_cutsE)
+  apply (clarsimp simp: other_obj_relation_def is_tcb obj_at_def
+                 split: Structures_A.kernel_object.split_asm if_split_asm
+                        ARM_A.arch_kernel_obj.split_asm)+
+  done
+
 lemma threadSet_corres_noopT:
   assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow>
                          tcb_relation tcb (fn tcb')"
   assumes y: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases.
                  getF (fn tcb) = getF tcb"
-  shows      "corres dc \<top> (tcb_at' t)
-                           (return v) (threadSet fn t)"
+  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')"
+  shows      "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+                        (return v) (threadSet fn t)"
 proof -
   have S: "\<And>t s. tcb_at t s \<Longrightarrow> return v s = (thread_set id t >>= (\<lambda>x. return v)) s"
     apply (clarsimp simp: tcb_at_def)
-    apply (clarsimp simp: return_def thread_set_def gets_the_def
-                          assert_opt_def simpler_gets_def set_object_def get_object_def
-                          put_def get_def bind_def assert_def a_type_def[split_simps kernel_object.split arch_kernel_obj.split]
-                   dest!: get_tcb_SomeD)
+    apply (simp add: return_def thread_set_def gets_the_def assert_def
+                     assert_opt_def simpler_gets_def set_object_def get_object_def
+                     put_def get_def bind_def)
     apply (subgoal_tac "(kheap s)(t \<mapsto> TCB tcb) = kheap s", simp)
-     apply (simp add: map_upd_triv get_tcb_SomeD)
+     apply (simp add: map_upd_triv get_tcb_SomeD)+
     done
   show ?thesis
     apply (rule stronger_corres_guard_imp)
@@ -403,16 +550,17 @@ proof -
        defer
        apply (subst bind_return [symmetric],
               rule corres_underlying_split [OF threadset_corresT])
-            apply (simp add: x)
-           apply simp
-          apply (rule y)
-        apply (rule corres_noop [where P=\<top> and P'=\<top>])
-         apply wpsimp+
-      apply (fastforce dest: pspace_relation_tcb_at
-                       simp: state_relation_def opt_map_def obj_at'_def projectKOs
-                      split: option.splits)
-     apply clarsimp
-    apply simp
+                apply (simp add: x)
+               apply simp
+              apply (rule y)
+             apply (fastforce simp: s)
+            apply (fastforce simp: s)
+           apply (fastforce simp: f)
+          apply (rule e)
+         apply (rule corres_noop [where P=\<top> and P'=\<top>])
+          apply simp
+         apply (rule no_fail_pre, wpsimp+)[1]
+        apply wpsimp+
     done
 qed
 
@@ -426,13 +574,21 @@ lemma threadSet_corres_noop_splitT:
                  getF (fn tcb) = getF tcb"
   assumes z: "corres r P Q' m m'"
   assumes w: "\<lbrace>P'\<rbrace> threadSet fn t \<lbrace>\<lambda>x. Q'\<rbrace>"
-  shows      "corres r P (tcb_at' t and P')
+  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')"
+  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 (simp add: x)
+           apply (rule y)
+          apply (fastforce simp: s)
+         apply (fastforce simp: s)
+        apply (fastforce simp: f)
+       apply (rule e)
       apply (rule z)
      apply (wp w)+
    apply simp
@@ -442,6 +598,15 @@ lemma threadSet_corres_noop_splitT:
 lemmas threadSet_corres_noop_split =
     threadSet_corres_noop_splitT [OF _ all_tcbI, OF _ ball_tcb_cte_casesI]
 
+lemma threadSet_tcb' [wp]:
+  "\<lbrace>tcb_at' t\<rbrace> threadSet f t' \<lbrace>\<lambda>rv. tcb_at' t\<rbrace>"
+  by (simp add: threadSet_def) wp
+
+lemma threadSet_nosch[wp]:
+  "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
+  unfolding threadSet_def
+  by (simp add: updateObject_default_def | wp setObject_nosch)+
+
 (* The function "thread_set f p" updates a TCB at p using function f.
    It should not be used to change capabilities, though. *)
 lemma setObject_tcb_valid_objs:
@@ -451,9 +616,16 @@ lemma setObject_tcb_valid_objs:
   done
 
 lemma setObject_tcb_at':
-  "\<lbrace>\<lambda>s. P (tcb_at' t' s)\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv s. P (tcb_at' t' s)\<rbrace>"
-  apply (subst typ_at_tcb'[symmetric])+
-  apply (rule setObject_typ_at')
+  "\<lbrace>tcb_at' t'\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
+  apply (rule obj_at_setObject1)
+   apply (clarsimp simp: updateObject_default_def return_def in_monad)
+  apply (simp add: objBits_simps)
+  done
+
+lemma setObject_sa_unchanged:
+  "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv s.  P (ksSchedulerAction s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp | simp add: updateObject_default_def)+
   done
 
 lemma setObject_queues_unchanged:
@@ -463,6 +635,22 @@ lemma setObject_queues_unchanged:
   apply (wp inv | simp)+
   done
 
+lemma setObject_queues_unchanged_tcb[wp]:
+  "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv s. P (ksReadyQueues s)\<rbrace>"
+  apply (rule setObject_queues_unchanged)
+  apply (wp|simp add: updateObject_default_def)+
+  done
+
+lemma setObject_queuesL1_unchanged_tcb[wp]:
+  "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
+  by (clarsimp simp: setObject_def split_def)
+     (wp | simp add: updateObject_default_def)+
+
+lemma setObject_queuesL2_unchanged_tcb[wp]:
+  "\<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
+  by (clarsimp simp: setObject_def split_def)
+     (wp | simp add: updateObject_default_def)+
+
 lemma setObject_tcb_ctes_of[wp]:
   "\<lbrace>\<lambda>s. P (ctes_of s) \<and>
      obj_at' (\<lambda>t. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF t = getF v) t s\<rbrace>
@@ -488,8 +676,7 @@ lemma setObject_tcb_mdb' [wp]:
 
 lemma setObject_tcb_state_refs_of'[wp]:
   "\<lbrace>\<lambda>s. P ((state_refs_of' s) (t := tcb_st_refs_of' (tcbState v)
-                                  \<union> tcb_bound_refs' (tcbBoundNotification v) (tcbSchedContext v)
-                                                    (tcbYieldTo v)))\<rbrace>
+                                  \<union> tcb_bound_refs' (tcbBoundNotification v)))\<rbrace>
      setObject t (v :: tcb) \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   by (wp setObject_state_refs_of',
       simp_all add: objBits_simps' fun_upd_def)
@@ -506,30 +693,24 @@ lemma setObject_tcb_iflive':
                          in_magnitude_check objBits_simps' prod_eq_iff
                          obj_at'_def)
    apply fastforce
-  apply (clarsimp simp: updateObject_default_def bind_def projectKOs in_monad)
+  apply (clarsimp simp: updateObject_default_def bind_def projectKOs)
   done
 
 lemma setObject_tcb_idle':
-  "\<lbrace>\<lambda>s. valid_idle' s \<and> (t = ksIdleThread s \<longrightarrow> idle_tcb' v)\<rbrace>
+  "\<lbrace>\<lambda>s. valid_idle' s \<and>
+     (t = ksIdleThread s \<longrightarrow> idle' (tcbState v) \<and> tcbBoundNotification v = None)\<rbrace>
      setObject t (v :: tcb) \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
   apply (rule hoare_pre)
   apply (rule setObject_idle')
       apply (simp add: objBits_simps')+
    apply (simp add: updateObject_default_inv)
-  apply (simp add: projectKOs idle_tcb_ps_def idle_sc_ps_def)
+  apply (simp add: projectKOs idle_tcb_ps_def idle_tcb'_def)
   done
 
-lemma setObject_sc_idle':
-  "\<lbrace>\<lambda>s. valid_idle' s  \<and> (t = idle_sc_ptr \<longrightarrow> idle_sc' v)\<rbrace>
-   setSchedContext t v
-   \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
-  apply (clarsimp simp: setSchedContext_def)
-  apply (rule hoare_pre)
-  apply (rule setObject_idle')
-     apply (simp add: objBits_simps')
-    apply (simp add: objBits_simps' scBits_pos_power2)
-   apply (simp add: updateObject_default_inv)
-  apply (simp add: projectKOs idle_tcb_ps_def idle_sc_ps_def)
+lemma setObject_tcb_irq_node'[wp]:
+  "\<lbrace>\<lambda>s. P (irq_node' s)\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv s. P (irq_node' s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
   done
 
 lemma setObject_tcb_ifunsafe':
@@ -541,10 +722,21 @@ lemma setObject_tcb_ifunsafe':
                           in_magnitude_check objBits_simps' prod_eq_iff
                           obj_at'_def)
     apply fastforce
-   apply (clarsimp simp: updateObject_default_def bind_def projectKOs in_monad)
+   apply (clarsimp simp: updateObject_default_def bind_def projectKOs)
+  apply wp
+  done
+
+lemma setObject_tcb_arch' [wp]:
+  "\<lbrace>\<lambda>s. P (ksArchState s)\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv s. P (ksArchState s)\<rbrace>"
+  apply (simp add: setObject_def split_def updateObject_default_def)
   apply wp
+  apply simp
   done
 
+lemma setObject_tcb_valid_arch' [wp]:
+  "\<lbrace>valid_arch_state'\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv. valid_arch_state'\<rbrace>"
+  by (wp valid_arch_state_lift' setObject_typ_at')
+
 lemma setObject_tcb_refs' [wp]:
   "\<lbrace>\<lambda>s. P (global_refs' s)\<rbrace> setObject t (v::tcb) \<lbrace>\<lambda>rv s. P (global_refs' s)\<rbrace>"
   apply (clarsimp simp: setObject_def split_def updateObject_default_def)
@@ -571,6 +763,37 @@ lemma setObject_tcb_valid_globals' [wp]:
    apply (wp | wp setObject_ksPSpace_only updateObject_default_inv | simp)+
   done
 
+lemma setObject_tcb_irq_states' [wp]:
+  "\<lbrace>valid_irq_states'\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv. valid_irq_states'\<rbrace>"
+  apply (rule hoare_pre)
+   apply (rule hoare_use_eq [where f=ksInterruptState, OF setObject_ksInterrupt])
+    apply (simp, rule updateObject_default_inv)
+   apply (rule hoare_use_eq [where f=ksMachineState, OF setObject_ksMachine])
+    apply (simp, rule updateObject_default_inv)
+   apply wp
+  apply assumption
+  done
+
+lemma getObject_tcb_wp:
+  "\<lbrace>\<lambda>s. tcb_at' p s \<longrightarrow> (\<exists>t::tcb. ko_at' t p s \<and> Q t s)\<rbrace> getObject p \<lbrace>Q\<rbrace>"
+  by (clarsimp simp: getObject_def valid_def in_monad
+                     split_def objBits_simps' loadObject_default_def
+                     projectKOs obj_at'_def in_magnitude_check)
+
+lemma setObject_tcb_pspace_no_overlap':
+  "\<lbrace>pspace_no_overlap' w s and tcb_at' t\<rbrace>
+  setObject t (tcb::tcb)
+  \<lbrace>\<lambda>rv. pspace_no_overlap' w s\<rbrace>"
+  apply (clarsimp simp: setObject_def split_def valid_def in_monad)
+  apply (clarsimp simp: obj_at'_def projectKOs)
+  apply (erule (1) ps_clear_lookupAround2)
+    apply (rule order_refl)
+   apply (erule is_aligned_no_overflow)
+   apply simp
+  apply (clarsimp simp: updateObject_default_def in_monad projectKOs objBits_simps in_magnitude_check)
+  apply (fastforce simp: pspace_no_overlap'_def objBits_simps)
+  done
+
 lemma threadSet_pspace_no_overlap' [wp]:
   "\<lbrace>pspace_no_overlap' w s\<rbrace> threadSet f t \<lbrace>\<lambda>rv. pspace_no_overlap' w s\<rbrace>"
   apply (simp add: threadSet_def)
@@ -590,60 +813,39 @@ lemma threadSet_global_refsT:
 lemmas threadSet_global_refs[wp] =
     threadSet_global_refsT [OF all_tcbI, OF ball_tcb_cte_casesI]
 
-lemma setObject_tcb_valid_replies':
-  "\<lbrace>\<lambda>s. valid_replies' s \<and>
-        (\<forall>rptr. st_tcb_at' ((=) (BlockedOnReply (Some rptr))) t s
-                  \<longrightarrow> tcbState v = BlockedOnReply (Some rptr)
-                      \<or> \<not> is_reply_linked rptr s)\<rbrace>
-   setObject t (v :: tcb)
-   \<lbrace>\<lambda>rv. valid_replies'\<rbrace>"
-  unfolding valid_replies'_def pred_tcb_at'_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_ex_lift
-                    set_tcb'.setObject_obj_at'_strongest)
-  apply (rename_tac rptr)
-  apply (rule ccontr, clarsimp simp flip: imp_disjL)
-  apply (drule_tac x=rptr in spec, drule mp, assumption)
-  apply (auto simp: opt_map_def)
-  done
-
 lemma threadSet_valid_pspace'T_P:
   assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
   assumes z: "\<forall>tcb. (P \<longrightarrow> Q (tcbState tcb)) \<longrightarrow>
                      (\<forall>s. valid_tcb_state' (tcbState tcb) s
                               \<longrightarrow> valid_tcb_state' (tcbState (F tcb)) s)"
-  assumes z': "\<forall>tcb. (P \<longrightarrow> Q (tcbState tcb)) \<longrightarrow>
-                      (\<forall>rptr. (tcbState tcb = BlockedOnReply rptr)
-                                 \<longrightarrow> (tcbState (F tcb) = BlockedOnReply rptr))"
-  assumes v1: "\<forall>tcb. (P \<longrightarrow> Q' (tcbBoundNotification tcb)) \<longrightarrow>
-                      (\<forall>s. valid_bound_ntfn' (tcbBoundNotification tcb) s
+  assumes v: "\<forall>tcb. (P \<longrightarrow> Q' (tcbBoundNotification tcb)) \<longrightarrow>
+                     (\<forall>s. valid_bound_ntfn' (tcbBoundNotification tcb) s
                               \<longrightarrow> valid_bound_ntfn' (tcbBoundNotification (F tcb)) s)"
-  assumes v2: "\<forall>tcb. (P \<longrightarrow> Q'' (tcbSchedContext tcb)) \<longrightarrow>
-                      (\<forall>s. valid_bound_sc' (tcbSchedContext tcb) s
-                              \<longrightarrow> valid_bound_sc' (tcbSchedContext (F tcb)) s)"
-  assumes v3: "\<forall>tcb. (P \<longrightarrow> Q''' (tcbYieldTo tcb)) \<longrightarrow>
-                      (\<forall>s. valid_bound_sc' (tcbYieldTo tcb) s
-                              \<longrightarrow> valid_bound_sc' (tcbYieldTo (F tcb)) s)"
-
+  assumes p: "\<forall>tcb. (P \<longrightarrow> Q'' (tcbSchedPrev tcb)) \<longrightarrow>
+                      (\<forall>s. none_top tcb_at' (tcbSchedPrev tcb) s
+                              \<longrightarrow> none_top tcb_at' (tcbSchedPrev (F tcb)) s)"
+  assumes n: "\<forall>tcb. (P \<longrightarrow> Q''' (tcbSchedNext tcb)) \<longrightarrow>
+                      (\<forall>s. none_top tcb_at' (tcbSchedNext tcb) s
+                              \<longrightarrow> none_top tcb_at' (tcbSchedNext (F tcb)) s)"
   assumes y: "\<forall>tcb. is_aligned (tcbIPCBuffer tcb) msg_align_bits
                       \<longrightarrow> is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"
   assumes u: "\<forall>tcb. tcbDomain tcb \<le> maxDomain \<longrightarrow> tcbDomain (F tcb) \<le> maxDomain"
   assumes w: "\<forall>tcb. tcbPriority tcb \<le> maxPriority \<longrightarrow> tcbPriority (F tcb) \<le> maxPriority"
   assumes w': "\<forall>tcb. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
   shows
-  "\<lbrace>valid_pspace' and (\<lambda>s. P \<longrightarrow> st_tcb_at' Q t s \<and> bound_tcb_at' Q' t s \<and>
-                                 bound_sc_tcb_at' Q'' t s \<and> bound_yt_tcb_at' Q''' t s)\<rbrace>
+  "\<lbrace>valid_pspace' and (\<lambda>s. P \<longrightarrow> st_tcb_at' Q t s \<and> bound_tcb_at' Q' t s
+                                 \<and> obj_at' (\<lambda>tcb. Q'' (tcbSchedPrev tcb)) t s
+                                 \<and> obj_at' (\<lambda>tcb. Q''' (tcbSchedNext tcb)) t s)\<rbrace>
    threadSet F t
-   \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
+   \<lbrace>\<lambda>_. valid_pspace'\<rbrace>"
   apply (simp add: valid_pspace'_def threadSet_def)
   apply (rule hoare_pre,
-         wpsimp wp: setObject_tcb_valid_objs setObject_tcb_valid_replies'
-                    getObject_tcb_wp)
+         wp setObject_tcb_valid_objs getObject_tcb_wp)
   apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def)
   apply (erule(1) valid_objsE')
   apply (clarsimp simp add: valid_obj'_def valid_tcb'_def
                             bspec_split [OF spec [OF x]] z
-                            split_paired_Ball y u w v1 v2 v3 w')
-  apply (drule sym, fastforce simp: z')
+                            split_paired_Ball y u w v w' p n)
   done
 
 lemmas threadSet_valid_pspace'T =
@@ -664,88 +866,48 @@ lemmas threadSet_ifunsafe' =
     threadSet_ifunsafe'T [OF all_tcbI, OF ball_tcb_cte_casesI]
 
 lemma threadSet_state_refs_of'_helper[simp]:
-  "{r. (r \<in> tcb_st_refs_of' ts \<or> r \<in> tcb_bound_refs' ntfnptr sc_ptr yt_ptr)
-       \<and> (snd r = TCBBound \<or> snd r = TCBSchedContext \<or> snd r = TCBYieldTo)}
-   = tcb_bound_refs' ntfnptr sc_ptr yt_ptr"
-  by (auto simp: tcb_st_refs_of'_def tcb_bound_refs'_def get_refs_def
-          split: thread_state.splits reftype.splits option.splits)
+  "{r. (r \<in> tcb_st_refs_of' ts \<or>
+       r \<in> tcb_bound_refs' ntfnptr) \<and>
+      snd r = TCBBound} =
+   tcb_bound_refs' ntfnptr"
+  by (auto simp: tcb_st_refs_of'_def tcb_bound_refs'_def
+          split: thread_state.splits)
 
 lemma threadSet_state_refs_of'_helper'[simp]:
-  "{r. (r \<in> tcb_st_refs_of' ts \<or> r \<in> tcb_bound_refs' ntfnptr sc_ptr yt_ptr)
-       \<and> (snd r \<noteq> TCBBound \<and> snd r \<noteq> TCBSchedContext \<and> snd r \<noteq> TCBYieldTo)}
-   = tcb_st_refs_of' ts"
-  by (auto simp: tcb_st_refs_of'_def tcb_bound_refs'_def get_refs_def
-          split: thread_state.splits reftype.splits option.splits)
-
-lemma threadSet_state_refs_of'_helper_TCBBound[simp]:
-  "{r. (r \<in> tcb_st_refs_of' (tcbState obj)
-        \<or> r \<in> tcb_bound_refs' (tcbBoundNotification obj)(tcbSchedContext obj) (tcbYieldTo obj))
-          \<and> snd r = TCBBound}
-  = get_refs TCBBound (tcbBoundNotification obj)"
-  by (auto simp: tcb_st_refs_of'_def tcb_bound_refs'_def get_refs_def
-          split: thread_state.splits reftype.splits option.splits)
-
-lemma threadSet_state_refs_of'_helper_TCBSchedContext[simp]:
-  "{r. (r \<in> tcb_st_refs_of' (tcbState obj)
-        \<or> r \<in> tcb_bound_refs' (tcbBoundNotification obj)(tcbSchedContext obj) (tcbYieldTo obj))
-          \<and> snd r = TCBSchedContext}
-  = get_refs TCBSchedContext (tcbSchedContext obj)"
-  by (auto simp: tcb_st_refs_of'_def tcb_bound_refs'_def get_refs_def
-          split: thread_state.splits reftype.splits option.splits)
-
-lemma threadSet_state_refs_of'_helper_TCBYieldTo[simp]:
-  "{r. (r \<in> tcb_st_refs_of' (tcbState obj)
-        \<or> r \<in> tcb_bound_refs' (tcbBoundNotification obj)(tcbSchedContext obj) (tcbYieldTo obj))
-          \<and> snd r = TCBYieldTo}
-  = get_refs TCBYieldTo (tcbYieldTo obj)"
-  by (auto simp: tcb_st_refs_of'_def tcb_bound_refs'_def get_refs_def
-          split: thread_state.splits reftype.splits option.splits)
+  "{r. (r \<in> tcb_st_refs_of' ts \<or>
+        r \<in> tcb_bound_refs' ntfnptr) \<and>
+       snd r \<noteq> TCBBound} =
+   tcb_st_refs_of' ts"
+  by (auto simp: tcb_st_refs_of'_def tcb_bound_refs'_def
+          split: thread_state.splits)
 
 lemma threadSet_state_refs_of'T_P:
   assumes x: "\<forall>tcb. (P' \<longrightarrow> Q (tcbState tcb)) \<longrightarrow>
                      tcb_st_refs_of' (tcbState (F tcb))
                        = f' (tcb_st_refs_of' (tcbState tcb))"
   assumes y: "\<forall>tcb. (P' \<longrightarrow> Q' (tcbBoundNotification tcb)) \<longrightarrow>
-                     (get_refs TCBBound (tcbBoundNotification (F tcb))
-                      = (g' (get_refs TCBBound (tcbBoundNotification tcb))))"
-  assumes z: "\<forall>tcb. (P' \<longrightarrow> Q'' (tcbSchedContext tcb)) \<longrightarrow>
-                     (get_refs TCBSchedContext (tcbSchedContext (F tcb))
-                      = (h' (get_refs TCBSchedContext (tcbSchedContext tcb))))"
-  assumes w: "\<forall>tcb. (P' \<longrightarrow> Q''' (tcbYieldTo tcb)) \<longrightarrow>
-                     (get_refs TCBYieldTo (tcbYieldTo (F tcb))
-                      = (i' (get_refs TCBYieldTo (tcbYieldTo tcb))))"
+                     tcb_bound_refs' (tcbBoundNotification (F tcb))
+                       = g' (tcb_bound_refs' (tcbBoundNotification tcb))"
   shows
-  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (t := f' {r \<in> state_refs_of' s t. snd r \<notin> {TCBBound, TCBSchedContext, TCBYieldTo}}
-                                    \<union> g' {r \<in> state_refs_of' s t. snd r = TCBBound}
-                                    \<union> h' {r \<in> state_refs_of' s t. snd r = TCBSchedContext}
-                                    \<union> i' {r \<in> state_refs_of' s t. snd r = TCBYieldTo}))
-        \<and> (P' \<longrightarrow> st_tcb_at' Q t s \<and> bound_tcb_at' Q' t s \<and> bound_sc_tcb_at' Q'' t s
-                  \<and> bound_yt_tcb_at' Q''' t s)\<rbrace>
-   threadSet F t
+  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (t := f' {r \<in> state_refs_of' s t. snd r \<noteq> TCBBound}
+                                  \<union> g' {r \<in> state_refs_of' s t. snd r = TCBBound}))
+              \<and> (P' \<longrightarrow> st_tcb_at' Q t s \<and> bound_tcb_at' Q' t s)\<rbrace>
+     threadSet F t
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (simp add: threadSet_def)
   apply (wp getObject_tcb_wp)
-  apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def tcb_bound_refs'_def
+  apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def
                  elim!: rsubst[where P=P] intro!: ext)
   apply (cut_tac s=s and p=t and 'a=tcb in ko_at_state_refs_ofD')
    apply (simp add: obj_at'_def projectKOs)
-  apply (fastforce simp: x y z w)
+  apply (clarsimp simp: x y)
   done
 
 lemmas threadSet_state_refs_of'T =
     threadSet_state_refs_of'T_P [where P'=False, simplified]
 
 lemmas threadSet_state_refs_of' =
-    threadSet_state_refs_of'T [OF all_tcbI all_tcbI all_tcbI all_tcbI]
-
-lemma state_refs_of'_helper[simp]:
-  "{r \<in> state_refs_of' s t. snd r \<noteq> TCBBound \<and> snd r \<noteq> TCBSchedContext \<and> snd r \<noteq> TCBYieldTo}
-   \<union> {r \<in> state_refs_of' s t. snd r = TCBBound}
-   \<union> {r \<in> state_refs_of' s t. snd r = TCBSchedContext}
-   \<union> {r \<in> state_refs_of' s t. snd r = TCBYieldTo}
-   = state_refs_of' s t"
-  by (auto simp: tcb_st_refs_of'_def tcb_bound_refs'_def get_refs_def
-          split: thread_state.splits reftype.splits option.splits)
+    threadSet_state_refs_of'T [OF all_tcbI all_tcbI]
 
 lemma threadSet_iflive'T:
   assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
@@ -753,11 +915,6 @@ lemma threadSet_iflive'T:
   "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s
       \<and> ((\<exists>tcb. \<not> bound (tcbBoundNotification tcb) \<and> bound (tcbBoundNotification (F tcb))
               \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
-      \<and> ((\<exists>tcb. \<not> bound (tcbYieldTo tcb) \<and> bound (tcbYieldTo (F tcb))
-              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
-      \<and> ((\<exists>tcb. (\<not> bound (tcbSchedContext tcb) \<or> tcbSchedContext tcb = Some idle_sc_ptr)
-              \<and> bound (tcbSchedContext (F tcb)) \<and> tcbSchedContext (F tcb) \<noteq> Some idle_sc_ptr
-              \<and> ko_at' tcb t s) \<longrightarrow> ex_nonz_cap_to' t s)
       \<and> ((\<exists>tcb. (tcbState tcb = Inactive \<or> tcbState tcb = IdleThreadState)
               \<and> tcbState (F tcb) \<noteq> Inactive
               \<and> tcbState (F tcb) \<noteq> IdleThreadState
@@ -778,9 +935,6 @@ lemma threadSet_iflive'T:
    apply (rule impI, clarsimp)
    apply (erule if_live_then_nonz_capE')
    apply (clarsimp simp: ko_wp_at'_def)
-  apply (intro conjI)
-    apply (metis if_live_then_nonz_capE' ko_wp_at'_def live'.simps(1))
-   apply (metis if_live_then_nonz_capE' ko_wp_at'_def live'.simps(1))
   apply (clarsimp simp: bspec_split [OF spec [OF x]])
   done
 
@@ -806,13 +960,6 @@ lemma threadSet_cte_wp_at'T:
 lemmas threadSet_cte_wp_at' =
   threadSet_cte_wp_at'T [OF all_tcbI, OF ball_tcb_cte_casesI]
 
-lemmas threadSet_cap_to' = ex_nonz_cap_to_pres' [OF threadSet_cte_wp_at']
-
-lemma threadSet_cap_to:
-  "(\<And>tcb. \<forall>(getF, v)\<in>ran tcb_cte_cases. getF (f tcb) = getF tcb)
-  \<Longrightarrow> \<lbrace>ex_nonz_cap_to' p\<rbrace> threadSet f tptr \<lbrace>\<lambda>_. ex_nonz_cap_to' p\<rbrace>"
-  by (wpsimp wp: hoare_vcg_ex_lift threadSet_cte_wp_at' simp: ex_nonz_cap_to'_def tcb_cte_cases_def)
-
 lemma threadSet_ctes_ofT:
   assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases.
                  getF (F tcb) = getF tcb"
@@ -827,9 +974,7 @@ lemma threadSet_ctes_ofT:
 lemmas threadSet_ctes_of =
     threadSet_ctes_ofT [OF all_tcbI, OF ball_tcb_cte_casesI]
 
-lemmas threadSet_cteCaps_of = ctes_of_cteCaps_of_lift [OF threadSet_ctes_of]
-
-lemmas threadSet_urz = untyped_ranges_zero_lift[where f="cteCaps_of", OF _ threadSet_cteCaps_of]
+lemmas threadSet_cap_to' = ex_nonz_cap_to_pres' [OF threadSet_cte_wp_at']
 
 lemma threadSet_cap_to:
   "(\<And>tcb. \<forall>(getF, v)\<in>ran tcb_cte_cases. getF (f tcb) = getF tcb)
@@ -838,42 +983,65 @@ lemma threadSet_cap_to:
            simp: ex_nonz_cap_to'_def tcb_cte_cases_def objBits_simps')
 
 lemma threadSet_idle'T:
+  assumes x: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
   shows
   "\<lbrace>\<lambda>s. valid_idle' s
-        \<and> (t = ksIdleThread s \<longrightarrow> (\<forall>tcb. ko_at' tcb t s \<and> idle_tcb' tcb \<longrightarrow> idle_tcb' (F tcb)))\<rbrace>
-   threadSet F t
+      \<and> (t = ksIdleThread s \<longrightarrow>
+          (\<forall>tcb. ko_at' tcb t s \<and> idle_tcb' tcb \<longrightarrow> idle_tcb' (F tcb)))\<rbrace>
+     threadSet F t
    \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
   apply (simp add: threadSet_def)
-  apply (wpsimp wp: setObject_tcb_idle' getObject_tcb_wp
-              simp: obj_at'_def projectKOs valid_idle'_def pred_tcb_at'_def threadSet_def)
+  apply (wp setObject_tcb_idle' getObject_tcb_wp)
+  apply (clarsimp simp: obj_at'_def projectKOs)
+  apply (clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def projectKOs idle_tcb'_def)
   done
 
 lemmas threadSet_idle' =
-    (*threadSet_idle'T [OF all_tcbI, OF ball_tcb_cte_casesI]*)
-    threadSet_idle'T
+    threadSet_idle'T [OF all_tcbI, OF ball_tcb_cte_casesI]
+
+lemma set_tcb_valid_bitmapQ[wp]:
+  "\<lbrace> valid_bitmapQ \<rbrace> setObject t (f tcb :: tcb) \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
+  apply (rule setObject_tcb_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
+  done
+
+lemma set_tcb_bitmapQ_no_L1_orphans[wp]:
+  "\<lbrace> bitmapQ_no_L1_orphans \<rbrace> setObject t (f tcb :: tcb) \<lbrace>\<lambda>_. bitmapQ_no_L1_orphans \<rbrace>"
+  apply (rule setObject_tcb_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
+  done
+
+lemma set_tcb_bitmapQ_no_L2_orphans[wp]:
+  "\<lbrace> bitmapQ_no_L2_orphans \<rbrace> setObject t (f tcb :: tcb) \<lbrace>\<lambda>_. bitmapQ_no_L2_orphans \<rbrace>"
+  apply (rule setObject_tcb_pre)
+  apply (simp add: bitmapQ_defs setObject_def split_def)
+  apply (wp hoare_Ball_helper hoare_vcg_all_lift updateObject_default_inv | simp add: bitmapQ_def)+
+  done
 
 lemma threadSet_valid_bitmapQ[wp]:
   "\<lbrace> valid_bitmapQ \<rbrace> threadSet f t \<lbrace> \<lambda>rv. valid_bitmapQ \<rbrace>"
   unfolding bitmapQ_defs threadSet_def
   by (clarsimp simp: setObject_def split_def)
-     (wp | simp add: updateObject_default_def objBits_simps)+
+     (wp | simp add: updateObject_default_def)+
 
 lemma threadSet_valid_bitmapQ_no_L1_orphans[wp]:
   "\<lbrace> bitmapQ_no_L1_orphans \<rbrace> threadSet f t \<lbrace> \<lambda>rv. bitmapQ_no_L1_orphans \<rbrace>"
   unfolding bitmapQ_defs threadSet_def
   by (clarsimp simp: setObject_def split_def)
-     (wp | simp add: updateObject_default_def objBits_simps)+
+     (wp | simp add: updateObject_default_def)+
 
 lemma threadSet_valid_bitmapQ_no_L2_orphans[wp]:
   "\<lbrace> bitmapQ_no_L2_orphans \<rbrace> threadSet f t \<lbrace> \<lambda>rv. bitmapQ_no_L2_orphans \<rbrace>"
   unfolding bitmapQ_defs threadSet_def
   by (clarsimp simp: setObject_def split_def)
-     (wp | simp add: updateObject_default_def objBits_simps)+
+     (wp | simp add: updateObject_default_def)+
 
 lemma threadSet_cur:
   "\<lbrace>\<lambda>s. cur_tcb' s\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. cur_tcb' s\<rbrace>"
-  apply (wpsimp simp: threadSet_def cur_tcb'_def
-                  wp: hoare_lift_Pf[OF setObject_tcb_at' setObject_ct_inv])
+  apply (simp add: threadSet_def cur_tcb'_def)
+  apply (wp hoare_lift_Pf [OF setObject_tcb_at'] setObject_ct_inv)
   done
 
 lemma modifyReadyQueuesL1Bitmap_obj_at[wp]:
@@ -887,17 +1055,22 @@ crunch setThreadState, setBoundNotification
   for valid_arch' [wp]: valid_arch_state'
   (simp: unless_def crunch_simps wp: crunch_wps)
 
+crunch threadSet
+  for ksInterrupt'[wp]: "\<lambda>s. P (ksInterruptState s)"
+  (wp: setObject_ksInterrupt updateObject_default_inv)
+
 lemma threadSet_typ_at'[wp]:
   "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> threadSet t F \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
-  by (wpsimp simp: threadSet_def wp: setObject_typ_at')
+  by (simp add: threadSet_def, wp setObject_typ_at')
+
+lemmas threadSet_typ_at_lifts[wp] = typ_at_lifts [OF threadSet_typ_at']
 
 lemma setObject_tcb_pde_mappings'[wp]:
   "\<lbrace>valid_pde_mappings'\<rbrace> setObject p (tcb :: tcb) \<lbrace>\<lambda>rv. valid_pde_mappings'\<rbrace>"
-  by (wpsimp wp: valid_pde_mappings_lift' setObject_typ_at')
-
-lemma setObject_sc_pde_mappings'[wp]:
-  "\<lbrace>valid_pde_mappings'\<rbrace> setObject p (sc :: sched_context) \<lbrace>\<lambda>rv. valid_pde_mappings'\<rbrace>"
-  by (wpsimp wp: valid_pde_mappings_lift' setObject_typ_at')
+  apply (wp valid_pde_mappings_lift' setObject_typ_at')
+  apply (rule obj_at_setObject2)
+  apply (auto dest: updateObject_default_result)
+  done
 
 crunch threadSet
   for irq_states' [wp]: valid_irq_states'
@@ -913,9 +1086,10 @@ lemma threadSet_obj_at'_really_strongest:
     apply (rule hoare_post_imp[where Q'="\<lambda>rv s. \<not> tcb_at' t s \<and> tcb_at' t s"])
      apply simp
     apply (subst simp_thms(21)[symmetric], rule hoare_vcg_conj_lift)
-     apply (rule getObject_tcb_inv)
+     apply (rule getObject_inv_tcb)
     apply (rule hoare_strengthen_post [OF getObject_ko_at])
-     apply simp
+      apply simp
+     apply (simp add: objBits_simps')
     apply (erule obj_at'_weakenE)
     apply simp
    apply (cases "t = t'", simp_all)
@@ -1003,17 +1177,37 @@ proof -
      apply (clarsimp)
      apply (frule_tac P=P' and Q="\<lambda>tcb. \<not> P' tcb" in pred_tcb_at_conj')
      apply (clarsimp)+
-    apply (wp hoare_convert_imp pos)
-    apply (clarsimp simp: tcb_at_typ_at' pred_tcb_at'_def not_obj_at'
-                   elim!: obj_at'_weakenE)
+    apply (wp hoare_convert_imp)
+      apply (simp add: typ_at_tcb' [symmetric])
+      apply (wp pos)+
+    apply (clarsimp simp: pred_tcb_at'_def not_obj_at' elim!: obj_at'_weakenE)
     done
 qed
 
-lemma threadSet_mdb':
-  "\<lbrace>valid_mdb' and obj_at' (\<lambda>t. \<forall>(getF, setF) \<in> ran tcb_cte_cases. getF t = getF (f t)) t\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
-  by (wpsimp wp: setObject_tcb_mdb' getTCB_wp simp: threadSet_def obj_at'_def)
+lemma threadSet_ct[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wp setObject_ct_inv)
+  done
+
+lemma threadSet_cd[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. P (ksCurDomain s)\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wp setObject_cd_inv)
+  done
+
+
+lemma threadSet_ksDomSchedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wp setObject_ksDomSchedule_inv)
+  done
+
+lemma threadSet_it[wp]:
+  "\<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> threadSet f t \<lbrace>\<lambda>rv s. P (ksIdleThread s)\<rbrace>"
+  apply (simp add: threadSet_def)
+  apply (wp setObject_it_inv)
+  done
 
 lemma threadSet_sch_act:
   "(\<And>tcb. tcbState (F tcb) = tcbState tcb \<and> tcbDomain (F tcb) = tcbDomain tcb) \<Longrightarrow>
@@ -1037,11 +1231,11 @@ lemma threadSet_sch_actT_P:
   apply (case_tac P, simp_all add: threadSet_sch_act)
   apply (clarsimp simp: valid_def)
   apply (frule_tac P1="\<lambda>sa. sch_act_wf sa s"
-                in use_valid [OF _ threadSet.ksSchedulerAction], assumption)
+                in use_valid [OF _ threadSet_nosch], assumption)
   apply (frule_tac P1="(=) (ksCurThread s)"
-                in use_valid [OF _ threadSet.ct], rule refl)
+                in use_valid [OF _ threadSet_ct], rule refl)
   apply (frule_tac P1="(=) (ksCurDomain s)"
-                in use_valid [OF _ threadSet.cur_domain], rule refl)
+                in use_valid [OF _ threadSet_cd], rule refl)
   apply (case_tac "ksSchedulerAction b",
          simp_all add: ct_in_state'_def pred_tcb_at'_def)
    apply (subgoal_tac "t \<noteq> ksCurThread s")
@@ -1086,7 +1280,7 @@ lemma threadSet_not_inQ:
   apply (simp add: threadSet_def ct_not_inQ_def)
   apply (wp)
     apply (rule hoare_convert_imp [OF setObject_nosch])
-     apply (wpsimp wp: updateObject_default_inv)
+     apply (rule updateObject_tcb_inv)
     apply (wps setObject_ct_inv)
     apply (wp setObject_tcb_strongest getObject_tcb_wp)+
   apply (case_tac "t = ksCurThread s")
@@ -1094,9 +1288,8 @@ lemma threadSet_not_inQ:
   done
 
 lemma threadSet_invs_trivial_helper[simp]:
-  "{r \<in> state_refs_of' s t. snd r \<noteq> TCBBound \<and> snd r \<noteq> TCBSchedContext \<and> snd r \<noteq> TCBYieldTo}
-    \<union> {r \<in> state_refs_of' s t. (snd r = TCBBound \<or> snd r = TCBSchedContext \<or> snd r = TCBYieldTo)}
-   = state_refs_of' s t"
+  "{r \<in> state_refs_of' s t. snd r \<noteq> TCBBound}
+   \<union> {r \<in> state_refs_of' s t. snd r = TCBBound} = state_refs_of' s t"
   by auto
 
 lemma threadSet_ct_idle_or_in_cur_domain':
@@ -1105,9 +1298,24 @@ lemma threadSet_ct_idle_or_in_cur_domain':
       apply (wp hoare_vcg_disj_lift| simp)+
   done
 
+crunch threadSet
+  for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+  (wp: setObject_ksPSpace_only updateObject_default_inv)
+crunch threadSet
+  for gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  (wp: setObject_ksPSpace_only updateObject_default_inv)
+
+lemma setObject_tcb_ksDomScheduleIdx [wp]:
+  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s) \<rbrace> setObject t (v::tcb) \<lbrace>\<lambda>_ s. P (ksDomScheduleIdx s)\<rbrace>"
+  apply (simp add:setObject_def)
+  apply (simp add: updateObject_default_def in_monad)
+  apply (wp|wpc)+
+  apply (simp add: projectKOs)
+  done
+
 lemma threadSet_valid_dom_schedule':
   "\<lbrace> valid_dom_schedule'\<rbrace> threadSet F t \<lbrace>\<lambda>_. valid_dom_schedule'\<rbrace>"
-  unfolding threadSet_def valid_dom_schedule'_def
+  unfolding threadSet_def
   by (wp setObject_ksDomSchedule_inv hoare_Ball_helper)
 
 lemma threadSet_wp:
@@ -1223,30 +1431,10 @@ lemma global'_no_ex_cap:
   apply (clarsimp simp: cte_wp_at'_def dest!: zobj_refs'_capRange, blast)
   done
 
-lemma global'_sc_no_ex_cap:
-  "\<lbrakk>valid_global_refs' s; valid_pspace' s\<rbrakk> \<Longrightarrow> \<not> ex_nonz_cap_to' idle_sc_ptr s"
-  apply (clarsimp simp: ex_nonz_cap_to'_def valid_global_refs'_def valid_refs'_def2 valid_pspace'_def)
-  apply (drule cte_wp_at_norm', clarsimp)
-  apply (frule(1) cte_wp_at_valid_objs_valid_cap', clarsimp)
-  apply (clarsimp simp: cte_wp_at'_def dest!: zobj_refs'_capRange, blast)
-  done
-
 lemma getObject_tcb_sp:
   "\<lbrace>P\<rbrace> getObject r \<lbrace>\<lambda>t::tcb. P and ko_at' t r\<rbrace>"
   by (wp getObject_obj_at'; simp)
 
-lemma threadGet_sp':
-  "\<lbrace>P\<rbrace> threadGet f p \<lbrace>\<lambda>t. obj_at' (\<lambda>t'. f t' = t) p and P\<rbrace>"
-  including no_pre
-  apply (simp add: threadGet_getObject)
-  apply wp
-  apply (rule hoare_strengthen_post)
-   apply (rule getObject_tcb_sp)
-  apply clarsimp
-  apply (erule obj_at'_weakenE)
-  apply simp
-  done
-
 lemma threadSet_valid_objs':
   "\<lbrace>valid_objs' and (\<lambda>s. \<forall>tcb. valid_tcb' tcb s \<longrightarrow> valid_tcb' (f tcb) s)\<rbrace>
   threadSet f t
@@ -1269,7 +1457,7 @@ lemma threadSet_valid_objs':
 lemmas typ_at'_valid_tcb'_lift =
   typ_at'_valid_obj'_lift[where obj="KOTCB tcb" for tcb, unfolded valid_obj'_def, simplified]
 
-lemmas setObject_valid_tcb' = typ_at'_valid_tcb'_lift[OF setObject_typ_at' setObject_sc_at'_n]
+lemmas setObject_valid_tcb' = typ_at'_valid_tcb'_lift[OF setObject_typ_at']
 
 lemma setObject_valid_tcbs':
   assumes preserve_valid_tcb': "\<And>s s' ko ko' x n tcb tcb'.
@@ -1302,13 +1490,13 @@ lemma setObject_valid_tcbs':
 lemma setObject_tcb_valid_tcbs':
   "\<lbrace>valid_tcbs' and (tcb_at' t and valid_tcb' v)\<rbrace> setObject t (v :: tcb) \<lbrace>\<lambda>rv. valid_tcbs'\<rbrace>"
   apply (rule setObject_valid_tcbs')
-  apply (clarsimp simp: updateObject_default_def in_monad projectKOs project_inject)
+  apply (clarsimp simp: updateObject_default_def in_monad project_inject)
   done
 
 lemma threadSet_valid_tcb':
   "\<lbrace>valid_tcb' tcb and (\<lambda>s. \<forall>tcb. valid_tcb' tcb s \<longrightarrow> valid_tcb' (f tcb) s)\<rbrace>
    threadSet f t
-   \<lbrace>\<lambda>rv. valid_tcb' tcb\<rbrace>"
+   \<lbrace>\<lambda>_. valid_tcb' tcb\<rbrace>"
   apply (simp add: threadSet_def)
   apply (wpsimp wp: setObject_valid_tcb')
   done
@@ -1316,18 +1504,18 @@ lemma threadSet_valid_tcb':
 lemma threadSet_valid_tcbs':
   "\<lbrace>valid_tcbs' and (\<lambda>s. \<forall>tcb. valid_tcb' tcb s \<longrightarrow> valid_tcb' (f tcb) s)\<rbrace>
    threadSet f t
-   \<lbrace>\<lambda>rv. valid_tcbs'\<rbrace>"
+   \<lbrace>\<lambda>_. valid_tcbs'\<rbrace>"
   apply (simp add: threadSet_def)
-  apply (rule bind_wp[OF _ get_tcb_sp'])
+  apply (rule bind_wp[OF _ getObject_tcb_sp])
   apply (wpsimp wp: setObject_tcb_valid_tcbs')
-  apply (clarsimp simp: obj_at'_def projectKOs valid_tcbs'_def)
+  apply (clarsimp simp: obj_at'_def valid_tcbs'_def projectKOs)
   done
 
 lemma asUser_valid_tcbs'[wp]:
   "asUser t f \<lbrace>valid_tcbs'\<rbrace>"
   apply (simp add: asUser_def split_def)
   apply (wpsimp wp: threadSet_valid_tcbs' hoare_drop_imps
-              simp: valid_tcb'_def tcb_cte_cases_def)
+              simp: valid_tcb'_def tcb_cte_cases_def objBits_simps')
   done
 
 lemma asUser_corres':
@@ -1345,11 +1533,11 @@ proof -
     apply (rule corres_cross_over_guard[where Q="tcb_at' t"])
      apply (fastforce simp: tcb_at_cross state_relation_def)
     apply (rule corres_guard_imp)
-      apply (simp add: threadGet_getObject)
-      apply (rule corres_bind_return)
-      apply (rule corres_split[OF getObject_TCB_corres])
-        apply (simp add: tcb_relation_def arch_tcb_relation_def)
-       apply wpsimp+
+      apply (rule corres_gets_the)
+      apply (simp add: threadGet_def)
+      apply (rule corres_rel_imp [OF corres_get_tcb])
+      apply (simp add: tcb_relation_def arch_tcb_relation_def)
+     apply (simp add: tcb_at_def)+
     done
   have L2: "\<And>tcb tcb' con con'. \<lbrakk> tcb_relation tcb tcb'; con = con'\<rbrakk>
               \<Longrightarrow> tcb_relation (tcb \<lparr> tcb_arch := arch_tcb_context_set con (tcb_arch tcb) \<rparr>)
@@ -1361,7 +1549,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)+)
+        (simp add: tcb_cte_cases_def tcb_cap_cases_def cteSizeBits_def exst_same_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'))"
@@ -1395,7 +1583,7 @@ lemma asUser_corres:
   apply (rule corres_guard_imp)
     apply (rule asUser_corres' [OF y])
    apply (simp add: invs_def valid_state_def valid_pspace_def)
-  apply (simp add: invs'_def valid_pspace'_def)
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
   done
 
 lemma asUser_inv:
@@ -1407,14 +1595,12 @@ proof -
   have R: "\<And>x. tcbArch_update (\<lambda>_. tcbArch x) x = x"
     by (case_tac x, simp)
   show ?thesis
-    apply (simp add: asUser_def split_def threadGet_getObject threadSet_def
+    apply (simp add: asUser_def split_def threadGet_def threadSet_def
                      liftM_def bind_assoc)
-    apply (clarsimp simp: valid_def in_monad getObject_def readObject_def setObject_def
+    apply (clarsimp simp: valid_def in_monad getObject_def setObject_def
                           loadObject_default_def projectKOs objBits_simps'
                           modify_def split_def updateObject_default_def
-                          in_magnitude_check select_f_def omonad_defs obind_def
-               split del: if_split
-                   split: option.split_asm if_split_asm
+                          in_magnitude_check select_f_def
                    dest!: P)
     apply (simp add: R map_upd_triv)
     done
@@ -1431,44 +1617,18 @@ lemma user_getreg_inv'[wp]:
   "\<lbrace>P\<rbrace> asUser t (getRegister r) \<lbrace>\<lambda>x. P\<rbrace>"
   by (wp asUser_inv)
 
-end
-
-crunch asUser
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: crunch_wps)
-
-global_interpretation asUser: typ_at_all_props' "asUser tptr f"
-  by typ_at_props'
-
-lemma threadGet_wp:
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> (\<exists>tcb. ko_at' tcb t s \<and> P (f tcb) s)\<rbrace>
-   threadGet f t
-   \<lbrace>P\<rbrace>"
-  apply (simp add: threadGet_getObject)
-  apply (wp getObject_tcb_wp)
-  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>"
-  apply (wpsimp wp: threadGet_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
+lemma asUser_typ_at' [wp]:
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> asUser t' f \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
+  by (simp add: asUser_def bind_assoc split_def, wp select_f_inv)
 
-lemma inReleaseQueue_wp:
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> (\<exists>tcb. ko_at' tcb t s \<and> P (tcbInReleaseQueue tcb) s)\<rbrace>
-   inReleaseQueue t
-   \<lbrace>P\<rbrace>"
-  apply (simp add: inReleaseQueue_def)
-  apply (wp threadGet_wp)
-  done
+lemmas asUser_typ_ats[wp] = typ_at_lifts [OF asUser_typ_at']
 
 lemma asUser_invs[wp]:
   "\<lbrace>invs' and tcb_at' t\<rbrace> asUser t m \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (simp add: asUser_def split_def)
-  apply (wpsimp wp: threadSet_invs_trivial threadGet_wp)
-  apply (fastforce dest!: invs_valid_release_queue'
-                    simp: obj_at'_def valid_release_queue'_def)
+  apply (wp hoare_drop_imps | simp)+
+
+  apply (wp threadSet_invs_trivial hoare_drop_imps | simp)+
   done
 
 lemma asUser_nosch[wp]:
@@ -1506,7 +1666,7 @@ lemma asUser_st_refs_of'[wp]:
      asUser t m
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (simp add: asUser_def split_def)
-  apply (wp threadSet_state_refs_of'[where h'=id and i'=id] hoare_drop_imps | simp)+
+  apply (wp threadSet_state_refs_of' hoare_drop_imps | simp)+
   done
 
 lemma asUser_iflive'[wp]:
@@ -1543,22 +1703,28 @@ lemma asUser_pred_tcb_at' [wp]:
 crunch asUser
   for ct[wp]: "\<lambda>s. P (ksCurThread s)"
   and cur_domain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  (simp: crunch_simps wp: hoare_drop_imps getObject_tcb_inv setObject_ct_inv)
+  (simp: crunch_simps wp: hoare_drop_imps getObject_inv_tcb setObject_ct_inv)
 
 lemma asUser_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t'\<rbrace> asUser t m \<lbrace>\<lambda>_. tcb_in_cur_domain' t'\<rbrace>"
-  unfolding asUser_def tcb_in_cur_domain'_def threadGet_getObject
-  by (wpsimp wp: threadSet_obj_at'_strongish getObject_tcb_wp | wps | clarsimp simp: obj_at'_def)+
+  apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def)
+  apply (wp | wpc | simp)+
+     apply (rule_tac f="ksCurDomain" in hoare_lift_Pf)
+      apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | simp)+
+  apply (clarsimp simp: obj_at'_def)
+  done
 
 lemma asUser_tcbDomain_inv[wp]:
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace> asUser t m \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t'\<rbrace>"
-  unfolding asUser_def tcb_in_cur_domain'_def threadGet_getObject
-  by (wpsimp wp: threadSet_obj_at'_strongish getObject_tcb_wp | wps | clarsimp simp: obj_at'_def)+
+  apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def)
+  apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | wpc | simp | clarsimp simp: obj_at'_def)+
+  done
 
 lemma asUser_tcbPriority_inv[wp]:
   "\<lbrace>obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace> asUser t m \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t'\<rbrace>"
-  unfolding asUser_def tcb_in_cur_domain'_def threadGet_getObject
-  by (wpsimp wp: threadSet_obj_at'_strongish getObject_tcb_wp | wps | clarsimp simp: obj_at'_def)+
+  apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def)
+  apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | wpc | simp | clarsimp simp: obj_at'_def)+
+  done
 
 lemma asUser_sch_act_wf[wp]:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>
@@ -1579,8 +1745,6 @@ lemma no_fail_asUser [wp]:
     apply (wpsimp wp: hoare_drop_imps no_fail_threadGet)+
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 lemma asUser_setRegister_corres:
   "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
              (as_user t (setRegister r v))
@@ -1590,37 +1754,16 @@ lemma asUser_setRegister_corres:
   apply (rule corres_modify'; simp)
   done
 
-end
-
-lemma getThreadState_corres':
-  "t = t' \<Longrightarrow>
-   corres thread_state_relation (tcb_at t) (tcb_at' t)
-          (get_thread_state t) (getThreadState t')"
+lemma getThreadState_corres:
+  "corres thread_state_relation (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (get_thread_state t) (getThreadState t)"
   apply (simp add: get_thread_state_def getThreadState_def)
   apply (rule threadGet_corres)
   apply (simp add: tcb_relation_def)
   done
 
-lemmas getThreadState_corres = getThreadState_corres'[OF refl]
-
-lemma is_blocked_corres:
-  "corres (=) (pspace_aligned and pspace_distinct and tcb_at tcb_ptr)  \<top>
-              (is_blocked tcb_ptr) (isBlocked tcb_ptr)"
-  apply (rule_tac Q="tcb_at' tcb_ptr" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD elim!: tcb_at_cross)
-  unfolding is_blocked_def isBlocked_def
-  apply clarsimp
-  apply (rule corres_guard_imp)
-    apply (rule corres_underlying_split[where b=return and Q="\<top>\<top>" and Q'="\<top>\<top>", simplified,
-                                        OF getThreadState_corres ])
-      apply (rename_tac st st')
-      apply (case_tac st; clarsimp)
-     apply wpsimp+
-  done
-
-lemma gts_wf'[wp]:
-  "\<lbrace>valid_objs'\<rbrace> getThreadState t \<lbrace>valid_tcb_state'\<rbrace>"
-  apply (simp add: getThreadState_def threadGet_getObject liftM_def)
+lemma gts_wf'[wp]: "\<lbrace>tcb_at' t and invs'\<rbrace> getThreadState t \<lbrace>valid_tcb_state'\<rbrace>"
+  apply (simp add: getThreadState_def threadGet_def liftM_def)
   apply (wp getObject_tcb_wp)
   apply clarsimp
   apply (drule obj_at_ko_at', clarsimp)
@@ -1629,7 +1772,7 @@ lemma gts_wf'[wp]:
   done
 
 lemma gts_st_tcb_at'[wp]: "\<lbrace>st_tcb_at' P t\<rbrace> getThreadState t \<lbrace>\<lambda>rv s. P rv\<rbrace>"
-  apply (simp add: getThreadState_def threadGet_getObject)
+  apply (simp add: getThreadState_def threadGet_def liftM_def)
   apply wp
    apply (rule hoare_chain)
      apply (rule obj_at_getObject)
@@ -1651,7 +1794,7 @@ lemma getBoundNotification_corres:
   done
 
 lemma gbn_bound_tcb_at'[wp]: "\<lbrace>bound_tcb_at' P t\<rbrace> getBoundNotification t \<lbrace>\<lambda>rv s. P rv\<rbrace>"
-  apply (simp add: getBoundNotification_def threadGet_getObject)
+  apply (simp add: getBoundNotification_def threadGet_def liftM_def)
   apply wp
    apply (rule hoare_strengthen_post)
     apply (rule obj_at_getObject)
@@ -1674,19 +1817,15 @@ lemma isStopped_def2:
 
 lemma isRunnable_def2:
   "isRunnable t = liftM runnable' (getThreadState t)"
-  apply (simp add: isRunnable_def liftM_def)
+  apply (simp add: isRunnable_def isStopped_def2 liftM_def)
   apply (rule bind_eqI, rule ext, rule arg_cong)
   apply (case_tac state)
   apply (clarsimp)+
   done
 
-lemma isBlocked_inv[wp]:
-  "\<lbrace>P\<rbrace> isBlocked t \<lbrace>\<lambda>rv. P\<rbrace>"
-  by (simp add: isBlocked_def | wp gts_inv')+
-
 lemma isStopped_inv[wp]:
   "\<lbrace>P\<rbrace> isStopped t \<lbrace>\<lambda>rv. P\<rbrace>"
-  by (simp add: isStopped_def | wp gts_inv')+
+  by (simp add: isStopped_def2 | wp gts_inv')+
 
 lemma isRunnable_inv[wp]:
   "\<lbrace>P\<rbrace> isRunnable t \<lbrace>\<lambda>rv. P\<rbrace>"
@@ -1695,14 +1834,14 @@ lemma isRunnable_inv[wp]:
 lemma isRunnable_wp[wp]:
   "\<lbrace>\<lambda>s. Q (st_tcb_at' (runnable') t s) s\<rbrace> isRunnable t \<lbrace>Q\<rbrace>"
   apply (simp add: isRunnable_def2)
-  apply (wpsimp simp: getThreadState_def threadGet_getObject wp: getObject_tcb_wp)
+  apply (wpsimp simp: getThreadState_def threadGet_def wp: getObject_tcb_wp)
   apply (clarsimp simp: getObject_def valid_def in_monad st_tcb_at'_def
                         loadObject_default_def projectKOs obj_at'_def
                         split_def objBits_simps in_magnitude_check)
   done
 
 lemma setQueue_obj_at[wp]:
-  "setQueue d p q \<lbrace>\<lambda>s. Q (obj_at' P t s)\<rbrace>"
+  "\<lbrace>obj_at' P t\<rbrace> setQueue d p q \<lbrace>\<lambda>rv. obj_at' P t\<rbrace>"
   apply (simp add: setQueue_def)
   apply wp
   apply (fastforce intro: obj_at'_pspaceI)
@@ -1751,7 +1890,42 @@ lemma getObject_obj_at_tcb:
 
 lemma threadGet_obj_at':
   "\<lbrace>obj_at' (\<lambda>t. P (f t) t) t\<rbrace> threadGet f t \<lbrace>\<lambda>rv. obj_at' (P rv) t\<rbrace>"
-  by (simp add: threadGet_getObject | wp getObject_obj_at_tcb)+
+  by (simp add: threadGet_def o_def | wp getObject_obj_at_tcb)+
+
+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))
@@ -1792,242 +1966,392 @@ lemma removeFromBitmap_corres_noop:
   by (rule corres_noop)
      (wp | simp add: bitmap_fun_defs state_relation_def | rule no_fail_pre)+
 
-crunch addToBitmap, removeFromBitmap
+crunch addToBitmap
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
+  (wp: hoare_drop_imps setCTE_typ_at')
 
-global_interpretation addToBitmap: typ_at_all_props' "addToBitmap tdom prio"
-  by typ_at_props'
+crunch removeFromBitmap
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: hoare_drop_imps setCTE_typ_at')
 
-global_interpretation removeFromBitmap: typ_at_all_props' "removeFromBitmap tdom prio"
-  by typ_at_props'
+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 pspace_relation_tcb_domain_priority:
-  "\<lbrakk>pspace_relation (kheap s) (ksPSpace s'); kheap s t = Some (TCB tcb);
+lemma ekheap_relation_tcb_domain_priority:
+  "\<lbrakk>ekheap_relation (ekheap s) (ksPSpace s'); ekheap s t = Some (tcb);
     ksPSpace s' t = Some (KOTCB tcb')\<rbrakk>
-   \<Longrightarrow> tcb_domain tcb = tcbDomain tcb' \<and> tcb_priority tcb = tcbPriority tcb'"
-  apply (clarsimp simp: pspace_relation_def)
+   \<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 (drule_tac x="(t, other_obj_relation)" in bspec, simp)
-  apply (clarsimp simp: other_obj_relation_def tcb_relation_def)
+  apply (clarsimp simp: other_obj_relation_def etcb_relation_def)
   done
 
-lemma tcbSchedEnqueue_corres:
-  "corres dc (tcb_at t and pspace_aligned and pspace_distinct)
-             (Invariants_H.valid_queues and valid_queues')
-          (tcb_sched_action (tcb_sched_enqueue) t) (tcbSchedEnqueue t)"
-    (is "corres _ _ ?conc_guard _ _")
-proof -
+lemma no_fail_thread_get[wp]:
+  "no_fail (tcb_at tcb_ptr) (thread_get f tcb_ptr)"
+  unfolding thread_get_def
+  apply wpsimp
+  apply (clarsimp simp: tcb_at_def)
+  done
 
-  have ready_queues_helper:
-    "\<And>t tcb s s'. \<lbrakk> obj_at' tcbQueued t s';  valid_queues' s'; kheap s t = Some (TCB tcb);
-                   pspace_relation (kheap s) (ksPSpace s') \<rbrakk>
-                   \<Longrightarrow> t \<in> set (ksReadyQueues s' (tcb_domain tcb, tcb_priority tcb))"
-  unfolding valid_queues'_def
-  apply  (clarsimp dest:  simp: obj_at'_def inQ_def tcb_relation_def projectKO_eq projectKO_tcb)
-  using pspace_relation_tcb_domain_priority by fastforce
+lemma pspace_relation_tcb_relation:
+  "\<lbrakk>pspace_relation (kheap s) (ksPSpace s'); kheap s ptr = Some (TCB tcb);
+    ksPSpace s' ptr = Some (KOTCB tcb')\<rbrakk>
+   \<Longrightarrow> tcb_relation tcb tcb'"
+  apply (clarsimp simp: pspace_relation_def)
+  apply (drule_tac x=ptr in bspec)
+   apply (fastforce simp: obj_at_def)
+  apply (clarsimp simp: tcb_relation_cut_def obj_at_def obj_at'_def)
+  done
+
+lemma pspace_relation_update_concrete_tcb:
+  "\<lbrakk>pspace_relation s s'; s ptr = Some (TCB tcb); s' ptr = Some (KOTCB otcb');
+    tcb_relation tcb tcb'\<rbrakk>
+   \<Longrightarrow> pspace_relation s (s'(ptr \<mapsto> KOTCB tcb'))"
+  by (fastforce dest: pspace_relation_update_tcbs simp: map_upd_triv)
+
+lemma threadSet_pspace_relation:
+  fixes s :: det_state
+  assumes tcb_rel: "(\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow> tcb_relation tcb (F tcb'))"
+  shows "threadSet F tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap 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 normalise_obj_at'
+  apply (frule tcb_at'_cross)
+   apply (fastforce simp: obj_at'_def)
+  apply (clarsimp simp: obj_at_def is_tcb_def)
+  apply (rename_tac ko, case_tac ko; clarsimp)
+  apply (rule pspace_relation_update_concrete_tcb)
+     apply fastforce
+    apply fastforce
+   apply (fastforce simp: obj_at'_def projectKOs)
+  apply (frule (1) pspace_relation_tcb_relation)
+   apply (fastforce simp: obj_at'_def projectKOs)
+  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 projectKOs)
+  apply (frule (1) ekheap_relation_etcb_relation)
+   apply (fastforce simp: obj_at'_def projectKOs)
+  apply (fastforce dest!: etcb_rel)
+  done
 
-  show ?thesis
-    apply (rule corres_cross_over_guard[where Q="?conc_guard and tcb_at' t"])
-     apply (fastforce intro: tcb_at_cross)
-    unfolding tcbSchedEnqueue_def tcb_sched_action_def
-    apply (rule corres_symb_exec_r[where Q'="\<lambda>rv. tcb_at' t and Invariants_H.valid_queues
-                                                  and valid_queues'
-                                                  and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"])
-       defer
-       apply (wp threadGet_obj_at'; simp_all)
-      apply (wpsimp wp: threadGet_inv)
-     apply (rule no_fail_pre, wp, blast)
-    apply (case_tac queued; simp_all)
-     apply (rule corres_no_failI)
-      apply (simp add: no_fail_return)
-     apply (clarsimp simp: in_monad gets_the_def bind_assoc
-                           assert_opt_def exec_gets get_tcb_queue_def
-                           set_tcb_queue_def simpler_modify_def ready_queues_relation_def
-                           state_relation_def tcb_sched_enqueue_def thread_get_def get_tcb_def
-                           gets_def get_def return_def fail_def bind_def tcb_at_def cdt_relation_def
-                    split: option.splits Structures_A.kernel_object.splits)
-    using ready_queues_helper apply blast
-
-    apply (clarsimp simp: when_def)
-    apply (rule stronger_corres_guard_imp)
-      apply (rule corres_split[where r'="(=)", OF threadGet_corres], simp add: tcb_relation_def)
-        apply (rule corres_split[where r'="(=)", OF threadGet_corres], simp add: tcb_relation_def)
-          apply (rule corres_split[where r'="(=)"])
-             apply (simp, rule getQueue_corres)
-            apply (rule corres_split_noop_rhs2)
-               apply (simp add: tcb_sched_enqueue_def split del: if_split)
-               apply (rule_tac P=\<top> and Q="K (t \<notin> set queuea)" in corres_assume_pre)
-               apply (simp, rule setQueue_corres[unfolded dc_def])
-              apply (rule corres_split_noop_rhs2)
-                 apply (fastforce intro: addToBitmap_noop_corres)
-                apply (fastforce intro: threadSet_corres_noop simp: tcb_relation_def)
-               apply wp+
-        apply (wp | simp add: threadGet_def)+
-    apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def
-                           projectKO_eq project_inject)
-    done
-qed
+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)
 
-definition
-  weak_sch_act_wf :: "scheduler_action \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
- "weak_sch_act_wf sa = (\<lambda>s. \<forall>t. sa = SwitchToThread t \<longrightarrow> st_tcb_at' runnable' t s \<and> tcb_in_cur_domain' t s)"
+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 weak_sch_act_wf_updates[simp]:
-  "\<And>f. weak_sch_act_wf sa (ksDomainTime_update f s) = weak_sch_act_wf sa s"
-  "\<And>f. weak_sch_act_wf sa (ksReprogramTimer_update f s) = weak_sch_act_wf sa s"
-  "\<And>f. weak_sch_act_wf sa (ksReleaseQueue_update f s) = weak_sch_act_wf sa s"
-  by (auto simp: weak_sch_act_wf_def tcb_in_cur_domain'_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 setSchedulerAction_corres:
-  "sched_act_relation sa sa'
-    \<Longrightarrow> corres dc \<top> \<top> (set_scheduler_action sa) (setSchedulerAction sa')"
-  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 swp_def)
+lemma threadSet_ghost_relation[wp]:
+  "threadSet f tcbPtr \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')\<rbrace>"
+  unfolding threadSet_def setObject_def updateObject_default_def
+  apply (wpsimp wp: getObject_tcb_wp simp: updateObject_default_def)
+  apply (clarsimp simp: obj_at'_def)
   done
 
-lemma getSchedulerAction_corres:
-  "corres sched_act_relation \<top> \<top> (gets scheduler_action) getSchedulerAction"
-  apply (simp add: getSchedulerAction_def)
-  apply (clarsimp simp: state_relation_def)
+lemma removeFromBitmap_ghost_relation[wp]:
+  "removeFromBitmap tdom prio \<lbrace>\<lambda>s'. ghost_relation (kheap s) (gsUserPages s') (gsCNodes s')\<rbrace>"
+  by (rule_tac f=gsUserPages in hoare_lift_Pf2; wpsimp simp: bitmap_fun_defs)
+
+lemma tcbQueued_update_ctes_of[wp]:
+  "threadSet (tcbQueued_update f) t \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp wp: threadSet_ctes_of)
+
+lemma removeFromBitmap_ctes_of[wp]:
+  "removeFromBitmap tdom prio \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
+  by (wpsimp simp: bitmap_fun_defs)
+
+crunch tcbQueueRemove, tcbQueuePrepend, tcbQueueAppend, tcbQueueInsert,
+         setQueue, removeFromBitmap
+  for ghost_relation_projs[wp]: "\<lambda>s. P (gsUserPages s) (gsCNodes s)"
+  and ksArchState[wp]: "\<lambda>s. P (ksArchState s)"
+  and ksWorkUnitsCompleted[wp]: "\<lambda>s. P (ksWorkUnitsCompleted s)"
+  and ksDomainTime[wp]: "\<lambda>s. P (ksDomainTime s)"
+  (wp: crunch_wps getObject_tcb_wp simp: setObject_def updateObject_default_def obj_at'_def)
+
+crunch tcbQueueRemove, tcbQueuePrepend, tcbQueueAppend, tcbQueueInsert,
+         setQueue, removeFromBitmap
+  for tcb_at'[wp]: "\<lambda>s. tcb_at' tcbPtr s"
+  (wp: crunch_wps ignore: threadSet)
+
+lemma set_tcb_queue_projs:
+  "set_tcb_queue d p queue
+   \<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>"
+  by (wpsimp simp: set_tcb_queue_def)
+
+lemma set_tcb_queue_cte_at:
+  "set_tcb_queue d p queue \<lbrace>\<lambda>s. P (swp cte_at s)\<rbrace>"
+  unfolding set_tcb_queue_def
+  apply wpsimp
+  apply (clarsimp simp: swp_def cte_wp_at_def)
+  done
+
+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'
+   \<and> idle_thread s = idle_thread s'
+   \<and> scheduler_action s = scheduler_action s'
+   \<and> domain_list s = domain_list s'
+   \<and> domain_index s = domain_index s'
+   \<and> cur_domain s = cur_domain s'
+   \<and> domain_time s = domain_time s'
+   \<and> machine_state s = machine_state s'
+   \<and> interrupt_irq_node s = interrupt_irq_node s'
+   \<and> interrupt_states s = interrupt_states s'
+   \<and> arch_state s = arch_state s'
+   \<and> caps_of_state s = caps_of_state s'
+   \<and> work_units_completed s = work_units_completed s'
+   \<and> cdt_list s = cdt_list s'
+   \<and> swp cte_at s = swp cte_at s'"
+  apply (drule singleton_eqD)
+  by (auto elim!: use_valid_inv[where E=\<top>, simplified]
+           intro: set_tcb_queue_projs set_tcb_queue_cte_at)
+
+lemma set_tcb_queue_new_state:
+  "(rv, t) \<in> fst (set_tcb_queue d p queue s)  \<Longrightarrow>
+   t = s\<lparr>ready_queues := \<lambda>dom prio. if dom = d \<and> prio = p then queue else ready_queues s dom prio\<rparr>"
+  by (clarsimp simp: set_tcb_queue_def in_monad)
+
+lemma tcbQueuePrepend_pspace_relation[wp]:
+  fixes s :: det_state
+  shows "tcbQueuePrepend queue tcbPtr \<lbrace>\<lambda>s'. pspace_relation (kheap s) (ksPSpace s')\<rbrace>"
+  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>"
+  unfolding bitmap_fun_defs
+  by wpsimp
+
+crunch setQueue, removeFromBitmap
+  for valid_pspace'[wp]: valid_pspace'
+  and state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
+  and valid_global_refs'[wp]: valid_global_refs'
+  and valid_arch_state'[wp]: valid_arch_state'
+  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
+  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  and valid_irq_states'[wp]: valid_irq_states'
+  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
+  and pspace_domain_valid[wp]: pspace_domain_valid
+  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
+  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
+  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  and valid_machine_state'[wp]: valid_machine_state'
+  and cur_tcb'[wp]: cur_tcb'
+  and ksPSpace[wp]: "\<lambda>s. P (ksPSpace s)"
+  (wp: crunch_wps
+   simp: crunch_simps tcb_cte_cases_def tcb_bound_refs'_def cur_tcb'_def threadSet_cur
+         bitmap_fun_defs valid_machine_state'_def)
+
+crunch tcbSchedEnqueue, tcbSchedAppend, tcbSchedDequeue, setQueue
+  for pspace_aligned'[wp]: pspace_aligned'
+  and state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
+  and pspace_distinct'[wp]: pspace_distinct'
+  and no_0_obj'[wp]: no_0_obj'
+  and ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  and valid_global_refs'[wp]: valid_global_refs'
+  and valid_arch_state'[wp]: valid_arch_state'
+  and irq_node[wp]: "\<lambda>s. P (irq_node' s)"
+  and typ_at[wp]: "\<lambda>s. P (typ_at' T p s)"
+  and interrupt_state[wp]: "\<lambda>s. P (ksInterruptState s)"
+  and valid_irq_state'[wp]: valid_irq_states'
+  and pspace_domain_valid[wp]: pspace_domain_valid
+  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
+  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
+  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
+  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
+  and ksMachineState[wp]: "\<lambda>s. P (ksMachineState s)"
+  and ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (wp: crunch_wps threadSet_state_refs_of'[where f'=id and g'=id]
+   simp: crunch_simps tcb_cte_cases_def tcb_bound_refs'_def bitmap_fun_defs)
+
+lemma threadSet_ready_queues_relation:
+  "(\<And>tcb. tcbQueued (F tcb) = tcbQueued tcb) \<Longrightarrow>
+   \<lbrace>\<lambda>s'. ready_queues_relation s s' \<and> \<not> (tcbQueued |< tcbs_of' s') tcbPtr\<rbrace>
+   threadSet F tcbPtr
+   \<lbrace>\<lambda>_ s'. ready_queues_relation s s'\<rbrace>"
+  supply fun_upd_apply[simp del]
+  apply (clarsimp simp: ready_queues_relation_def Let_def)
+  apply (wpsimp wp: threadSet_wp)
+  apply (clarsimp simp: list_queue_relation_def obj_at'_def projectKOs)
+  apply (rename_tac tcb' d p)
+  apply (drule_tac x=d in spec)
+  apply (drule_tac x=p in spec)
+  apply (clarsimp simp: ready_queue_relation_def list_queue_relation_def)
+  apply (rule conjI)
+   apply (drule_tac x=tcbPtr in spec)
+   apply (fastforce intro: heap_path_heap_upd_not_in
+                     simp: inQ_def opt_map_def opt_pred_def obj_at'_def)
+  apply (rule conjI)
+   apply (drule_tac x=tcbPtr in spec)
+   apply (clarsimp simp: prev_queue_head_def)
+   apply (prop_tac "ready_queues s d p \<noteq> []", fastforce)
+   apply (fastforce dest: heap_path_head simp: inQ_def opt_pred_def opt_map_def fun_upd_apply)
+  apply (auto simp: inQ_def opt_pred_def opt_map_def fun_upd_apply projectKOs split: option.splits)
   done
 
-\<comment>\<open>
-  State-preservation lemmas: lemmas of the form @{term "m \<lbrace>P\<rbrace>"}.
-\<close>
-lemmas tcb_inv_collection =
-  getObject_tcb_inv
-  threadGet_inv
-
-\<comment>\<open>
-  State preservation lowered through @{thm use_valid}. Results are of
-  the form @{term "(rv, s') \<in> fst (m s) \<Longrightarrow> P s \<Longrightarrow> P s'"}.
-\<close>
-lemmas tcb_inv_use_valid =
-  tcb_inv_collection[THEN use_valid[rotated], rotated]
-
-\<comment>\<open>
-  Low-level monadic state preservation. Results are of the form
-  @{term "(rv, s') \<in> fst (m s) \<Longrightarrow> s = s'"}.
-\<close>
-lemmas tcb_inv_state_eq =
-  tcb_inv_use_valid[where s=s and P="(=) s" for s, OF _ refl]
-
-\<comment>\<open>
-  For when you want an obj_at' goal instead of the ko_at' that @{thm threadGet_wp}
-  gives you.
-\<close>
-lemma threadGet_obj_at'_field:
-  "\<lbrace>\<lambda>s. tcb_at' ptr s \<longrightarrow> obj_at' (\<lambda>tcb. P (field tcb) s) ptr s\<rbrace>
-   threadGet field ptr
-   \<lbrace>P\<rbrace>"
-  by (wpsimp wp: threadGet_wp
-           simp: obj_at_ko_at')
-
-\<comment>\<open>
-  Getting a boolean field of a thread is the same as the thread
-  "satisfying" the "predicate" which the field represents.
-\<close>
-lemma threadGet_obj_at'_bool_field:
-  "\<lbrace>tcb_at' ptr\<rbrace>
-   threadGet field ptr
-   \<lbrace>\<lambda>rv s. obj_at' field ptr s = rv\<rbrace>"
-   by (wpsimp wp: threadGet_wp
-            simp: obj_at'_def)
-
-lemma inReleaseQueue_corres:
-  shows "corres (=)
-          (tcb_at ptr)
-          (tcb_at' ptr and valid_release_queue_iff)
-          (gets (in_release_queue ptr))
-          (inReleaseQueue ptr)"
-  apply (simp add: gets_def)
-  apply (rule corres_bind_return_l)
-  apply (clarsimp simp: corres_underlying_def inReleaseQueue_def
-                        valid_release_queue_def valid_release_queue'_def
-                        no_fail_threadGet[unfolded no_fail_def])
-  apply (rename_tac s s' rv t')
-  apply (prop_tac "ksReleaseQueue s' = release_queue s")
-   subgoal by (clarsimp simp: state_relation_def release_queue_relation_def)
-  apply (frule tcb_inv_state_eq)
-  apply (clarsimp simp: split_paired_Bex in_get)
-  apply (frule tcb_inv_state_eq)
-  apply (erule allE[where x=ptr])+
-  apply (frule use_valid[OF _ threadGet_obj_at'_bool_field], assumption)
-  apply (fastforce simp: in_release_q_def)
-  done
-
-lemma isRunnable_corres:
-  "tcb_relation tcb_abs tcb_conc \<Longrightarrow>
-   corres (=)
-          (tcb_at t)
-          (ko_at' tcb_conc t)
-          (return (runnable (tcb_state tcb_abs)))
-          (isRunnable t)"
-  unfolding isRunnable_def getThreadState_def
-  apply (rule corres_symb_exec_r[where Q'="\<lambda>rv s. tcbState tcb_conc = rv"])
-     apply (case_tac "tcb_state tcb_abs"; clarsimp simp: tcb_relation_def)
-    apply (wpsimp wp: threadGet_wp)
-    apply (rule exI, fastforce)
-   apply (rule tcb_inv_collection)
-  apply (rule no_fail_pre[OF no_fail_threadGet])
-  apply (clarsimp simp: obj_at'_weaken)
-  done
-
-
-lemma isSchedulable_corres:
-  "corres (=)
-          (valid_tcbs and pspace_aligned and pspace_distinct and tcb_at t)
-          (valid_tcbs' and valid_release_queue_iff)
-          (is_schedulable t)
-          (isSchedulable t)"
-    (is "corres _ _ ?conc_guard _ _")
-  apply (rule corres_cross_over_guard[where Q="?conc_guard and tcb_at' t"])
-   apply (fastforce intro: tcb_at_cross)
-  unfolding is_schedulable_def isSchedulable_def fun_app_def
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getObject_TCB_corres])
-      apply (rename_tac tcb_abs tcb_conc)
-      apply (rule corres_if[OF _ corres_return_eq_same])
-        apply (clarsimp simp: tcb_relation_def Option.is_none_def)
-       apply simp
-      apply (rule corres_split[OF get_sc_corres[THEN equify]])
-         apply (clarsimp simp: tcb_relation_def)
-        apply (rename_tac sc_abs sc_conc)
-        apply (rule corres_split[OF isRunnable_corres])
-           apply assumption
-          apply (rule corres_split[OF inReleaseQueue_corres])
-            apply (rule corres_trivial)
-            apply (clarsimp simp: sc_relation_def active_sc_def)
-           apply wp+
-    apply (wpsimp simp: pred_conj_def
-                    wp: hoare_vcg_if_lift2 getObject_tcb_wp)
-   apply (clarsimp simp: pred_conj_def)
-   apply (frule (1) valid_tcbs_valid_tcb)
-   apply (fastforce simp: valid_tcb_def valid_bound_obj_def obj_at_def split: option.splits)
-  apply (fastforce simp: valid_tcbs'_def valid_tcb'_def obj_at'_def projectKOs)
-  done
-
-lemma get_simple_ko_exs_valid:
-  "\<lbrakk>inj C; \<exists>ko. ko_at (C ko) p s \<and> is_simple_type (C ko)\<rbrakk> \<Longrightarrow> \<lbrace>(=) s\<rbrace> get_simple_ko C p \<exists>\<lbrace>\<lambda>_. (=) s\<rbrace>"
-  by (fastforce simp: get_simple_ko_def get_object_def gets_def return_def get_def
-                      partial_inv_def exs_valid_def bind_def obj_at_def is_reply fail_def inj_def
-                      gets_the_def assert_def)
-
-lemmas get_notification_exs_valid[wp] =
-  get_simple_ko_exs_valid[where C=kernel_object.Notification, simplified]
-lemmas get_reply_exs_valid[wp] =
-  get_simple_ko_exs_valid[where C=kernel_object.Reply, simplified]
-lemmas get_endpoint_exs_valid[wp] =
-  get_simple_ko_exs_valid[where C=kernel_object.Endpoint, simplified]
-
-lemma thread_get_exs_valid:
-  "tcb_at tcb_ptr s \<Longrightarrow> \<lbrace>(=) s\<rbrace> thread_get f tcb_ptr \<exists>\<lbrace>\<lambda>_. (=) s\<rbrace>"
-  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)
+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"
+
+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)"
+
+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 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
+  "ready_qs_distinct s \<equiv> \<forall>d p. distinct (ready_queues s d p)"
+
+lemma ready_qs_distinct_lift:
+  assumes r: "\<And>P. f \<lbrace>\<lambda>s. P (ready_queues s)\<rbrace>"
+  shows "f \<lbrace>ready_qs_distinct\<rbrace>"
+  unfolding ready_qs_distinct_def
+  apply (rule hoare_pre)
+   apply (wps assms | wpsimp)+
+  done
+
+lemma ready_queues_disjoint:
+  "\<lbrakk>in_correct_ready_q s; ready_qs_distinct s; d \<noteq> d' \<or> p \<noteq> p'\<rbrakk>
+   \<Longrightarrow> set (ready_queues s d p) \<inter> set (ready_queues s d' p') = {}"
+  apply (clarsimp simp: ready_qs_distinct_def in_correct_ready_q_def)
+  apply (rule disjointI)
+  apply (frule_tac x=d in spec)
+  apply (drule_tac x=d' in spec)
+  apply (fastforce simp: etcb_at_def is_etcb_at_def split: option.splits)
+  done
 
 lemma isRunnable_sp:
   "\<lbrace>P\<rbrace>
@@ -2036,159 +2360,371 @@ lemma isRunnable_sp:
                   \<and> (rv = (tcbState tcb' = Running \<or> tcbState tcb' = Restart))
            \<and> P s\<rbrace>"
   unfolding isRunnable_def getThreadState_def
-  apply (wpsimp wp: hoare_case_option_wp getObject_tcb_wp simp: threadGet_getObject)
+  apply (wpsimp wp: hoare_case_option_wp getObject_tcb_wp simp: threadGet_def)
   apply (fastforce simp: obj_at'_def split: Structures_H.thread_state.splits)
   done
 
-lemma isRunnable_sp':
-  "\<lbrace>P\<rbrace>
-   isRunnable tcb_ptr
-   \<lbrace>\<lambda>rv s. (rv = st_tcb_at' active' tcb_ptr s) \<and> P s\<rbrace>"
-  apply (clarsimp simp: isRunnable_def getThreadState_def)
-  apply (wpsimp wp: hoare_case_option_wp getObject_tcb_wp
-              simp: threadGet_getObject)
-  apply (fastforce simp: obj_at'_def st_tcb_at'_def
-                  split: Structures_H.thread_state.splits)
+crunch isRunnable
+  for (no_fail) no_fail[wp]
+
+defs ksReadyQueues_asrt_def:
+  "ksReadyQueues_asrt
+     \<equiv> \<lambda>s'. \<forall>d p. \<exists>ts. ready_queue_relation d p ts (ksReadyQueues s' (d, p))
+                                            (tcbSchedNexts_of s') (tcbSchedPrevs_of s')
+                                            (inQ d p |< tcbs_of' s')"
+
+lemma ksReadyQueues_asrt_cross:
+  "ready_queues_relation s s' \<Longrightarrow> ksReadyQueues_asrt s'"
+  by (fastforce simp: ready_queues_relation_def Let_def ksReadyQueues_asrt_def)
+
+lemma ex_abs_ksReadyQueues_asrt:
+  "ex_abs P s \<Longrightarrow> ksReadyQueues_asrt s"
+  by (fastforce simp: ex_abs_underlying_def intro: ksReadyQueues_asrt_cross)
+
+crunch addToBitmap
+  for ko_at'[wp]: "\<lambda>s. P (ko_at' ko ptr s)"
+  and sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  and ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  and ksReadyQueues_asrt[wp]: ksReadyQueues_asrt
+  and st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' Q tcbPtr s)"
+  and valid_tcbs'[wp]: valid_tcbs'
+  (simp: bitmap_fun_defs ksReadyQueues_asrt_def)
+
+lemma tcbQueueHead_ksReadyQueues:
+  "\<lbrakk>list_queue_relation ts queue nexts prevs;
+    \<forall>t. (inQ d p |< tcbs_of' s') t \<longleftrightarrow> t \<in> set ts\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty queue \<longrightarrow> (inQ d p |< tcbs_of' s') (the (tcbQueueHead queue))"
+  by (fastforce dest: heap_path_head
+                simp: tcbQueueEmpty_def list_queue_relation_def queue_end_valid_def)
+
+lemma obj_at'_tcbQueueHead_ksReadyQueues:
+  "\<lbrakk>list_queue_relation ts queue nexts prevs;
+    \<forall>t. (inQ d p |< tcbs_of' s') t \<longleftrightarrow> t \<in> set ts;
+    pspace_aligned' s'; pspace_distinct' s'\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty queue \<longrightarrow> obj_at' (inQ d p) (the (tcbQueueHead queue)) s'"
+  by (fastforce dest!: tcbQueueHead_ksReadyQueues intro: aligned'_distinct'_ko_wp_at'I
+                 simp: obj_at'_real_def opt_map_def opt_pred_def split: option.splits)
+
+lemma tcbQueueHead_iff_tcbQueueEnd:
+  "list_queue_relation ts q nexts prevs \<Longrightarrow> tcbQueueHead q \<noteq> None \<longleftrightarrow> tcbQueueEnd q \<noteq> None"
+  apply (clarsimp simp: list_queue_relation_def queue_end_valid_def)
+  using heap_path_None
+  apply fastforce
   done
 
-lemma inReleaseQueue_sp:
-  "\<lbrace>P\<rbrace>
-   inReleaseQueue tcb_ptr
-   \<lbrace>\<lambda>rv s. \<exists>tcb'. ko_at' tcb' tcb_ptr s \<and> (rv = (tcbInReleaseQueue tcb')) \<and> P s\<rbrace>"
-  unfolding inReleaseQueue_def
-  apply (wpsimp wp: hoare_case_option_wp getObject_tcb_wp simp: threadGet_getObject)
+lemma tcbQueueEnd_ksReadyQueues:
+  "\<lbrakk>list_queue_relation ts queue nexts prevs;
+    \<forall>t. (inQ d p |< tcbs_of' s') t \<longleftrightarrow> t \<in> set ts\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty queue \<longrightarrow> (inQ d p |< tcbs_of' s') (the (tcbQueueEnd queue))"
+  apply (frule tcbQueueHead_iff_tcbQueueEnd)
+  by (clarsimp simp: tcbQueueEmpty_def list_queue_relation_def queue_end_valid_def)
+
+lemma obj_at'_tcbQueueEnd_ksReadyQueues:
+  "\<lbrakk>list_queue_relation ts queue nexts prevs;
+    \<forall>t. (inQ d p |< tcbs_of' s') t \<longleftrightarrow> t \<in> set ts;
+    pspace_aligned' s'; pspace_distinct' s'\<rbrakk>
+   \<Longrightarrow> \<not> tcbQueueEmpty queue \<longrightarrow> obj_at' (inQ d p) (the (tcbQueueEnd queue)) s'"
+  by (fastforce dest!: tcbQueueEnd_ksReadyQueues intro: aligned'_distinct'_ko_wp_at'I
+                 simp: obj_at'_real_def opt_map_def opt_pred_def split: option.splits)
+
+lemma thread_get_exs_valid[wp]:
+  "tcb_at tcb_ptr s \<Longrightarrow> \<lbrace>(=) s\<rbrace> thread_get f tcb_ptr \<exists>\<lbrace>\<lambda>_. (=) s\<rbrace>"
+  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
+  apply (wpsimp wp: getObject_tcb_wp)
   apply (clarsimp simp: obj_at'_def)
   done
 
-lemma inReleaseQueue_inv[wp]:
-  "inReleaseQueue t \<lbrace>P\<rbrace>"
-  by (simp add: inReleaseQueue_def | wp gts_inv')+
+lemma in_set_ready_queues_inQ_eq:
+  "ready_queues_relation s s' \<Longrightarrow> t \<in> set (ready_queues s d p) \<longleftrightarrow> (inQ d p |< tcbs_of' s') t"
+  by (clarsimp simp: ready_queue_relation_def ready_queues_relation_def Let_def)
 
-lemma conjunct_rewrite:
-  "P = P' \<and> Q = Q' \<and> R = R' \<Longrightarrow> (P \<and> Q \<and> R) = (P' \<and> Q' \<and> R')"
-  by simp
+lemma in_ready_q_tcbQueued_eq:
+  "ready_queues_relation s s'
+   \<Longrightarrow> (\<exists>d p. t \<in> set (ready_queues s d p))  \<longleftrightarrow> (tcbQueued |< tcbs_of' s') t"
+  apply (intro iffI)
+   apply clarsimp
+   apply (frule in_set_ready_queues_inQ_eq)
+   apply (fastforce simp: inQ_def opt_map_def opt_pred_def split: option.splits)
+  apply (fastforce simp: ready_queue_relation_def ready_queues_relation_def Let_def
+                         inQ_def opt_pred_def
+                  split: option.splits)
+  done
 
-lemma isSchedulable_inv[wp]:
-  "isSchedulable tcbPtr \<lbrace>P\<rbrace>"
-  apply (clarsimp simp: isSchedulable_def inReleaseQueue_def)
-  apply (rule bind_wp[OF _ getObject_tcb_inv])
-  by (wpsimp wp: inReleaseQueue_inv)
+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
+      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)"
+  supply if_split[split del]
+         heap_path_append[simp del] fun_upd_apply[simp del] distinct_append[simp del]
+  apply (rule_tac Q'="st_tcb_at' runnable' tcbPtr" in corres_cross_add_guard)
+   apply (fastforce intro!: st_tcb_at_runnable_cross simp: obj_at_def is_tcb_def)
+  apply (rule_tac Q="tcb_at tcb_ptr" in corres_cross_add_abs_guard)
+   apply (fastforce dest: st_tcb_at_tcb_at)
+  apply (rule_tac Q'=pspace_aligned' in corres_cross_add_guard)
+   apply (fastforce dest: pspace_aligned_cross)
+  apply (rule_tac Q'=pspace_distinct' in corres_cross_add_guard)
+   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 (rename_tac domain)
+  apply (rule corres_symb_exec_l[OF _ _ ethread_get_sp]; (solves wpsimp)?)
+  apply (rename_tac priority)
+  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 _ isRunnable_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_r[OF _ assert_sp, rotated]; (solves wpsimp)?)
+   apply wpsimp
+   apply (fastforce simp: st_tcb_at'_def runnable_eq_active' obj_at'_def)
+  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 projectKOs)
+   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)
+    apply (rule monadic_rewrite_guard_imp)
+     apply (rule monadic_rewrite_modify_noop)
+    apply (prop_tac "(\<lambda>d p. if d = domain \<and> p = priority
+                            then ready_queues s domain priority
+                            else ready_queues s d p)
+                     = ready_queues s")
+     apply (fastforce split: if_splits)
+    apply fastforce
+   apply clarsimp
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_r[OF _ threadGet_sp]; (solves wpsimp)?)
+  apply (rule corres_symb_exec_r[OF _ gets_sp]; (solves wpsimp)?)
 
-lemma get_sc_refill_sufficient_sp:
-  "\<lbrace>P\<rbrace>
-   get_sc_refill_sufficient sc_ptr usage
-   \<lbrace>\<lambda>rv s. (\<exists>sc n. ko_at (kernel_object.SchedContext sc n) sc_ptr s
-                   \<and> (rv = sc_refill_sufficient usage sc))
-           \<and> P s\<rbrace>"
-  by (wpsimp simp: get_sc_refill_sufficient_def obj_at_def)
+  \<comment> \<open>break off the addToBitmap\<close>
+  apply (rule corres_add_noop_lhs)
+  apply (rule corres_underlying_split[rotated 2,
+                                      where Q="\<lambda>_. P" and P=P and Q'="\<lambda>_. P'" and P'=P' for P P'])
+     apply wpsimp
+    apply (wpsimp wp: hoare_vcg_if_lift hoare_vcg_ex_lift)
+   apply (corres corres: addToBitmap_if_null_noop_corres)
 
-lemma get_sc_refill_ready_sp:
-  "\<lbrace>P\<rbrace>
-   get_sc_refill_ready sc_ptr
-   \<lbrace>\<lambda>rv s. (\<exists>sc n. ko_at (kernel_object.SchedContext sc n) sc_ptr s
-                   \<and> (rv = sc_refill_ready (cur_time s) sc))
-           \<and> P s\<rbrace>"
-  by (wpsimp simp: obj_at_def)
-
-\<comment> \<open>In sched_context_donate, weak_valid_sched_action does not propagate backwards over the statement
-    where from_tptr's sched context is set to None because it requires the thread associated with a
-    switch_thread action to have a sched context. For this instance, we introduce a weaker version
-    of weak_valid_sched_action that is sufficient to prove refinement for reschedule_required\<close>
-definition weaker_valid_sched_action where
-  "weaker_valid_sched_action s \<equiv>
-   \<forall>t. scheduler_action s = switch_thread t \<longrightarrow>
-       tcb_at t s \<and> (bound_sc_tcb_at ((\<noteq>) None) t s \<longrightarrow> released_sc_tcb_at t s)"
-
-lemma weak_valid_sched_action_strg:
-  "weak_valid_sched_action s \<longrightarrow> weaker_valid_sched_action s"
-  by (fastforce simp: weak_valid_sched_action_def weaker_valid_sched_action_def
-                      obj_at_kh_kheap_simps vs_all_heap_simps is_tcb_def
-               split: Structures_A.kernel_object.splits)
-
-lemma no_ofail_get_tcb[wp]:
-  "no_ofail (tcb_at tp) (get_tcb tp)"
-  unfolding get_tcb_def no_ofail_def
-  by (clarsimp simp: obj_at_def is_tcb split: option.splits)
-
-lemma no_ofail_read_sched_context[wp]:
-  "no_ofail (\<lambda>s. \<exists>sc n. kheap s scp = Some (Structures_A.SchedContext sc n)) (read_sched_context scp)"
-  unfolding read_sched_context_def no_ofail_def
-  by (clarsimp simp: obj_at_def is_sc_obj obind_def)
-
-lemma no_ofail_read_sc_refill_ready:
-  "no_ofail (\<lambda>s. \<exists>sc n. kheap s scp = Some (Structures_A.SchedContext sc n)) (read_sc_refill_ready scp)"
-  unfolding read_sc_refill_ready_def no_ofail_def
-  by (clarsimp simp: omonad_defs obind_def dest!: no_ofailD[OF no_ofail_read_sched_context])
-
-lemma rescheduleRequired_corres_weak:
-  "corres dc (valid_tcbs and weaker_valid_sched_action and pspace_aligned and pspace_distinct
-              and active_scs_valid)
-             (valid_tcbs' and Invariants_H.valid_queues and valid_queues' and valid_release_queue_iff)
-             reschedule_required rescheduleRequired"
-  apply (simp add: rescheduleRequired_def reschedule_required_def)
-  apply (rule corres_underlying_split[OF _ _ gets_sp, rotated 2])
-    apply (clarsimp simp: getSchedulerAction_def)
-    apply (rule gets_sp)
-   apply (corresKsimp corres: getSchedulerAction_corres)
-  apply (rule corres_underlying_split[where r'=dc, rotated]; (solves \<open>wpsimp\<close>)?)
-   apply (corresKsimp corres: setSchedulerAction_corres)
-  apply (case_tac action; clarsimp?)
-  apply (rename_tac tp)
-  apply (rule corres_underlying_split[OF _ _ is_schedulable_sp isSchedulable_inv, rotated 2])
-   apply (corresKsimp corres: isSchedulable_corres)
-   apply (clarsimp simp: weaker_valid_sched_action_def obj_at_def vs_all_heap_simps is_tcb_def)
-  apply (clarsimp simp: when_def)
-
-  apply (rule corres_symb_exec_l[OF _ thread_get_exs_valid thread_get_sp , rotated])
-    apply (clarsimp simp: weaker_valid_sched_action_def vs_all_heap_simps obj_at_def is_tcb_def)
-   apply (wpsimp simp: thread_get_def get_tcb_def weaker_valid_sched_action_def vs_all_heap_simps)
-   apply (clarsimp simp: obj_at_def is_tcb_def)
-   apply (clarsimp split: Structures_A.kernel_object.splits)
-  apply (rule corres_symb_exec_l[OF _ _ assert_opt_sp, rotated])
-    apply (clarsimp simp: exs_valid_def obj_at_def return_def is_schedulable_opt_def get_tcb_def
-                   split: option.splits)
-   apply (clarsimp simp: no_fail_def obj_at_def return_def is_schedulable_opt_def get_tcb_def
-                  split: Structures_A.kernel_object.splits option.splits)
-
-  apply (rule corres_symb_exec_l[OF _ _ get_sc_refill_sufficient_sp, rotated])
-    apply (wpsimp wp: get_sched_context_exs_valid exs_valid_bind
-                simp: get_sc_refill_sufficient_def is_schedulable_opt_def get_tcb_def obj_at_def
-                      is_sc_active_def
-               split: Structures_A.kernel_object.splits option.splits)
-   apply (wpsimp wp: get_sched_context_no_fail simp: get_sc_refill_sufficient_def)
-   apply (fastforce simp: valid_tcbs_def valid_tcb_def obj_at_def is_schedulable_opt_def get_tcb_def
-                          is_sc_active_def is_sc_obj_def
-                   split: option.splits Structures_A.kernel_object.splits)
-
-  apply (rule corres_symb_exec_l[OF _ _ get_sc_refill_ready_sp, rotated])
-    apply (wpsimp wp: get_sched_context_exs_valid gets_the_exs_valid
-                simp: get_sc_refill_ready_def)
-     apply (clarsimp intro!: no_ofailD[OF no_ofail_read_sc_refill_ready] simp: obj_at_def is_sc_obj)
-    apply simp
-   apply (wpsimp wp: get_sched_context_no_fail simp: get_sc_refill_ready_def)
-   apply (clarsimp intro!: no_ofailD[OF no_ofail_read_sc_refill_ready] simp: obj_at_def is_sc_obj)
-  apply (rule_tac F=sufficient in corres_req)
-   apply (clarsimp simp: obj_at_def is_schedulable_opt_def get_tcb_def)
-   apply (drule_tac tp=tp in active_valid_budget_sufficient)
-    apply (clarsimp simp: vs_all_heap_simps is_sc_active_def)
-   apply (clarsimp simp: return_def vs_all_heap_simps
-                         obj_at_def pred_tcb_at_def weaker_valid_sched_action_def)
-  apply (rule corres_symb_exec_l[OF _ _ assert_sp, rotated])
-    apply (clarsimp simp: exs_valid_def return_def vs_all_heap_simps
-                          obj_at_def pred_tcb_at_def weaker_valid_sched_action_def)
-   apply (clarsimp simp: no_fail_def return_def vs_all_heap_simps
-                         obj_at_def pred_tcb_at_def weaker_valid_sched_action_def)
-  apply (corresKsimp corres: tcbSchedEnqueue_corres
-                      simp: obj_at_def is_tcb_def weak_sch_act_wf_def)
+  apply (rule corres_from_valid_det)
+    apply (fastforce intro: det_wp_modify det_wp_pre simp: set_tcb_queue_def)
+   apply (wpsimp simp: tcbQueuePrepend_def wp: hoare_vcg_if_lift2 | drule Some_to_the)+
+   apply (clarsimp simp: ex_abs_underlying_def split: if_splits)
+   apply (frule state_relation_ready_queues_relation)
+   apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def)
+   apply (drule_tac x="tcbDomain tcb" in spec)
+   apply (drule_tac x="tcbPriority tcb" in spec)
+   subgoal by (force dest!: obj_at'_tcbQueueHead_ksReadyQueues simp: obj_at'_def projectKOs)
+
+  apply (rename_tac s rv t)
+  apply (clarsimp simp: state_relation_def)
+  apply (intro hoare_vcg_conj_lift_pre_fix;
+         (solves \<open>frule singleton_eqD, frule set_tcb_queue_projs_inv, wpsimp simp: swp_def\<close>)?)
+
+  \<comment> \<open>ready_queues_relation\<close>
+  apply (clarsimp simp: ready_queues_relation_def ready_queue_relation_def Let_def)
+  apply (intro hoare_allI)
+  apply (drule singleton_eqD)
+  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 (force simp: obj_at_def)
+   apply (force simp: obj_at'_def projectKOs)
+  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)"
+              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'
+              in obj_at'_tcbQueueEnd_ksReadyQueues)
+      apply fast
+     apply auto[1]
+    apply fastforce
+   apply fastforce
+  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))"
+              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"
+               in ready_queues_disjoint)
+      apply force
+     apply fastforce
+    apply fastforce
+   apply (prop_tac "tcbPtr \<notin> set (ready_queues s d p)")
+    apply (clarsimp simp: obj_at'_def opt_pred_def opt_map_def projectKOs)
+    apply (metis inQ_def option.simps(5) tcb_of'_TCB)
+   apply (intro conjI impI; simp)
+
+         \<comment> \<open>the ready queue was originally empty\<close>
+         apply (rule heap_path_heap_upd_not_in)
+          apply (clarsimp simp: fun_upd_apply split: if_splits)
+         apply fastforce
+        apply (clarsimp simp: queue_end_valid_def fun_upd_apply split: if_splits)
+       apply (rule prev_queue_head_heap_upd)
+        apply (clarsimp simp: fun_upd_apply split: if_splits)
+       apply (case_tac "ready_queues s d p";
+              clarsimp simp: fun_upd_apply tcbQueueEmpty_def split: if_splits)
+      apply (clarsimp simp: inQ_def in_opt_pred fun_upd_apply obj_at'_def split: if_splits)
+     apply (clarsimp simp: fun_upd_apply split: if_splits)
+    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)))
+                    \<notin> set (ready_queues s d p)")
+    apply (erule orthD2)
+    apply (clarsimp simp: tcbQueueEmpty_def)
+   apply (intro conjI impI allI)
+        apply (intro heap_path_heap_upd_not_in)
+          apply (clarsimp simp: fun_upd_apply split: if_splits)
+         apply simp
+        apply fastforce
+       apply (clarsimp simp: queue_end_valid_def fun_upd_apply split: if_splits)
+      apply (intro prev_queue_head_heap_upd)
+        apply (force simp: fun_upd_apply split: if_splits)
+       apply (case_tac "ready_queues s d p";
+              force simp: fun_upd_apply tcbQueueEmpty_def split: if_splits)
+      apply (clarsimp simp: fun_upd_apply inQ_def split: if_splits)
+      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 projectKOs split: if_splits)
+     apply (case_tac "t = the (tcbQueueHead (ksReadyQueues s' (tcb_domain etcb, tcb_priority etcb)))")
+      apply (clarsimp simp: inQ_def opt_pred_def opt_map_def obj_at'_def projectKOs fun_upd_apply
+                     split: option.splits)
+      apply metis
+     apply (clarsimp simp: inQ_def in_opt_pred opt_map_def fun_upd_apply)
+    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>
+  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)"
+              in tcbQueueHead_iff_tcbQueueEnd)
+   apply (force simp: list_queue_relation_def)
+  apply (frule valid_tcbs'_maxDomain[where t=tcbPtr], simp add: obj_at'_def projectKOs)
+  apply (frule valid_tcbs'_maxPriority[where t=tcbPtr], simp add: obj_at'_def projectKOs)
+  apply (drule valid_sched_pointersD[where t=tcbPtr])
+    apply (clarsimp simp: in_opt_pred opt_map_red obj_at'_def)
+   apply (clarsimp simp: in_opt_pred opt_map_red obj_at'_def projectKOs)
+  apply (intro conjI; clarsimp simp: tcbQueueEmpty_def)
+
+   \<comment> \<open>the ready queue was originally empty\<close>
+   apply (force simp: inQ_def in_opt_pred fun_upd_apply queue_end_valid_def prev_queue_head_def
+                      opt_map_red obj_at'_def projectKOs
+               split: if_splits)
+
+  \<comment> \<open>the ready queue was not originally empty\<close>
+  apply (drule (2) heap_ls_prepend[where new=tcbPtr])
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply)
+  apply (rule conjI)
+   apply (subst opt_map_upd_triv)
+    apply (clarsimp simp: opt_map_def obj_at'_def projectKOs fun_upd_apply split: if_splits)
+   apply (clarsimp simp: fun_upd_apply obj_at'_def projectKOs split: if_splits)
+  apply (rule conjI)
+   apply (clarsimp simp: fun_upd_apply queue_end_valid_def)
+  apply (rule conjI)
+   apply (clarsimp simp: prev_queue_head_def fun_upd_apply opt_map_def split: if_splits)
+  by (auto dest!: hd_in_set
+            simp: inQ_def in_opt_pred opt_map_def fun_upd_apply obj_at'_def projectKOs
+           split: if_splits option.splits)
+
+definition
+  weak_sch_act_wf :: "scheduler_action \<Rightarrow> kernel_state \<Rightarrow> bool"
+where
+ "weak_sch_act_wf sa = (\<lambda>s. \<forall>t. sa = SwitchToThread t \<longrightarrow> st_tcb_at' runnable' t s \<and> tcb_in_cur_domain' t s)"
+
+lemma weak_sch_act_wf_updateDomainTime[simp]:
+  "weak_sch_act_wf m (ksDomainTime_update f s) = weak_sch_act_wf m s"
+  by (simp add:weak_sch_act_wf_def tcb_in_cur_domain'_def )
+
+lemma setSchedulerAction_corres:
+  "sched_act_relation sa sa'
+    \<Longrightarrow> corres dc \<top> \<top> (set_scheduler_action sa) (setSchedulerAction sa')"
+  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)
+  done
+
+lemma getSchedulerAction_corres:
+  "corres sched_act_relation \<top> \<top> (gets scheduler_action) getSchedulerAction"
+  apply (simp add: getSchedulerAction_def)
+  apply (clarsimp simp: state_relation_def)
   done
 
 lemma rescheduleRequired_corres:
-  "corres dc (valid_tcbs and weak_valid_sched_action and pspace_aligned and pspace_distinct
-              and active_scs_valid)
-             (valid_tcbs' and valid_queues and valid_queues' and valid_release_queue_iff)
-             reschedule_required rescheduleRequired"
-  by (rule corres_guard_imp[OF rescheduleRequired_corres_weak])
-     (auto simp: weak_valid_sched_action_strg)
+  "corres dc
+     (weak_valid_sched_action and in_correct_ready_q and ready_qs_distinct and valid_etcbs
+      and pspace_aligned and pspace_distinct)
+     (sym_heap_sched_pointers and valid_sched_pointers and valid_tcbs')
+     (reschedule_required) rescheduleRequired"
+  apply (simp add: rescheduleRequired_def reschedule_required_def)
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF getSchedulerAction_corres])
+      apply (rule_tac P="case action of switch_thread t \<Rightarrow> P t | _ \<Rightarrow> \<top>"
+                  and P'="case actiona of SwitchToThread t \<Rightarrow> P' t | _ \<Rightarrow> \<top>" for P P'
+              in corres_split[where r'=dc])
+         apply (case_tac action)
+           apply simp
+          apply simp
+          apply (rule tcbSchedEnqueue_corres, simp)
+         apply simp
+        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 (clarsimp split: scheduler_action.splits)
+  done
 
 lemma rescheduleRequired_corres_simple:
   "corres dc \<top> sch_act_simple
@@ -2236,7 +2772,7 @@ apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | simp add: assms)+
 done
 
 lemmas threadSet_weak_sch_act_wf
-  = weak_sch_act_wf_lift[OF threadSet.ksSchedulerAction threadSet_pred_tcb_no_state threadSet_tcbDomain_triv, simplified]
+  = weak_sch_act_wf_lift[OF threadSet_nosch threadSet_pred_tcb_no_state threadSet_tcbDomain_triv, simplified]
 
 lemma removeFromBitmap_nosch[wp]:
   "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> removeFromBitmap d p \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
@@ -2255,13 +2791,26 @@ lemmas addToBitmap_weak_sch_act_wf[wp]
   = weak_sch_act_wf_lift[OF addToBitmap_nosch]
 
 crunch removeFromBitmap
- for obj_at'[wp]: "\<lambda>s. Q (obj_at' P t s)"
+  for st_tcb_at'[wp]: "st_tcb_at' P t"
+crunch removeFromBitmap
+  for pred_tcb_at'[wp]: "\<lambda>s. Q (pred_tcb_at' proj P t s)"
+
+crunch removeFromBitmap
+  for not_st_tcb_at'[wp]: "\<lambda>s. \<not> (st_tcb_at' P' t) s"
+
 crunch addToBitmap
- for obj_at'[wp]: "\<lambda>s. Q (obj_at' P t s)"
+  for st_tcb_at'[wp]: "st_tcb_at' P' t"
+crunch addToBitmap
+  for pred_tcb_at'[wp]: "\<lambda>s. Q (pred_tcb_at' proj P t s)"
+
+crunch addToBitmap
+  for not_st_tcb_at'[wp]: "\<lambda>s. \<not> (st_tcb_at' P' t) s"
+
 crunch removeFromBitmap
- for pred_tcb_at'[wp]: "\<lambda>s. Q (pred_tcb_at' proj P t s)"
+  for obj_at'[wp]: "\<lambda>s. Q (obj_at' P t s)"
+
 crunch addToBitmap
- for pred_tcb_at'[wp]: "\<lambda>s. Q (pred_tcb_at' proj P' t s)"
+  for obj_at'[wp]: "\<lambda>s. Q (obj_at' P t s)"
 
 lemma removeFromBitmap_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t\<rbrace> removeFromBitmap tdom prio \<lbrace>\<lambda>ya. tcb_in_cur_domain' t\<rbrace>"
@@ -2658,114 +3207,32 @@ lemma thread_get_isRunnable_corres:
   apply (case_tac "tcb_state x",simp_all)
   done
 
-lemma setObject_tcbState_update_corres:
-  "\<lbrakk>thread_state_relation ts ts'; tcb_relation tcb tcb'\<rbrakk> \<Longrightarrow>
-   corres dc
-          (ko_at (TCB tcb) t)
-          (ko_at' tcb' t)
-          (set_object t (TCB (tcb\<lparr>tcb_state := ts\<rparr>)))
-          (setObject t (tcbState_update (\<lambda>_. ts') tcb'))"
-  apply (rule setObject_update_TCB_corres')
-     apply (simp add: tcb_relation_def)
-    apply (rule ball_tcb_cap_casesI; clarsimp)
-   apply (rule ball_tcb_cte_casesI; clarsimp)
-  apply simp
-  done
-
-lemma threadSet_wp:
-  "\<lbrace>\<lambda>s. \<forall>tcb :: tcb. ko_at' tcb t s \<longrightarrow> P (set_obj' t (f tcb) s)\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_. P\<rbrace>"
-  unfolding threadSet_def
-  apply (wpsimp wp: setObject_tcb_wp set_tcb'.getObject_wp)
-  done
-
-\<comment>\<open>
-  If we don't change the @{term tcbInReleaseQueue} flag of a TCB,
-  then the release queues stay valid.
-\<close>
-lemma setObject_valid_release_queue:
-  "\<lbrace>valid_release_queue
-      and obj_at' (\<lambda>old_tcb. tcbInReleaseQueue old_tcb \<longrightarrow> tcbInReleaseQueue tcb) ptr\<rbrace>
-   setObject ptr tcb
-   \<lbrace>\<lambda>rv. valid_release_queue\<rbrace>"
-  unfolding valid_release_queue_def
-  apply (rule hoare_allI)
-  apply (wpsimp wp: setObject_tcb_obj_at'_strongest hoare_vcg_imp_lift)
-  apply (clarsimp simp: obj_at'_imp obj_at'_def)
-  done
-
-lemma setObject_valid_release_queue':
-  "\<lbrace>valid_release_queue'
-      and obj_at' (\<lambda>old_tcb. tcbInReleaseQueue tcb \<longrightarrow> tcbInReleaseQueue old_tcb) ptr\<rbrace>
-   setObject ptr tcb
-   \<lbrace>\<lambda>rv. valid_release_queue'\<rbrace>"
-  unfolding valid_release_queue'_def
-  apply (rule hoare_allI)
-  apply (wpsimp wp: setObject_tcb_obj_at'_strongest hoare_vcg_imp_lift)
-  apply (rename_tac t s)
-  apply (case_tac "ptr = t"; clarsimp)
-  done
-
 lemma setThreadState_corres:
-  assumes "thread_state_relation ts ts'"
-  shows "corres dc
-          (valid_tcbs and pspace_aligned and pspace_distinct and tcb_at t and valid_tcb_state ts)
-          (valid_tcbs' and valid_release_queue_iff)
+  "thread_state_relation ts ts' \<Longrightarrow>
+   corres dc
+          (tcb_at t and pspace_aligned and pspace_distinct)
+          \<top>
           (set_thread_state t ts) (setThreadState ts' t)"
-    (is "corres _ _ ?conc_guard _ _")
-  using assms
-  apply -
-  apply (rule corres_cross_over_guard
-                  [where Q="?conc_guard and tcb_at' t and valid_tcb_state' ts'"])
-   apply (solves \<open>auto simp: state_relation_def intro: valid_tcb_state_cross tcb_at_cross\<close>)[1]
-  apply (simp add: set_thread_state_def setThreadState_def threadSet_def)
+  (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 (subst bind_assoc[symmetric], subst thread_set_def[simplified, symmetric])
   apply (rule corres_guard_imp)
-    apply (subst bind_assoc)
-    apply (rule corres_split[OF getObject_TCB_corres])
-      apply (rule corres_split[OF setObject_tcbState_update_corres])
-          apply assumption
-         apply assumption
-        apply (simp add: set_thread_state_act_def scheduleTCB_def)
+    apply (rule corres_split[where r'=dc])
+       apply (rule threadset_corres, (simp add: tcb_relation_def exst_same_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])
           apply (rule corres_split[OF getSchedulerAction_corres])
-            apply (rule corres_split[OF isSchedulable_corres])
-              apply (rule corres_split corres_when)+
-               apply (rename_tac sched_act sched_act' dont_care dont_care')
-               apply (case_tac sched_act; clarsimp)
-              apply (rule rescheduleRequired_corres_simple)
-             apply wpsimp
-            apply (wpsimp simp: isSchedulable_def inReleaseQueue_def
-                            wp: threadGet_obj_at'_field getObject_tcb_wp)
-           apply wp
-          apply wp
-         apply wp
-        apply wp
-       apply wpsimp
-      apply (wpsimp simp: pred_conj_def sch_act_simple_def obj_at_ko_at'_eq
-                      wp: setObject_tcb_valid_tcbs' setObject_tcb_obj_at'_strongest
-                          setObject_valid_release_queue setObject_valid_release_queue')
-     apply wp
-    apply (wpsimp wp: getObject_tcb_wp)
-   apply (fastforce intro: valid_tcb_state_update valid_tcbs_valid_tcb
-                     simp: obj_at_def is_tcb_def)
-  apply (fastforce intro: valid_tcb'_tcbState_update
-                    simp: projectKOs valid_tcbs'_def obj_at'_def)+
+            apply (simp only: when_def)
+            apply (rule corres_if[where Q=\<top> and Q'=\<top>])
+              apply (rule iffI)
+               apply clarsimp+
+              apply (case_tac rva,simp_all)[1]
+             apply (wp rescheduleRequired_corres_simple corres_return_trivial | simp)+
+    apply (wp hoare_vcg_conj_lift[where Q'="\<top>\<top>"] | simp add: sch_act_simple_def)+
   done
 
-lemma set_tcb_obj_ref_corresT:
-  assumes x: "\<And>tcb tcb'. tcb_relation tcb tcb' \<Longrightarrow>
-                         tcb_relation (f (\<lambda>_. new) tcb) (f' tcb')"
-  assumes y: "\<And>tcb. \<forall>(getF, setF) \<in> ran tcb_cap_cases. getF (f (\<lambda>_. new) tcb) = getF tcb"
-  assumes z: "\<forall>tcb. \<forall>(getF, setF) \<in> ran tcb_cte_cases.
-                 getF (f' tcb) = getF tcb"
-  shows      "corres dc (tcb_at t) (tcb_at' t)
-                     (set_tcb_obj_ref f t new) (threadSet f' t)"
-  by (clarsimp simp: set_tcb_obj_ref_thread_set threadset_corresT x y z)
-
-lemmas set_tcb_obj_ref_corres =
-    set_tcb_obj_ref_corresT [OF _ _ all_tcbI, OF _ ball_tcb_cap_casesI ball_tcb_cte_casesI]
-
 lemma setBoundNotification_corres:
   "corres dc
           (tcb_at t and pspace_aligned and pspace_distinct)
@@ -2777,36 +3244,49 @@ lemma setBoundNotification_corres:
   done
 
 crunch rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  (wp: crunch_wps)
-
-global_interpretation rescheduleRequired: typ_at_all_props' "rescheduleRequired"
-  by typ_at_props'
-
-global_interpretation tcbSchedDequeue: typ_at_all_props' "tcbSchedDequeue thread"
-  by typ_at_props'
+  for tcb'[wp]: "tcb_at' addr"
 
-global_interpretation threadSet: typ_at_all_props' "threadSet f p"
-  by typ_at_props'
+lemma tcbSchedNext_update_valid_objs'[wp]:
+  "\<lbrace>valid_objs' and valid_bound_tcb' ptrOpt\<rbrace>
+   threadSet (tcbSchedNext_update (\<lambda>_. ptrOpt)) tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (wpsimp wp: threadSet_valid_objs')
+  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
 
-global_interpretation setThreadState: typ_at_all_props' "setThreadState st p"
-  by typ_at_props'
+lemma tcbSchedPrev_update_valid_objs'[wp]:
+  "\<lbrace>valid_objs' and valid_bound_tcb' ptrOpt\<rbrace>
+   threadSet (tcbSchedPrev_update (\<lambda>_. ptrOpt)) tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (wpsimp wp: threadSet_valid_objs')
+  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
 
-global_interpretation setBoundNotification: typ_at_all_props' "setBoundNotification v p"
-  by typ_at_props'
+lemma tcbQueuePrepend_valid_objs'[wp]:
+  "\<lbrace>\<lambda>s. valid_objs' s \<and> tcb_at' tcbPtr s
+        \<and> (\<not> tcbQueueEmpty queue \<longrightarrow> tcb_at' (the (tcbQueueHead queue)) s)\<rbrace>
+   tcbQueuePrepend queue tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  unfolding tcbQueuePrepend_def
+  by (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift' simp: tcbQueueEmpty_def)
 
-global_interpretation scheduleTCB: typ_at_all_props' "scheduleTCB tcbPtr"
-  by typ_at_props'
+crunch addToBitmap
+  for valid_objs'[wp]: valid_objs'
+  (simp: unless_def crunch_simps wp: crunch_wps)
 
-lemma sts'_valid_mdb'[wp]:
-  "setThreadState st t \<lbrace>valid_mdb'\<rbrace>"
-  by (wpsimp simp: valid_mdb'_def)
+lemma tcbSchedEnqueue_valid_objs'[wp]:
+  "\<lbrace>valid_objs' and pspace_aligned' and pspace_distinct'\<rbrace>
+   tcbSchedEnqueue tcbPtr
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  unfolding tcbSchedEnqueue_def setQueue_def
+  apply (wpsimp wp: threadSet_valid_objs' getObject_tcb_wp simp: threadGet_def)
+  apply (fastforce dest!: obj_at'_tcbQueueHead_ksReadyQueues
+                    simp: ready_queue_relation_def ksReadyQueues_asrt_def obj_at'_def)
+  done
 
-crunch rescheduleRequired, removeFromBitmap, scheduleTCB
+crunch rescheduleRequired, removeFromBitmap
   for valid_objs'[wp]: valid_objs'
-  (simp: unless_def crunch_simps wp: crunch_wps)
+  (simp: crunch_simps)
 
 lemmas ko_at_valid_objs'_pre =
   ko_at_valid_objs'[simplified project_inject, atomized, simplified, rule_format]
@@ -2836,115 +3316,56 @@ lemma tcbSchedDequeue_valid_objs'[wp]:
   by (wpsimp wp: threadSet_valid_objs')
 
 lemma sts_valid_objs':
-  "\<lbrace>valid_objs' and valid_tcb_state' st\<rbrace>
-  setThreadState st t
-  \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
+  "\<lbrace>valid_objs' and valid_tcb_state' st and pspace_aligned' and pspace_distinct'\<rbrace>
+   setThreadState st t
+   \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
   apply (wpsimp simp: setThreadState_def wp: threadSet_valid_objs')
-  by (simp add: valid_tcb'_def tcb_cte_cases_def)
+   apply (rule_tac Q'="\<lambda>_. valid_objs' and pspace_aligned' and pspace_distinct'" in hoare_post_imp)
+    apply fastforce
+   apply (wpsimp wp: threadSet_valid_objs')
+  apply (simp add: valid_tcb'_def tcb_cte_cases_def cteSizeBits_def)
+  done
 
 lemma sbn_valid_objs':
   "\<lbrace>valid_objs' and valid_bound_ntfn' ntfn\<rbrace>
   setBoundNotification ntfn t
   \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
-  apply (wpsimp simp: setBoundNotification_def wp: threadSet_valid_objs')
-  by (simp add: valid_tcb'_def tcb_cte_cases_def)
-
-crunch setBoundNotification
-  for reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and st_tcb_at'[wp]: "st_tcb_at' P p"
-  and valid_replies' [wp]: valid_replies'
-  (wp: valid_replies'_lift threadSet_pred_tcb_no_state)
+  apply (simp add: setBoundNotification_def)
+  apply (wp threadSet_valid_objs')
+     apply (simp add: valid_tcb'_def tcb_cte_cases_def)
+  done
 
 lemma ssa_wp[wp]:
   "\<lbrace>\<lambda>s. P (s \<lparr>ksSchedulerAction := sa\<rparr>)\<rbrace> setSchedulerAction sa \<lbrace>\<lambda>_. P\<rbrace>"
   by (wpsimp simp: setSchedulerAction_def)
 
-crunch rescheduleRequired, tcbSchedDequeue, scheduleTCB
-  for st_tcb_at'[wp]: "st_tcb_at' P p"
-  and valid_replies' [wp]: valid_replies'
-  (wp: crunch_wps threadSet_pred_tcb_no_state valid_replies'_lift)
-
-crunch rescheduleRequired, tcbSchedDequeue, setThreadState
+crunch rescheduleRequired, tcbSchedDequeue
   for aligned'[wp]: "pspace_aligned'"
   and distinct'[wp]: "pspace_distinct'"
-  and bounded'[wp]: "pspace_bounded'"
-  and no_0_obj'[wp]: "no_0_obj'"
-  (wp: crunch_wps)
+  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
 
-lemma threadSet_valid_replies':
-  "\<lbrace>\<lambda>s. valid_replies' s  \<and>
-        (\<forall>tcb. ko_at' tcb t s
-           \<longrightarrow> (\<forall>rptr. tcbState tcb = BlockedOnReply (Some rptr)
-                       \<longrightarrow> is_reply_linked rptr s \<longrightarrow> tcbState (f tcb) = BlockedOnReply (Some rptr)))\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  apply (clarsimp simp: threadSet_def)
-  apply (wpsimp wp: setObject_tcb_valid_replies' getObject_tcb_wp)
-  by (force simp: pred_tcb_at'_def obj_at'_def projectKOs)
-
-lemma sts'_valid_replies':
-  "\<lbrace>\<lambda>s. valid_replies' s \<and>
-        (\<forall>rptr. st_tcb_at' ((=) (BlockedOnReply (Some rptr))) t s
-                  \<longrightarrow> is_reply_linked rptr s \<longrightarrow> st = BlockedOnReply (Some rptr))\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  apply (wpsimp wp: threadSet_valid_replies')
-  by (auto simp: pred_tcb_at'_def obj_at'_def projectKOs opt_map_def)
+crunch rescheduleRequired, tcbSchedDequeue
+  for no_0_obj'[wp]: "no_0_obj'"
 
 lemma sts'_valid_pspace'_inv[wp]:
-  "\<lbrace> valid_pspace' and tcb_at' t and valid_tcb_state' st
-     and (\<lambda>s. \<forall>rptr. st_tcb_at' ((=) (BlockedOnReply (Some rptr))) t s
-                      \<longrightarrow> st = BlockedOnReply (Some rptr) \<or> \<not> is_reply_linked rptr s)\<rbrace>
-   setThreadState st t
-   \<lbrace> \<lambda>rv. valid_pspace' \<rbrace>"
+  "\<lbrace> valid_pspace' and tcb_at' t and valid_tcb_state' st \<rbrace>
+  setThreadState st t
+  \<lbrace> \<lambda>rv. valid_pspace' \<rbrace>"
   apply (simp add: valid_pspace'_def)
-  apply (wpsimp wp: sts_valid_objs' sts'_valid_replies')
-  by (auto simp: opt_map_def)
-
-abbreviation
-  "is_replyState st \<equiv> is_BlockedOnReply st \<or> is_BlockedOnReceive st"
-
-lemma setObject_tcb_valid_replies'_except_Blocked:
-  "\<lbrace>\<lambda>s. valid_replies'_except {rptr} s \<and> replyTCBs_of s rptr = Some t
-        \<and> st_tcb_at' (\<lambda>st. is_replyState st \<longrightarrow> replyObject st = None) t s
-        \<and> (tcbState v = BlockedOnReply (Some rptr))\<rbrace>
-   setObject t (v :: tcb)
-   \<lbrace>\<lambda>rv. valid_replies'\<rbrace>"
-  supply opt_mapE[elim!]
-  unfolding valid_replies'_def valid_replies'_except_def
-  apply (subst pred_tcb_at'_eq_commute)+
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' hoare_vcg_ex_lift
-                    set_tcb'.setObject_obj_at'_strongest
-                simp: pred_tcb_at'_def simp_del: imp_disjL)
-  apply (rename_tac rptr' rp obj)
-  apply (case_tac "rptr' = rptr")
-   apply (fastforce simp: opt_map_def)
-  apply (drule_tac x=rptr' in spec, drule mp, clarsimp)
-  apply (auto simp: opt_map_def obj_at'_def)
-  done
-
-lemma threadSet_valid_replies'_except_Blocked:
-  "\<lbrace>\<lambda>s. valid_replies'_except {rptr} s \<and> replyTCBs_of s rptr = Some t
-        \<and> st_tcb_at' (\<lambda>st. is_replyState st \<longrightarrow> replyObject st = None) t s
-        \<and> (\<forall>tcb. tcbState (f tcb) = BlockedOnReply (Some rptr))\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  apply (clarsimp simp: threadSet_def)
-  apply (wpsimp wp: setObject_tcb_valid_replies'_except_Blocked[where rptr=rptr] getObject_tcb_wp)
-  by (auto simp: pred_tcb_at'_def obj_at'_def projectKOs)
-
-lemma sts'_valid_replies'_except_Blocked:
-  "\<lbrace>\<lambda>s. valid_replies'_except {rptr} s \<and> replyTCBs_of s rptr = Some t
-        \<and> st_tcb_at' (\<lambda>st. is_replyState st \<longrightarrow> replyObject st = None) t s\<rbrace>
-   setThreadState (BlockedOnReply (Some rptr)) t
-   \<lbrace>\<lambda>_. valid_replies'\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  apply (wpsimp wp: threadSet_valid_replies'_except_Blocked)
-  by (auto simp: pred_tcb_at'_def obj_at'_def projectKOs opt_map_def)
+  apply (rule hoare_pre)
+   apply (wp sts_valid_objs')
+   apply (simp add: setThreadState_def threadSet_def
+                    setQueue_def bind_assoc valid_mdb'_def)
+   apply (wp getObject_obj_at_tcb | simp)+
+  apply (clarsimp simp: valid_mdb'_def)
+  apply (drule obj_at_ko_at')
+  apply clarsimp
+  apply (erule obj_at'_weakenE)
+  apply (simp add: tcb_cte_cases_def)
+  done
 
 crunch setQueue
- for ct[wp]: "\<lambda>s. P (ksCurThread s)"
+  for ct[wp]: "\<lambda>s. P (ksCurThread s)"
 
 crunch setQueue
   for cur_domain[wp]: "\<lambda>s. P (ksCurDomain s)"
@@ -2956,10 +3377,10 @@ crunch removeFromBitmap
 
 lemma setQueue_tcb_in_cur_domain'[wp]:
   "\<lbrace>tcb_in_cur_domain' t\<rbrace> setQueue d p xs \<lbrace>\<lambda>_. tcb_in_cur_domain' t\<rbrace>"
-  apply (simp add: setQueue_def tcb_in_cur_domain'_def)
-  apply wp
-  apply (simp add: ps_clear_def projectKOs obj_at'_def)
-  done
+apply (simp add: setQueue_def tcb_in_cur_domain'_def)
+apply wp
+apply (simp add: ps_clear_def projectKOs obj_at'_def)
+done
 
 lemma sbn'_valid_pspace'_inv[wp]:
   "\<lbrace> valid_pspace' and tcb_at' t and valid_bound_ntfn' ntfn \<rbrace>
@@ -2969,7 +3390,7 @@ lemma sbn'_valid_pspace'_inv[wp]:
   apply (rule hoare_pre)
    apply (wp sbn_valid_objs')
    apply (simp add: setBoundNotification_def threadSet_def bind_assoc valid_mdb'_def)
-   apply (wp getObject_obj_at_tcb)
+   apply (wp getObject_obj_at_tcb | simp)+
   apply (clarsimp simp: valid_mdb'_def)
   apply (drule obj_at_ko_at')
   apply clarsimp
@@ -3010,13 +3431,13 @@ lemma threadSet_runnable_sch_act:
    \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   apply (clarsimp simp: valid_def)
   apply (frule_tac P1="(=) (ksSchedulerAction s)"
-                in use_valid [OF _ threadSet.ksSchedulerAction],
+                in use_valid [OF _ threadSet_nosch],
          rule refl)
   apply (frule_tac P1="(=) (ksCurThread s)"
-                in use_valid [OF _ threadSet.ct],
+                in use_valid [OF _ threadSet_ct],
          rule refl)
   apply (frule_tac P1="(=) (ksCurDomain s)"
-                in use_valid [OF _ threadSet.cur_domain],
+                in use_valid [OF _ threadSet_cd],
          rule refl)
   apply (case_tac "ksSchedulerAction b",
          simp_all add: sch_act_simple_def ct_in_state'_def pred_tcb_at'_def)
@@ -3040,28 +3461,25 @@ lemma threadSet_runnable_sch_act:
   done
 
 lemma threadSet_pred_tcb_at_state:
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow>
-         (p = t \<longrightarrow> obj_at' (\<lambda>tcb. P (Q (proj (tcb_to_itcb' (f tcb))))) t s) \<and>
-         (p \<noteq> t \<longrightarrow>  P (pred_tcb_at' proj Q p s))\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_ s. P (pred_tcb_at' proj Q p s)\<rbrace>"
-  unfolding threadSet_def
-  apply (wpsimp wp: set_tcb'.setObject_wp set_tcb'.getObject_wp)
-  apply (case_tac "p = t"; clarsimp)
-   apply (subst pred_tcb_at'_set_obj'_iff, assumption)
-   apply (clarsimp simp: obj_at'_def)
-  apply (subst pred_tcb_at'_set_obj'_distinct, assumption, assumption)
-  apply (clarsimp simp: obj_at'_def)
+  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> (if p = t
+        then obj_at' (\<lambda>tcb. P (proj (tcb_to_itcb' (f tcb)))) t s
+        else pred_tcb_at' proj P p s)\<rbrace>
+  threadSet f t \<lbrace>\<lambda>_. pred_tcb_at' proj P p\<rbrace>"
+  apply (rule hoare_chain)
+    apply (rule threadSet_obj_at'_really_strongest)
+   prefer 2
+   apply (simp add: pred_tcb_at'_def)
+  apply (clarsimp split: if_splits simp: pred_tcb_at'_def o_def)
   done
 
 lemma threadSet_tcbDomain_triv':
   "\<lbrace>tcb_in_cur_domain' t' and K (t \<noteq> t')\<rbrace> threadSet f t \<lbrace>\<lambda>_. tcb_in_cur_domain' t'\<rbrace>"
-  apply (simp add: tcb_in_cur_domain'_def)
-  apply (rule hoare_assume_pre)
-  apply simp
-  apply (rule_tac f="ksCurDomain" in hoare_lift_Pf)
-   apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | simp)+
-  done
+apply (simp add: tcb_in_cur_domain'_def)
+apply (rule hoare_assume_pre)
+apply simp
+apply (rule_tac f="ksCurDomain" in hoare_lift_Pf)
+apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | simp)+
+done
 
 lemma threadSet_sch_act_wf:
   "\<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s \<and> sch_act_not t s \<and>
@@ -3084,90 +3502,12 @@ lemma threadSet_sch_act_wf:
   apply (wp threadSet_pred_tcb_at_state threadSet_tcbDomain_triv' | clarsimp)+
   done
 
-definition
-  isScActive :: "machine_word \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
-  "isScActive scPtr s' \<equiv> pred_map (\<lambda>sc. 0 < scRefillMax sc) (scs_of' s') scPtr"
-
-abbreviation
-  "ct_isSchedulable \<equiv> ct_active'
-                       and (\<lambda>s. pred_map (\<lambda>tcb. \<not> tcbInReleaseQueue tcb) (tcbs_of' s) (ksCurThread s))
-                       and (\<lambda>s. pred_map (\<lambda>scPtr. isScActive scPtr s) (tcbSCs_of s) (ksCurThread s))"
-
-definition
-  isSchedulable_bool :: "machine_word \<Rightarrow> kernel_state \<Rightarrow> bool"
-where
-  "isSchedulable_bool tcbPtr s'
-    \<equiv> pred_map (\<lambda>tcb. runnable' (tcbState tcb) \<and> \<not>(tcbInReleaseQueue tcb)) (tcbs_of' s') tcbPtr
-      \<and> pred_map (\<lambda>scPtr. isScActive scPtr s') (tcbSCs_of s') tcbPtr"
-
-lemma isSchedulable_wp:
-  "\<lbrace>\<lambda>s. \<forall>t. isSchedulable_bool tcbPtr s = t \<and> tcb_at' tcbPtr s \<longrightarrow> P t s\<rbrace> isSchedulable tcbPtr \<lbrace>P\<rbrace>"
-  apply (clarsimp simp: isSchedulable_def)
-  apply (rule bind_wp[OF _ getObject_tcb_sp])
-  apply (wpsimp simp: hoare_vcg_if_lift2 obj_at_def is_tcb inReleaseQueue_def wp: threadGet_wp)
-  apply (rule conjI)
-   apply (fastforce simp: isSchedulable_bool_def isScActive_def obj_at'_def projectKOs
-                          pred_tcb_at'_def pred_map_simps in_opt_map_eq
-                   split: option.splits)
-  apply (clarsimp simp: isSchedulable_bool_def isScActive_def obj_at'_def projectKOs
-                         pred_tcb_at'_def pred_map_simps in_opt_map_eq vs_all_heap_simps
-                 split: option.splits)
-  by argo
-
-lemma isSchedulable_sp:
-  "\<lbrace>P\<rbrace> isSchedulable tcbPtr \<lbrace>\<lambda>rv. (\<lambda>s. rv = isSchedulable_bool tcbPtr s) and P\<rbrace>"
-  by (wpsimp wp: isSchedulable_wp)
-
-
 lemma rescheduleRequired_sch_act'[wp]:
   "\<lbrace>\<top>\<rbrace>
-   rescheduleRequired
+      rescheduleRequired
    \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (wpsimp simp: rescheduleRequired_def wp: isSchedulable_wp)
-
-lemma rescheduleRequired_weak_sch_act_wf[wp]:
-  "\<lbrace>\<top>\<rbrace>
-   rescheduleRequired
-   \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add: rescheduleRequired_def setSchedulerAction_def)
-  apply (wp hoare_TrueI | simp add: weak_sch_act_wf_def)+
-  done
-
-lemma sts_weak_sch_act_wf[wp]:
-  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s
-        \<and> (ksSchedulerAction s = SwitchToThread t \<longrightarrow> runnable' st)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding setThreadState_def scheduleTCB_def
-  apply (wpsimp wp: hoare_vcg_if_lift2 hoare_vcg_imp_lift hoare_vcg_all_lift
-                    threadSet_pred_tcb_at_state threadSet_tcbDomain_triv
-                    isSchedulable_inv
-                    hoare_pre_cont[where f="isSchedulable x" and P="\<lambda>rv _. rv" for x]
-                    hoare_pre_cont[where f="isSchedulable x" and P="\<lambda>rv _. \<not>rv" for x]
-              simp: weak_sch_act_wf_def)
-  done
-
-lemma threadSet_isSchedulable_bool_nochange:
-  "\<lbrace>\<lambda>s. runnable' st \<and> isSchedulable_bool t s\<rbrace>
-   threadSet (tcbState_update (\<lambda>_. st)) t
-   \<lbrace>\<lambda>_. isSchedulable_bool t\<rbrace>"
-  unfolding isSchedulable_bool_def threadSet_def
-  apply (rule bind_wp[OF _ getObject_tcb_sp])
-  apply (wpsimp wp: setObject_tcb_wp simp: pred_map_def obj_at'_def opt_map_def projectKOs)
-  apply (fastforce simp: pred_map_def projectKOs isScActive_def elim!: opt_mapE)
-  done
-
-lemma threadSet_isSchedulable_bool:
-  "\<lbrace>\<lambda>s. runnable' st
-      \<and> pred_map (\<lambda>tcb. \<not>(tcbInReleaseQueue tcb)) (tcbs_of' s) t
-      \<and> pred_map (\<lambda>scPtr. isScActive scPtr s) (tcbSCs_of s) t\<rbrace>
-   threadSet (tcbState_update (\<lambda>_. st)) t
-   \<lbrace>\<lambda>_. isSchedulable_bool t\<rbrace>"
-  unfolding isSchedulable_bool_def threadSet_def
-  apply (rule bind_wp[OF _ getObject_tcb_sp])
-  apply (wpsimp wp: setObject_tcb_wp simp: pred_map_def obj_at'_def opt_map_def projectKOs)
-  apply (fastforce simp: pred_map_def projectKOs isScActive_def elim!: opt_mapE)
+  apply (simp add: rescheduleRequired_def)
+  apply (wp | wpc | simp)+
   done
 
 lemma setObject_queued_pred_tcb_at'[wp]:
@@ -3201,7 +3541,7 @@ lemma threadSet_queued_sch_act_wf[wp]:
   apply (wp hoare_vcg_conj_lift)
    apply (simp add: threadSet_def)
    apply (wp hoare_weak_lift_imp)
-    apply wps
+    apply (wps setObject_sa_unchanged)
     apply (wp hoare_weak_lift_imp getObject_tcb_wp)+
    apply (clarsimp simp: obj_at'_def)
   apply (wp hoare_vcg_all_lift hoare_vcg_conj_lift hoare_convert_imp)+
@@ -3233,51 +3573,51 @@ lemma tcbSchedDequeue_sch_act_wf[wp]:
   by (wp setQueue_sch_act threadSet_tcbDomain_triv hoare_drop_imps
       | wp sch_act_wf_lift | simp add: if_apply_def2)+
 
-lemma scheduleTCB_sch_act_wf:
-  "\<lbrace>\<lambda>s. \<not>(t = ksCurThread s \<and> ksSchedulerAction s = ResumeCurrentThread
-        \<and> \<not> pred_map (\<lambda>tcb. runnable' (tcbState tcb)) (tcbs_of' s) t)
-        \<longrightarrow> (sch_act_wf (ksSchedulerAction s) s)\<rbrace>
-   scheduleTCB t \<lbrace>\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (simp add: scheduleTCB_def)
-  by (wpsimp wp: isSchedulable_wp  simp: isSchedulable_bool_def pred_map_def opt_map_Some)
+crunch tcbSchedDequeue
+  for nosch: "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma sts_sch_act':
   "\<lbrace>\<lambda>s. (\<not> runnable' st \<longrightarrow> sch_act_not t s) \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
   setThreadState st t  \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   apply (simp add: setThreadState_def)
-  apply (wp scheduleTCB_sch_act_wf)
+  apply (wp | simp)+
    prefer 2
    apply assumption
   apply (case_tac "runnable' st")
-   apply (wpsimp wp: hoare_drop_imps threadSet_runnable_sch_act)
+   apply ((wp threadSet_runnable_sch_act hoare_drop_imps | simp)+)[1]
   apply (rule_tac Q'="\<lambda>rv s. st_tcb_at' (Not \<circ> runnable') t s \<and>
-                            (ksCurThread s \<noteq> t \<or> ksSchedulerAction s \<noteq> ResumeCurrentThread \<longrightarrow>
-                               sch_act_wf (ksSchedulerAction s) s)"
-           in hoare_post_imp)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs pred_map_def elim!: opt_mapE)
+                     (ksCurThread s \<noteq> t \<or> ksSchedulerAction s \<noteq> ResumeCurrentThread \<longrightarrow>
+                            sch_act_wf (ksSchedulerAction s) s)"
+               in hoare_post_imp)
+   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
   apply (simp only: imp_conv_disj)
-  apply (wpsimp wp: threadSet_pred_tcb_at_state threadSet_sch_act_wf hoare_vcg_disj_lift)
+  apply (wp threadSet_pred_tcb_at_state threadSet_sch_act_wf
+            hoare_vcg_disj_lift|simp)+
   done
 
-(* FIXME: sts_sch_act' (above) is stronger, and should be the wp rule. VER-1366 *)
 lemma sts_sch_act[wp]:
   "\<lbrace>\<lambda>s. (\<not> runnable' st \<longrightarrow> sch_act_simple s) \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
      setThreadState st t
    \<lbrace>\<lambda>rv s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
   apply (simp add: setThreadState_def)
-  apply (wp scheduleTCB_sch_act_wf)
+  apply wp
+   apply simp
    prefer 2
    apply assumption
   apply (case_tac "runnable' st")
-   apply (wpsimp wp: hoare_drop_imps threadSet_runnable_sch_act)
+   apply (rule_tac P'="\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
+                in hoare_pre_imp, simp)
+   apply ((wp hoare_drop_imps threadSet_runnable_sch_act | simp)+)[1]
   apply (rule_tac Q'="\<lambda>rv s. st_tcb_at' (Not \<circ> runnable') t s \<and>
-                            (ksCurThread s \<noteq> t \<or> ksSchedulerAction s \<noteq> ResumeCurrentThread \<longrightarrow>
-                               sch_act_wf (ksSchedulerAction s) s)"
-           in hoare_post_imp)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs pred_map_def elim!: opt_mapE)
+                     (ksCurThread s \<noteq> t \<or> ksSchedulerAction s \<noteq> ResumeCurrentThread \<longrightarrow>
+                            sch_act_wf (ksSchedulerAction s) s)"
+               in hoare_post_imp)
+   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs)
   apply (simp only: imp_conv_disj)
-  apply (wpsimp wp: threadSet_pred_tcb_at_state threadSet_sch_act_wf hoare_vcg_disj_lift)
-  apply (fastforce simp: sch_act_simple_def)
+  apply (rule hoare_pre)
+   apply (wp threadSet_pred_tcb_at_state threadSet_sch_act_wf
+             hoare_vcg_disj_lift|simp)+
+  apply (auto simp: sch_act_simple_def)
   done
 
 lemma sbn_sch_act':
@@ -3298,33 +3638,31 @@ lemma sch_act_simple_lift:
    \<lbrace>sch_act_simple\<rbrace> f \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
   by (simp add: sch_act_simple_def) assumption
 
-lemma rescheduleRequired_sch_act_simple_True[wp]:
-  "\<lbrace>\<top>\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
-  by (wpsimp simp: rescheduleRequired_def)
-
-crunch scheduleTCB
-  for sch_act_simple[wp]: sch_act_simple
-  (wp: crunch_wps hoare_vcg_if_lift2)
+lemma rescheduleRequired_sch_act_simple[wp]:
+  "\<lbrace>sch_act_simple\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
+  apply (simp add: rescheduleRequired_def)
+  apply (wp | wpc | simp)+
+  done
 
 crunch tcbSchedDequeue
   for no_sa[wp]: "\<lambda>s. P (ksSchedulerAction s)"
 
 lemma sts_sch_act_simple[wp]:
   "\<lbrace>sch_act_simple\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  by (wpsimp simp: sch_act_simple_def)
+  apply (simp add: setThreadState_def)
+  apply (wp hoare_drop_imps | rule sch_act_simple_lift | simp)+
+  done
 
 lemma setQueue_after:
   "(setQueue d p q >>= (\<lambda>rv. threadSet f t)) =
    (threadSet f t >>= (\<lambda>rv. setQueue d p q))"
   apply (simp add: setQueue_def)
   apply (rule oblivious_modify_swap)
-  apply (simp add: threadSet_def getObject_def setObject_def obind_def
-                   loadObject_default_def gets_the_def omonad_defs read_magnitudeCheck_assert
-                   split_def projectKO_def alignCheck_assert readObject_def
-                   magnitudeCheck_assert updateObject_default_def
-            split: option.splits if_splits)
-  apply (intro oblivious_bind, simp_all split: option.splits)
+  apply (simp add: threadSet_def getObject_def setObject_def
+                   loadObject_default_def
+                   split_def projectKO_def2 alignCheck_assert
+                   magnitudeCheck_assert updateObject_default_def)
+  apply (intro oblivious_bind, simp_all)
   done
 
 lemma tcbSchedEnqueue_sch_act[wp]:
@@ -3342,15 +3680,20 @@ lemma tcbSchedEnqueue_weak_sch_act[wp]:
   apply (wp setQueue_sch_act threadSet_weak_sch_act_wf | clarsimp)+
   done
 
+lemma threadGet_wp:
+  "\<lbrace>\<lambda>s. \<forall>tcb. ko_at' tcb t s \<longrightarrow> P (f tcb) s\<rbrace> threadGet f t \<lbrace>P\<rbrace>"
+  apply (simp add: threadGet_def)
+  apply (wp getObject_tcb_wp)
+  apply (clarsimp simp: obj_at'_def)
+  done
+
 lemma threadGet_const:
   "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> obj_at' (P \<circ> f) t s\<rbrace> threadGet f t \<lbrace>\<lambda>rv s. P (rv)\<rbrace>"
-  apply (simp add: threadGet_getObject)
+  apply (simp add: threadGet_def liftM_def)
   apply (wp getObject_tcb_wp)
   apply (clarsimp simp: obj_at'_def)
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 schematic_goal l2BitmapSize_def': (* arch specific consequence *)
   "l2BitmapSize = numeral ?X"
   by (simp add: l2BitmapSize_def wordBits_def word_size numPriorities_def)
@@ -3543,7 +3886,7 @@ lemma addToBitmap_valid_bitmapQ:
 
 lemma threadGet_const_tcb_at:
   "\<lbrace>\<lambda>s. tcb_at' t s \<and> obj_at' (P s \<circ> f) t s\<rbrace> threadGet f t \<lbrace>\<lambda>rv s. P s rv \<rbrace>"
-  apply (simp add: threadGet_getObject)
+  apply (simp add: threadGet_def liftM_def)
   apply (wp getObject_tcb_wp)
   apply (clarsimp simp: obj_at'_def)
   done
@@ -3552,7 +3895,7 @@ lemma threadGet_const_tcb_at_imp_lift:
   "\<lbrace>\<lambda>s. tcb_at' t s \<and> obj_at' (P s \<circ> f) t s \<longrightarrow>  obj_at' (Q s \<circ> f) t s \<rbrace>
    threadGet f t
    \<lbrace>\<lambda>rv s. P s rv \<longrightarrow> Q s rv \<rbrace>"
-  apply (simp add: threadGet_getObject)
+  apply (simp add: threadGet_def liftM_def)
   apply (wp getObject_tcb_wp)
   apply (clarsimp simp: obj_at'_def)
   done
@@ -3615,304 +3958,36 @@ lemma rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple:
   apply (wp, fastforce)
   done
 
-lemma scheduleTCB_bitmapQ_sch_act_simple:
-  "\<lbrace>valid_bitmapQ and sch_act_simple\<rbrace>
-   scheduleTCB tcbPtr
-   \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-  by (wpsimp simp: scheduleTCB_def
-               wp: rescheduleRequired_valid_bitmapQ_sch_act_simple isSchedulable_inv
-                   hoare_vcg_if_lift2 hoare_drop_imps)
-
 lemma sts_valid_bitmapQ_sch_act_simple:
   "\<lbrace>valid_bitmapQ and sch_act_simple\<rbrace>
    setThreadState st t
    \<lbrace>\<lambda>_. valid_bitmapQ \<rbrace>"
-  apply (simp add: setThreadState_def pred_conj_def)
-  by (wpsimp wp: threadSet_valid_bitmapQ scheduleTCB_bitmapQ_sch_act_simple)
-
-lemma scheduleTCB_bitmapQ_no_L2_orphans_sch_act_simple:
-  "\<lbrace>bitmapQ_no_L2_orphans and sch_act_simple\<rbrace>
-   scheduleTCB tcbPtr
-   \<lbrace>\<lambda>_. bitmapQ_no_L2_orphans \<rbrace>"
-  by (wpsimp simp: scheduleTCB_def
-               wp: rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple isSchedulable_inv
-                   hoare_vcg_if_lift2 hoare_drop_imps)
+  apply (simp add: setThreadState_def)
+  apply (wp rescheduleRequired_valid_bitmapQ_sch_act_simple
+            threadSet_valid_bitmapQ [THEN hoare_strengthen_post])
+   apply (clarsimp simp: sch_act_simple_def inQ_def)+
+  done
 
 lemma sts_valid_bitmapQ_no_L2_orphans_sch_act_simple:
-  "\<lbrace> bitmapQ_no_L2_orphans and sch_act_simple\<rbrace>
-    setThreadState st t
-   \<lbrace>\<lambda>_. bitmapQ_no_L2_orphans \<rbrace>"
-  apply (simp add: setThreadState_def pred_conj_def)
-  by (wpsimp wp: threadSet_valid_bitmapQ_no_L2_orphans
-                 scheduleTCB_bitmapQ_no_L2_orphans_sch_act_simple)
-
-lemma scheduleTCB_bitmapQ_no_L1_orphans_sch_act_simple:
-  "\<lbrace>bitmapQ_no_L1_orphans and sch_act_simple\<rbrace>
-   scheduleTCB tcbPtr
-   \<lbrace>\<lambda>_. bitmapQ_no_L1_orphans \<rbrace>"
-  by (wpsimp simp: scheduleTCB_def
-               wp: rescheduleRequired_bitmapQ_no_L1_orphans_sch_act_simple isSchedulable_inv
-                   hoare_vcg_if_lift2 hoare_drop_imps)
+  "\<lbrace>bitmapQ_no_L2_orphans and sch_act_simple\<rbrace>
+   setThreadState st t
+   \<lbrace>\<lambda>_. bitmapQ_no_L2_orphans\<rbrace>"
+  apply (simp add: setThreadState_def)
+  apply (wp rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple
+            threadSet_valid_bitmapQ_no_L2_orphans [THEN hoare_strengthen_post])
+   apply (clarsimp simp: sch_act_simple_def inQ_def)+
+  done
 
 lemma sts_valid_bitmapQ_no_L1_orphans_sch_act_simple:
   "\<lbrace>bitmapQ_no_L1_orphans and sch_act_simple\<rbrace>
    setThreadState st t
    \<lbrace>\<lambda>_. bitmapQ_no_L1_orphans \<rbrace>"
-  apply (simp add: setThreadState_def pred_conj_def)
-  by (wpsimp wp: threadSet_valid_bitmapQ_no_L1_orphans
-                 scheduleTCB_bitmapQ_no_L1_orphans_sch_act_simple)
-
-lemma scheduleTCB_valid_queues:
-  "\<lbrace>Invariants_H.valid_queues\<rbrace>
-   scheduleTCB tcbPtr
-   \<lbrace>\<lambda>_. Invariants_H.valid_queues\<rbrace>"
-  apply (clarsimp simp: scheduleTCB_def getCurThread_def getSchedulerAction_def)
-  apply (intro bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp wp: isSchedulable_inv)
-  apply (rule hoare_when_cases; (solves \<open>wpsimp\<close>)?)
-  by (wpsimp simp: scheduleTCB_def sch_act_simple_def
-               wp: rescheduleRequired_valid_queues_sch_act_simple hoare_vcg_if_lift2
-                   hoare_drop_imps)
-
-lemma sts_valid_queues[wp]:
-  "setThreadState st t \<lbrace>valid_queues\<rbrace>"
-  apply (simp add: setThreadState_def pred_conj_def)
-  apply (wpsimp wp: threadSet_valid_queues scheduleTCB_valid_queues)
-  apply (clarsimp simp: inQ_def)
-  done
-
-lemma sbn_valid_queues:
-  "setBoundNotification ntfn t \<lbrace>Invariants_H.valid_queues\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_queues)
-  by (clarsimp simp: sch_act_simple_def Invariants_H.valid_queues_def valid_queues_no_bitmap_def
-                     inQ_def)+
-
-lemma addToBitmap_valid_queues'[wp]:
-  "\<lbrace> valid_queues' \<rbrace> addToBitmap d p \<lbrace>\<lambda>_. valid_queues' \<rbrace>"
-  unfolding valid_queues'_def addToBitmap_def
-            modifyReadyQueuesL1Bitmap_def modifyReadyQueuesL2Bitmap_def
-            getReadyQueuesL1Bitmap_def getReadyQueuesL2Bitmap_def
-  by (wp, simp)
-
-lemma tcbSchedEnqueue_valid_queues'[wp]:
-  "tcbSchedEnqueue t \<lbrace>valid_queues'\<rbrace>"
-  apply (simp add: tcbSchedEnqueue_def)
-  apply (rule hoare_pre)
-   apply (rule_tac Q'="\<lambda>rv. valid_queues' and obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
-           in bind_wp)
-    apply (rename_tac queued)
-    apply (case_tac queued; simp_all add: unless_def when_def)
-     apply (wp threadSet_valid_queues' setQueue_valid_queues' | simp)+
-         apply (subst conj_commute, wp)
-         apply (rule hoare_pre_post, assumption)
-         apply (clarsimp simp: addToBitmap_def modifyReadyQueuesL1Bitmap_def modifyReadyQueuesL2Bitmap_def
-         getReadyQueuesL1Bitmap_def getReadyQueuesL2Bitmap_def)
-         apply wp
-         apply fastforce
-        apply wp
-       apply (subst conj_commute)
-       apply clarsimp
-       apply (rule_tac Q'="\<lambda>rv. valid_queues'
-                   and obj_at' (\<lambda>obj. \<not> tcbQueued obj) t
-                   and obj_at' (\<lambda>obj. tcbPriority obj = prio) t
-                   and obj_at' (\<lambda>obj. tcbDomain obj = tdom) t
-                   and (\<lambda>s. t \<in> set (ksReadyQueues s (tdom, prio)))"
-                   in hoare_post_imp)
-        apply (clarsimp simp: valid_queues'_def obj_at'_def projectKOs inQ_def)
-       apply (wp setQueue_valid_queues' | simp | simp add: setQueue_def)+
-     apply (wp getObject_tcb_wp | simp add: threadGet_getObject)+
-     apply (clarsimp simp: obj_at'_def inQ_def projectKOs valid_queues'_def)
-    apply (wp getObject_tcb_wp | simp add: threadGet_getObject)+
-  apply (clarsimp simp: obj_at'_def)
-  done
-
-lemma rescheduleRequired_valid_queues'[wp]:
-  "rescheduleRequired \<lbrace>valid_queues'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wpsimp wp: isSchedulable_inv hoare_vcg_if_lift2)
-  done
-
-lemma tcbSchedEnqueue_sch_act_sane[wp]:
-  "tcbSchedEnqueue t \<lbrace>sch_act_sane\<rbrace>"
-  apply (clarsimp simp: tcbSchedEnqueue_def sch_act_sane_def)
-  by (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
-
-lemma rescheduleRequired_valid_release_queue[wp]:
-  "rescheduleRequired \<lbrace>valid_release_queue\<rbrace>"
-  apply (simp add: rescheduleRequired_def getSchedulerAction_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule_tac Q'="\<lambda>_. valid_release_queue" in bind_wp_fwd
-         ; (solves \<open>wpsimp simp: valid_release_queue_def\<close>)?)
-  done
-
-lemma rescheduleRequired_valid_release_queue'[wp]:
-  "rescheduleRequired \<lbrace>valid_release_queue'\<rbrace>"
-  apply (simp add: rescheduleRequired_def getSchedulerAction_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule_tac Q'="\<lambda>_. valid_release_queue'" in bind_wp_fwd
-         ; (solves \<open>wpsimp simp: valid_release_queue'_def\<close>)?)
-  done
-
-lemma setThreadState_valid_queues'[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: setThreadState_def scheduleTCB_def)
-  apply (rule bind_wp_fwd_skip)
-   apply (wp threadSet_valid_queues')
-   apply (clarsimp simp: inQ_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (clarsimp simp: getSchedulerAction_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp wp: isSchedulable_inv)
-  apply (rule hoare_when_cases; wpsimp simp: weak_sch_act_wf_def)
-  done
-
-lemma setThreadState_valid_release_queue[wp]:
-  "setThreadState st t \<lbrace>valid_release_queue\<rbrace>"
-  apply (simp add: setThreadState_def scheduleTCB_def)
-  apply (rule bind_wp_fwd_skip)
-   apply (wp threadSet_valid_release_queue)
-   using valid_release_queue_def apply simp
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (clarsimp simp: getSchedulerAction_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp wp: isSchedulable_inv)
-  apply (rule hoare_when_cases)
-   apply clarsimp
-  apply wpsimp
-  done
-
-lemma setThreadState_valid_release_queue'[wp]:
-  "setThreadState st t \<lbrace>valid_release_queue'\<rbrace>"
-  apply (simp add: setThreadState_def scheduleTCB_def)
-  apply (rule bind_wp_fwd_skip)
-   apply (wp threadSet_valid_release_queue')
-   apply (fastforce simp: obj_at'_def valid_release_queue'_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (clarsimp simp: getSchedulerAction_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp wp: isSchedulable_inv)
-  apply (rule hoare_when_cases)
-   apply clarsimp
-  apply wpsimp
-  done
-
-lemma setBoundNotification_valid_queues'[wp]:
-  "\<lbrace>\<lambda>s. valid_queues' s\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv. valid_queues'\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_queues')
-  apply (fastforce simp: inQ_def obj_at'_def pred_tcb_at'_def)
-  done
-
-lemma setBoundNotification_valid_release_queue[wp]:
-  "setBoundNotification ntfn t \<lbrace>valid_release_queue\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_release_queue)
-  apply (fastforce simp: inQ_def obj_at'_def pred_tcb_at'_def)
-  done
-
-lemma setBoundNotification_valid_release_queues[wp]:
-  "setBoundNotification ntfn t \<lbrace>valid_release_queue'\<rbrace>"
-  apply (simp add: setBoundNotification_def)
-  apply (wp threadSet_valid_release_queue')
-  apply (fastforce simp: inQ_def obj_at'_def pred_tcb_at'_def valid_release_queue'_def)
-  done
-
-lemma setThreadState_valid_objs'[wp]:
-  "\<lbrace> valid_tcb_state' st and valid_objs' \<rbrace> setThreadState st t \<lbrace> \<lambda>_. valid_objs' \<rbrace>"
-  apply (simp add: setThreadState_def pred_conj_def)
-  apply (wpsimp wp: threadSet_valid_objs')
-  apply (clarsimp simp: valid_tcb'_tcbState_update)
-  done
-
-crunch addToBitmap
-  for ksPSpace[wp]: "\<lambda>s. P (ksPSpace s ptr = opt)"
-
-lemma addToBitmap_valid_tcb'[wp]:
-  "addToBitmap tdom prio \<lbrace>valid_tcb' tcb\<rbrace>"
-  by (wpsimp simp: addToBitmap_def getReadyQueuesL2Bitmap_def getReadyQueuesL1Bitmap_def
-                   modifyReadyQueuesL2Bitmap_def modifyReadyQueuesL1Bitmap_def
-                   update_valid_tcb')
-
-lemma addToBitmap_valid_tcbs'[wp]:
-  "addToBitmap tdom prio \<lbrace>valid_tcbs'\<rbrace>"
-  unfolding valid_tcbs'_def
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')
-  done
-
-crunch setQueue
-  for valid_tcb'[wp]: "\<lambda>s. valid_tcb' tcb s"
-  and ksPSpace[wp]: "\<lambda>s. P (ksPSpace s ptr = opt)"
-
-lemma tcbSchedEnqueue_valid_tcb'[wp]:
-  "tcbSchedEnqueue thread \<lbrace>valid_tcb' tcb\<rbrace>"
-  apply (clarsimp simp: tcbSchedEnqueue_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (clarsimp simp: unless_def when_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)+
-  apply (wpsimp wp: threadSet_valid_tcb')
-  done
-
-lemma tcbSchedEnqueue_valid_tcbs'[wp]:
-  "tcbSchedEnqueue thread \<lbrace>valid_tcbs'\<rbrace>"
-  apply (clarsimp simp: tcbSchedEnqueue_def setQueue_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (clarsimp simp: unless_def when_def)
-  apply (rule bind_wp_fwd_skip, wpsimp simp: valid_tcbs'_def wp: update_valid_tcb')+
-  apply (wpsimp wp: threadSet_valid_tcbs')
-  done
-
-lemma setSchedulerAction_valid_tcbs'[wp]:
-  "setSchedulerAction sa \<lbrace>valid_tcbs'\<rbrace>"
-  unfolding valid_tcbs'_def
-  apply (wpsimp wp: hoare_vcg_all_lift update_valid_tcb')
-  done
-
-lemma rescheduleRequired_valid_tcb'[wp]:
-  "rescheduleRequired \<lbrace>valid_tcb' tcb\<rbrace>"
-  apply (clarsimp simp: rescheduleRequired_def)
-  apply (rule bind_wp_fwd_skip, wpsimp wp: update_valid_tcb' isSchedulable_wp)+
-  apply (wpsimp wp: update_valid_tcb')
-  done
-
-lemma rescheduleRequired_valid_tcbs'[wp]:
-  "rescheduleRequired \<lbrace>valid_tcbs'\<rbrace>"
-  apply (clarsimp simp: rescheduleRequired_def)
-  apply (rule bind_wp_fwd_skip, wpsimp wp: update_valid_tcb' isSchedulable_wp)+
-  apply (wpsimp wp: update_valid_tcb')
-  done
-
-crunch scheduleTCB
-  for valid_tcbs'[wp]: valid_tcbs'
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma setThreadState_valid_tcbs'[wp]:
-  "\<lbrace> valid_tcb_state' st and valid_tcbs' \<rbrace> setThreadState st t \<lbrace> \<lambda>_. valid_tcbs' \<rbrace>"
-  apply (simp add: setThreadState_def pred_conj_def)
-  apply (wpsimp wp: threadSet_valid_tcbs')
-  apply (clarsimp simp: valid_tcb'_tcbState_update)
-  done
-
-lemma rescheduleRequired_ksQ:
-  "\<lbrace>\<lambda>s. sch_act_simple s \<and> P (ksReadyQueues s)\<rbrace>
-    rescheduleRequired
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  including no_pre
-  apply (simp add: rescheduleRequired_def sch_act_simple_def)
-  apply (rule_tac Q'="\<lambda>rv s. (rv = ResumeCurrentThread \<or> rv = ChooseNewThread)
-                            \<and> P (ksReadyQueues s)" in bind_wp)
-   apply wpsimp
-   apply (case_tac x; simp)
-  apply wp
+  apply (simp add: setThreadState_def)
+  apply (wp rescheduleRequired_bitmapQ_no_L1_orphans_sch_act_simple
+            threadSet_valid_bitmapQ_no_L1_orphans [THEN hoare_strengthen_post])
+   apply (clarsimp simp: sch_act_simple_def inQ_def)+
   done
 
-lemma scheduleTCB_ksQ:
-  "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace>
-   scheduleTCB tcbPtr
-   \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
-  by (wpsimp simp: scheduleTCB_def sch_act_simple_def
-               wp: isSchedulable_inv rescheduleRequired_ksQ hoare_vcg_if_lift2 isSchedulable_wp)
-
 lemma setSchedulerAction_ksQ[wp]:
   "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setSchedulerAction act \<lbrace>\<lambda>_ s. P (ksReadyQueues s)\<rbrace>"
   by (wp, simp)
@@ -4081,16 +4156,14 @@ lemma getMRs_corres:
                   (tcb_at t and pspace_aligned and pspace_distinct) \<top>
                   (thread_get (arch_tcb_get_registers o tcb_arch) t)
                   (asUser t (mapM getRegister ARM_H.msgRegisters))"
-    unfolding arch_tcb_get_registers_def
-
-    apply (subst thread_get_as_user)
+    apply (subst thread_get_registers)
     apply (rule asUser_corres')
     apply (subst mapM_gets)
      apply (simp add: getRegister_def)
     apply (simp add: S ARM_H.msgRegisters_def msg_registers_def)
     done
   show ?thesis
-  apply (case_tac mi, simp add: get_mrs_def getMRs_def mirel split del: if_split)
+  apply (case_tac mi, simp add: get_mrs_def getMRs_def split del: if_split)
   apply (case_tac buf)
    apply (rule corres_guard_imp)
      apply (rule corres_split [where R = "\<lambda>_. \<top>" and R' =  "\<lambda>_. \<top>", OF T])
@@ -4276,10 +4349,10 @@ proof -
                    od)
              (take (unat n) msgRegisters))"
     apply (rule corres_guard_imp)
-      apply (rule_tac S=Id in corres_mapM, simp+)
-          apply (rule corres_split_eqr[OF asUser_getRegister_corres asUser_setRegister_corres])
-           apply (wp | clarsimp simp: msg_registers_def msgRegisters_def)+
-    done
+    apply (rule_tac S=Id in corres_mapM, simp+)
+        apply (rule corres_split_eqr[OF asUser_getRegister_corres asUser_setRegister_corres])
+        apply (wp | clarsimp simp: msg_registers_def msgRegisters_def)+
+        done
 
   have wordSize[simp]: "of_nat wordSize = 4"
     by (simp add: wordSize_def wordBits_def word_size)
@@ -4457,22 +4530,20 @@ lemma lookupIPCBuffer_corres:
                (tcb_at' t and invs')
                (lookup_ipc_buffer w t) (lookupIPCBuffer w t)"
   using lookupIPCBuffer_corres'
-  by (rule corres_guard_imp, auto simp: invs'_def)
+  by (rule corres_guard_imp, auto simp: invs'_def valid_state'_def)
 
-crunch lookupIPCBuffer
- for inv[wp]: P
-  (wp: crunch_wps)
 
-end
+crunch lookupIPCBuffer
+  for inv[wp]: P
 
-crunch scheduleTCB, possibleSwitchTo
-  for pred_tcb_at'[wp]: "\<lambda>s. P' (pred_tcb_at' proj P t s)"
-  (wp: crunch_wps simp: crunch_simps)
+crunch rescheduleRequired
+  for pred_tcb_at'[wp]: "pred_tcb_at' proj P t"
 
 lemma setThreadState_st_tcb':
   "\<lbrace>\<top>\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. st_tcb_at' (\<lambda>s. s = st) t\<rbrace>"
   apply (simp add: setThreadState_def)
-  by (wpsimp wp: threadSet_pred_tcb_at_state)
+  apply (wp threadSet_pred_tcb_at_state | simp add: if_apply_def2)+
+  done
 
 lemma setThreadState_st_tcb:
   "\<lbrace>\<lambda>s. P st\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
@@ -4500,7 +4571,6 @@ lemma setBoundNotification_bound_tcb:
 
 crunch rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
   for ct'[wp]: "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps simp: crunch_simps)
 
 lemma ct_in_state'_decomp:
   assumes x: "\<lbrace>\<lambda>s. t = (ksCurThread s)\<rbrace> f \<lbrace>\<lambda>rv s. t = (ksCurThread s)\<rbrace>"
@@ -4522,19 +4592,22 @@ lemma ct_in_state'_set:
   apply clarsimp
   done
 
-crunch setQueue, scheduleTCB, tcbSchedDequeue
+crunch setQueue, rescheduleRequired, tcbSchedDequeue
   for idle'[wp]: "valid_idle'"
   (simp: crunch_simps wp: crunch_wps)
 
 lemma sts_valid_idle'[wp]:
-  "\<lbrace>valid_idle' and (\<lambda>s. t = ksIdleThread s \<longrightarrow> idle' ts)\<rbrace>
+  "\<lbrace>valid_idle' and valid_pspace' and
+    (\<lambda>s. t = ksIdleThread s \<longrightarrow> idle' ts)\<rbrace>
    setThreadState ts t
    \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
   apply (simp add: setThreadState_def)
-  by (wpsimp wp: threadSet_idle' simp: idle_tcb'_def)
+  apply (wpsimp wp: threadSet_idle' simp: idle_tcb'_def)
+  done
 
 lemma sbn_valid_idle'[wp]:
-  "\<lbrace>valid_idle' and (\<lambda>s. t = ksIdleThread s \<longrightarrow> \<not>bound ntfn)\<rbrace>
+  "\<lbrace>valid_idle' and valid_pspace' and
+    (\<lambda>s. t = ksIdleThread s \<longrightarrow> \<not>bound ntfn)\<rbrace>
    setBoundNotification ntfn t
    \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
   apply (simp add: setBoundNotification_def)
@@ -4543,7 +4616,7 @@ lemma sbn_valid_idle'[wp]:
 
 lemma gts_sp':
   "\<lbrace>P\<rbrace> getThreadState t \<lbrace>\<lambda>rv. st_tcb_at' (\<lambda>st. st = rv) t and P\<rbrace>"
-  apply (simp add: getThreadState_def threadGet_getObject)
+  apply (simp add: getThreadState_def threadGet_def)
   apply wp
   apply (simp add: o_def pred_tcb_at'_def)
   apply (wp getObject_tcb_wp)
@@ -4552,7 +4625,7 @@ lemma gts_sp':
 
 lemma gbn_sp':
   "\<lbrace>P\<rbrace> getBoundNotification t \<lbrace>\<lambda>rv. bound_tcb_at' (\<lambda>st. st = rv) t and P\<rbrace>"
-  apply (simp add: getBoundNotification_def threadGet_getObject)
+  apply (simp add: getBoundNotification_def threadGet_def)
   apply wp
   apply (simp add: o_def pred_tcb_at'_def)
   apply (wp getObject_tcb_wp)
@@ -4593,131 +4666,73 @@ lemma tcbSchedDequeue_pred_tcb_at'[wp]:
   apply (clarsimp simp: obj_at'_def)
   done
 
-lemma tcbReleaseRemove_pred_tcb_at'[wp]:
-  "tcbReleaseRemove t \<lbrace>\<lambda>s. P' (pred_tcb_at' proj P t' s)\<rbrace>"
-  apply (rule_tac P=P' in P_bool_lift)
-  unfolding tcbReleaseRemove_def
-   apply (wp threadSet_pred_tcb_no_state
-          | clarsimp simp: tcb_to_itcb'_def setReleaseQueue_def
-                           setReprogramTimer_def getReleaseQueue_def)+
-  done
-
-crunch tcbReleaseRemove
-  for weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-
 lemma sts_st_tcb':
   "\<lbrace>if t = t' then K (P st) else st_tcb_at' P t\<rbrace>
   setThreadState st t'
   \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
-  by (cases "t = t'"
-      ; wpsimp wp: threadSet_pred_tcb_at_state simp: setThreadState_def)
-
-lemma sts_bound_tcb_at'[wp]:
-  "setThreadState st t' \<lbrace>bound_tcb_at' P t\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  by (cases "t = t'"
-      ; wpsimp wp: threadSet_pred_tcb_at_state
-             simp: pred_tcb_at'_def)+
-
-lemma sts_bound_sc_tcb_at'[wp]:
-  "setThreadState st t' \<lbrace>bound_sc_tcb_at' P t\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  by (cases "t = t'"
-      ; wpsimp wp: threadSet_pred_tcb_at_state
-             simp: pred_tcb_at'_def)+
-
-lemma sts_bound_yt_tcb_at'[wp]:
-  "setThreadState st t' \<lbrace>bound_yt_tcb_at' P t\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  by (cases "t = t'";
-      wpsimp wp: threadSet_pred_tcb_at_state
-           simp: pred_tcb_at'_def)
-
-lemma sbn_st_tcb'[wp]:
-  "setBoundNotification ntfn t' \<lbrace>st_tcb_at' P t\<rbrace>"
   apply (cases "t = t'",
-         simp_all add: setBoundNotification_def
+         simp_all add: setThreadState_def
                   split del: if_split)
    apply ((wp threadSet_pred_tcb_at_state | simp)+)[1]
-  apply (wp threadSet_obj_at'_really_strongest | simp add: pred_tcb_at'_def)+
+  apply (wp threadSet_obj_at'_really_strongest
+              | simp add: pred_tcb_at'_def)+
   done
 
-context begin interpretation Arch .
+lemma sts_bound_tcb_at':
+  "\<lbrace>bound_tcb_at' P t\<rbrace>
+  setThreadState st t'
+  \<lbrace>\<lambda>_. bound_tcb_at' P t\<rbrace>"
+  apply (cases "t = t'",
+         simp_all add: setThreadState_def
+                  split del: if_split)
+   apply ((wp threadSet_pred_tcb_at_state | simp)+)[1]
+   apply (wp threadSet_obj_at'_really_strongest
+               | simp add: pred_tcb_at'_def)+
+  done
 
-crunch scheduleTCB, setThreadState
-  for cte_wp_at'[wp]: "\<lambda>s. Q (cte_wp_at' P p s)"
-  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
-  (wp: hoare_when_weak_wp crunch_wps)
+lemma sbn_st_tcb':
+  "\<lbrace>st_tcb_at' P t\<rbrace>
+  setBoundNotification ntfn t'
+  \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
+  apply (cases "t = t'",
+         simp_all add: setBoundNotification_def
+                  split del: if_split)
+   apply ((wp threadSet_pred_tcb_at_state | simp)+)[1]
+  apply (wp threadSet_obj_at'_really_strongest
+              | simp add: pred_tcb_at'_def)+
+  done
 
-lemma sts_ctes_wp_at[wp]:
-  "setThreadState st p \<lbrace>\<lambda>s. P (cte_wp_at' Q p' s)\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  by (wpsimp wp: threadSet_cte_wp_at')
+crunch rescheduleRequired, tcbSchedDequeue, setThreadState, setBoundNotification
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
 
-lemmas setThreadState_cap_to'[wp]
-    = ex_cte_cap_to'_pres [OF sts_ctes_wp_at setThreadState_ksInterruptState]
+lemmas setThreadState_typ_ats[wp] = typ_at_lifts [OF setThreadState_typ_at']
+lemmas setBoundNotification_typ_ats[wp] = typ_at_lifts [OF setBoundNotification_typ_at']
 
 crunch setThreadState, setBoundNotification
   for aligned'[wp]: pspace_aligned'
   and distinct'[wp]: pspace_distinct'
-  and cte_wp_at'[wp]: "\<lambda>s. Q (cte_wp_at' P p s)"
-  (wp: hoare_when_weak_wp crunch_wps)
+  and cte_wp_at'[wp]: "cte_wp_at' P p"
+  (wp: hoare_when_weak_wp)
 
 crunch rescheduleRequired
- for refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
-  (wp: threadSet_state_refs_of' crunch_wps)
-
-crunch scheduleTCB
-  for state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
-
-abbreviation tcb_non_st_state_refs_of' ::
-  "kernel_state \<Rightarrow> obj_ref \<Rightarrow> (obj_ref \<times> reftype) set"
-  where
-  "tcb_non_st_state_refs_of' s t \<equiv>
-    {r \<in> state_refs_of' s t. snd r = TCBBound \<or> snd r = TCBSchedContext \<or> snd r = TCBYieldTo}"
-
-lemma state_refs_of'_helper2[simp]:
-  "tcb_non_st_state_refs_of' s t
-   = {r \<in> state_refs_of' s t. snd r = TCBBound}
-     \<union> {r \<in> state_refs_of' s t. snd r = TCBSchedContext}
-     \<union> {r \<in> state_refs_of' s t. snd r = TCBYieldTo}"
-  by fastforce
+  for refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
+  (wp: threadSet_state_refs_of')
 
 lemma setThreadState_state_refs_of'[wp]:
   "\<lbrace>\<lambda>s. P ((state_refs_of' s) (t := tcb_st_refs_of' st
-                                    \<union> tcb_non_st_state_refs_of' s t))\<rbrace>
-   setThreadState st t
+                                 \<union> {r \<in> state_refs_of' s t. snd r = TCBBound}))\<rbrace>
+     setThreadState st t
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
-  apply (clarsimp simp: setThreadState_def)
-  apply (wpsimp wp: threadSet_state_refs_of')
-      apply simp
-     apply force+
-  by (metis Un_assoc)
+  by (simp add: setThreadState_def fun_upd_def
+        | wp threadSet_state_refs_of')+
 
 lemma setBoundNotification_state_refs_of'[wp]:
-  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (t := (case ntfn of None \<Rightarrow> {} | Some new \<Rightarrow> {(new, TCBBound)})
-                                    \<union> {r \<in> state_refs_of' s t. snd r \<noteq> TCBBound}))\<rbrace>
-   setBoundNotification ntfn t
+  "\<lbrace>\<lambda>s. P ((state_refs_of' s) (t := tcb_bound_refs' ntfn
+                                 \<union> {r \<in> state_refs_of' s t. snd r \<noteq> TCBBound}))\<rbrace>
+     setBoundNotification ntfn t
    \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
-  apply (clarsimp simp: setBoundNotification_def)
-  apply (wpsimp wp: threadSet_state_refs_of'
-                     [where f'=id and h'=id and i'=id and F="tcbBoundNotification_update (\<lambda>_. ntfn)"]
-              simp: get_refs_def)
-     apply simp
-    apply simp
-   apply simp
-  apply (prop_tac "{r \<in> state_refs_of' s t. snd r \<noteq> TCBBound}
-                    = {r \<in> state_refs_of' s t. snd r \<noteq> TCBBound \<and> snd r \<noteq> TCBSchedContext
-                                               \<and> snd r \<noteq> TCBYieldTo}
-                      \<union> {r \<in> state_refs_of' s t. snd r = TCBSchedContext}
-                      \<union> {r \<in> state_refs_of' s t. snd r = TCBYieldTo}")
-   apply fastforce
-  by (metis id_def Un_ac(1) Un_ac(4))
-
-lemma setBoundNotification_list_refs_of_replies'[wp]:
-  "setBoundNotification ntfn t \<lbrace>\<lambda>s. P (list_refs_of_replies' s)\<rbrace>"
-  unfolding setBoundNotification_def
-  by wpsimp
+  by (simp add: setBoundNotification_def Un_commute fun_upd_def
+        | wp threadSet_state_refs_of' )+
 
 lemma sts_cur_tcb'[wp]:
   "\<lbrace>cur_tcb'\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. cur_tcb'\<rbrace>"
@@ -4798,14 +4813,17 @@ lemma getTCB_wp:
   apply (clarsimp simp: obj_at'_def)
   done
 
-lemma rescheduleRequired_iflive'[wp]:
-  "rescheduleRequired \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: rescheduleRequired_def)
-  apply (wpsimp wp: isSchedulable_wp)
-  apply (erule if_live_then_nonz_capE')
-  apply (fastforce simp: isSchedulable_bool_def pred_map_def
-                         ko_wp_at'_def obj_at'_def projectKO_eq projectKO_tcb
-                  elim!: opt_mapE)
+lemma tcbQueueRemove_if_live_then_nonz_cap':
+  "\<lbrace>if_live_then_nonz_cap' and valid_objs' and sym_heap_sched_pointers and ex_nonz_cap_to' tcbPtr\<rbrace>
+   tcbQueueRemove q tcbPtr
+   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
+  unfolding tcbQueueRemove_def
+  apply (wpsimp wp: tcbSchedPrev_update_iflive' tcbSchedNext_update_iflive'
+                    hoare_vcg_imp_lift' getTCB_wp)
+  apply (frule (1) tcb_ko_at_valid_objs_valid_tcb')
+  apply (force dest: sym_heapD2[where p'=tcbPtr] sym_heapD1[where p=tcbPtr]
+               elim: if_live_then_nonz_capE'
+               simp: valid_tcb'_def opt_map_def obj_at'_def projectKOs  ko_wp_at'_def)
   done
 
 lemma tcbQueueRemove_ex_nonz_cap_to'[wp]:
@@ -4878,15 +4896,13 @@ lemma sts_iflive'[wp]:
       \<and> pspace_aligned' s \<and> pspace_distinct' s\<rbrace>
      setThreadState st t
    \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
-  apply (simp add: setThreadState_def scheduleTCB_def rescheduleRequired_def
-                   getCurThread_def getSchedulerAction_def)
-  apply (rule_tac Q'="\<lambda>rv. if_live_then_nonz_cap'" in bind_wp_fwd)
+  apply (simp add: setThreadState_def setQueue_def)
+  apply wpsimp
+   apply (rule_tac Q'="\<lambda>rv. if_live_then_nonz_cap' and pspace_aligned' and pspace_distinct'"
+                in hoare_post_imp)
+    apply clarsimp
    apply (wpsimp wp: threadSet_iflive')
-        apply fastforce+
-  apply (intro bind_wp[OF _ gets_sp]
-               bind_wp[OF _ isSchedulable_sp])
-  apply (rule hoare_when_cases; (solves \<open>wpsimp\<close>)?)
-  apply (wpsimp wp: isSchedulable_inv hoare_vcg_if_lift2 hoare_drop_imps)
+  apply fastforce
   done
 
 lemma sbn_iflive'[wp]:
@@ -4900,23 +4916,7 @@ lemma sbn_iflive'[wp]:
   apply auto
   done
 
-crunch addToBitmap
-  for if_unsafe_then_cap'[wp]: if_unsafe_then_cap'
-
-lemma setThreadState_if_unsafe_then_cap'[wp]:
-  "setThreadState st p \<lbrace>if_unsafe_then_cap'\<rbrace>"
-  apply (clarsimp simp: setThreadState_def scheduleTCB_def rescheduleRequired_def when_def)
-  apply (rule bind_wp_fwd_skip)
-   apply (rule threadSet_ifunsafe'T)
-   apply (clarsimp simp: tcb_cte_cases_def)
-  apply (wpsimp simp: tcbSchedEnqueue_def)
-               apply (rule threadSet_ifunsafe'T)
-               apply (clarsimp simp: tcb_cte_cases_def)
-              apply (wpsimp simp: setQueue_def
-                              wp: isSchedulable_inv hoare_vcg_if_lift2 hoare_drop_imps)+
-  done
-
-crunch setBoundNotification
+crunch setThreadState, setBoundNotification
   for ifunsafe'[wp]: "if_unsafe_then_cap'"
 
 lemma st_tcb_ex_cap'':
@@ -4933,10 +4933,10 @@ lemma bound_tcb_ex_cap'':
               elim!: ko_wp_at'_weakenE
                      if_live_then_nonz_capE')
 
-crunch setThreadState
+crunch setThreadState, setBoundNotification
   for arch'[wp]:  "\<lambda>s. P (ksArchState s)"
   and it'[wp]: "\<lambda>s. P (ksIdleThread s)"
-  (wp: getObject_tcb_inv crunch_wps
+  (wp: getObject_inv_tcb
    simp: updateObject_default_def unless_def crunch_simps)
 
 crunch removeFromBitmap
@@ -4944,7 +4944,9 @@ crunch removeFromBitmap
 
 lemma sts_ctes_of [wp]:
   "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> setThreadState st t \<lbrace>\<lambda>rv s. P (ctes_of s)\<rbrace>"
-  by wpsimp
+  apply (simp add: setThreadState_def)
+  apply (wp threadSet_ctes_ofT | simp add: tcb_cte_cases_def)+
+  done
 
 lemma sbn_ctes_of [wp]:
   "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>rv s. P (ctes_of s)\<rbrace>"
@@ -4955,13 +4957,13 @@ lemma sbn_ctes_of [wp]:
 crunch setThreadState, setBoundNotification
   for ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
   and gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
-  (simp: unless_def crunch_simps wp: setObject_ksPSpace_only updateObject_default_inv crunch_wps)
+  (simp: unless_def crunch_simps wp: setObject_ksPSpace_only updateObject_default_inv)
 
 lemmas setThreadState_irq_handlers[wp]
     = valid_irq_handlers_lift'' [OF sts_ctes_of setThreadState_ksInterruptState]
 
 lemmas setBoundNotification_irq_handlers[wp]
-    = valid_irq_handlers_lift'' [OF sbn_ctes_of setBoundNotification.ksInterruptState]
+    = valid_irq_handlers_lift'' [OF sbn_ctes_of setBoundNotification_ksInterruptState]
 
 lemma sts_global_reds' [wp]:
   "\<lbrace>valid_global_refs'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. valid_global_refs'\<rbrace>"
@@ -4974,7 +4976,6 @@ lemma sbn_global_reds' [wp]:
 crunch setThreadState, setBoundNotification
   for irq_states' [wp]: valid_irq_states'
   and pde_mappings' [wp]: valid_pde_mappings'
-  (wp: crunch_wps)
 
 lemma addToBitmap_ksMachine[wp]:
   "\<lbrace>\<lambda>s. P (ksMachineState s)\<rbrace> addToBitmap d p \<lbrace>\<lambda>rv s. P (ksMachineState s)\<rbrace>"
@@ -4993,7 +4994,6 @@ lemma tcbSchedEnqueue_ksMachine[wp]:
 crunch setThreadState, setBoundNotification
   for ksMachine[wp]: "\<lambda>s. P (ksMachineState s)"
   and pspace_domain_valid[wp]: "pspace_domain_valid"
-  (wp: crunch_wps)
 
 lemma setThreadState_vms'[wp]:
   "\<lbrace>valid_machine_state'\<rbrace> setThreadState F t \<lbrace>\<lambda>rv. valid_machine_state'\<rbrace>"
@@ -5040,7 +5040,7 @@ lemma tcbSchedEnqueue_ct_not_inQ:
       apply (rule_tac P'="\<lambda>s. ksSchedulerAction s = ResumeCurrentThread
                   \<longrightarrow> obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<and> ksCurThread s \<noteq> t"
                   in hoare_pre_imp, clarsimp)
-      apply (rule hoare_convert_imp [OF threadSet.ksSchedulerAction])
+      apply (rule hoare_convert_imp [OF threadSet_nosch])
       apply (rule hoare_weaken_pre)
        apply (wps setObject_ct_inv)
        apply (rule threadSet_obj_at'_strongish)
@@ -5067,7 +5067,7 @@ lemma tcbSchedAppend_ct_not_inQ:
       apply (rule_tac P'="\<lambda>s. ksSchedulerAction s = ResumeCurrentThread
                   \<longrightarrow> obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s \<and> ksCurThread s \<noteq> t"
                   in hoare_pre_imp, clarsimp)
-      apply (rule hoare_convert_imp [OF threadSet.ksSchedulerAction])
+      apply (rule hoare_convert_imp [OF threadSet_nosch])
       apply (rule hoare_weaken_pre)
        apply (wps setObject_ct_inv)
        apply (rule threadSet_obj_at'_strongish)
@@ -5084,11 +5084,11 @@ lemma tcbSchedAppend_ct_not_inQ:
       done
   qed
 
-lemma setSchedulerAction_direct[wp]:
+lemma setSchedulerAction_direct:
   "\<lbrace>\<top>\<rbrace> setSchedulerAction sa \<lbrace>\<lambda>_ s. ksSchedulerAction s = sa\<rbrace>"
   by (wpsimp simp: setSchedulerAction_def)
 
-lemma rescheduleRequired_ct_not_inQ[wp]:
+lemma rescheduleRequired_ct_not_inQ:
   "\<lbrace>\<top>\<rbrace> rescheduleRequired \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
   apply (simp add: rescheduleRequired_def ct_not_inQ_def)
   apply (rule_tac Q'="\<lambda>_ s. ksSchedulerAction s = ChooseNewThread"
@@ -5096,34 +5096,31 @@ lemma rescheduleRequired_ct_not_inQ[wp]:
   apply (wp setSchedulerAction_direct)
   done
 
-lemma scheduleTCB_ct_not_inQ[wp]:
-  "scheduleTCB tcbPtr \<lbrace>ct_not_inQ\<rbrace>"
-  apply (clarsimp simp: scheduleTCB_def getCurThread_def getSchedulerAction_def)
-  by (wpsimp wp: rescheduleRequired_ct_not_inQ isSchedulable_inv hoare_vcg_if_lift2 hoare_drop_imps)
-
-crunch tcbSchedEnqueue, tcbSchedAppend, tcbSchedDequeue
+crunch tcbSchedEnqueue
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  (simp: unless_def)
+crunch tcbSchedAppend
   for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
   (simp: unless_def)
 
 lemma rescheduleRequired_sa_cnt[wp]:
   "\<lbrace>\<lambda>s. True \<rbrace> rescheduleRequired \<lbrace>\<lambda>_ s. ksSchedulerAction s = ChooseNewThread \<rbrace>"
   unfolding rescheduleRequired_def setSchedulerAction_def
-  by (wpsimp wp: hoare_vcg_if_lift2)
+  by wpsimp
 
 lemma possibleSwitchTo_ct_not_inQ:
   "\<lbrace>ct_not_inQ and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t)\<rbrace>
     possibleSwitchTo t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
   apply (simp add: possibleSwitchTo_def curDomain_def)
-  apply (wpsimp wp: rescheduleRequired_ct_not_inQ tcbSchedEnqueue_ct_not_inQ threadGet_wp
-              simp: inReleaseQueue_def
+  apply (wpsimp wp: hoare_weak_lift_imp rescheduleRequired_ct_not_inQ tcbSchedEnqueue_ct_not_inQ
+                    threadGet_wp
          | (rule hoare_post_imp[OF _ rescheduleRequired_sa_cnt], fastforce))+
-  apply (fastforce simp: obj_at'_def)
   done
 
 lemma threadSet_tcbState_update_ct_not_inQ[wp]:
   "\<lbrace>ct_not_inQ\<rbrace> threadSet (tcbState_update f) t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
   apply (simp add: ct_not_inQ_def)
-  apply (rule hoare_convert_imp [OF threadSet.ksSchedulerAction])
+  apply (rule hoare_convert_imp [OF threadSet_nosch])
   apply (simp add: threadSet_def)
   apply (wp)
     apply (wps setObject_ct_inv)
@@ -5142,7 +5139,7 @@ lemma threadSet_tcbState_update_ct_not_inQ[wp]:
 lemma threadSet_tcbBoundNotification_update_ct_not_inQ[wp]:
   "\<lbrace>ct_not_inQ\<rbrace> threadSet (tcbBoundNotification_update f) t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
   apply (simp add: ct_not_inQ_def)
-  apply (rule hoare_convert_imp [OF threadSet.ksSchedulerAction])
+  apply (rule hoare_convert_imp [OF threadSet_nosch])
   apply (simp add: threadSet_def)
   apply (wp)
     apply (wps setObject_ct_inv)
@@ -5164,7 +5161,10 @@ lemma setThreadState_ct_not_inQ:
   (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
   including no_pre
   apply (simp add: setThreadState_def)
-  by (wpsimp wp: threadSet_tcbState_update_ct_not_inQ)
+  apply (wp rescheduleRequired_ct_not_inQ)
+  apply (rule_tac Q'="\<lambda>_. ?PRE" in hoare_post_imp, clarsimp)
+  apply (wp)
+  done
 
 lemma setBoundNotification_ct_not_inQ:
   "\<lbrace>ct_not_inQ\<rbrace> setBoundNotification ntfn t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
@@ -5181,7 +5181,7 @@ lemma tcbSchedDequeue_ct_not_inQ[wp]:
       \<lbrace>ct_not_inQ and (\<lambda>_. \<forall>tcb. \<not>tcbQueued (F tcb))\<rbrace>
       threadSet F t \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
       apply (simp add: ct_not_inQ_def)
-      apply (wp hoare_convert_imp [OF threadSet.ksSchedulerAction])
+      apply (wp hoare_convert_imp [OF threadSet_nosch])
        apply (simp add: threadSet_def)
        apply (wp)
         apply (wps setObject_ct_inv)
@@ -5246,20 +5246,21 @@ lemma setSchedulerAction_spec:
   apply (simp add:ct_idle_or_in_cur_domain'_def)
   done
 
-crunch rescheduleRequired, setThreadState, setBoundNotification
-  for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  (wp: crunch_wps)
-
 lemma rescheduleRequired_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>\<top>\<rbrace> rescheduleRequired \<lbrace>\<lambda>rv. ct_idle_or_in_cur_domain'\<rbrace>"
   apply (simp add: rescheduleRequired_def)
   apply (wp setSchedulerAction_spec)
   done
 
-crunch scheduleTCB
-  for ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  (wp: crunch_wps hoare_vcg_if_lift2)
+lemma rescheduleRequired_ksCurDomain[wp]:
+  "\<lbrace> \<lambda>s. P (ksCurDomain s) \<rbrace> rescheduleRequired \<lbrace>\<lambda>_ s. P (ksCurDomain s) \<rbrace>"
+  apply (simp add: rescheduleRequired_def)
+  apply wpsimp
+  done
+
+lemma rescheduleRequired_ksDomSchedule[wp]:
+  "\<lbrace> \<lambda>s. P (ksDomSchedule s) \<rbrace> rescheduleRequired \<lbrace>\<lambda>_ s. P (ksDomSchedule s) \<rbrace>"
+  by (simp add: rescheduleRequired_def) wpsimp
 
 lemma setThreadState_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> setThreadState st tptr \<lbrace>\<lambda>rv. ct_idle_or_in_cur_domain'\<rbrace>"
@@ -5267,16 +5268,39 @@ lemma setThreadState_ct_idle_or_in_cur_domain'[wp]:
   apply (wp threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps | simp)+
   done
 
+lemma setThreadState_ksCurDomain[wp]:
+  "\<lbrace> \<lambda>s. P (ksCurDomain s) \<rbrace> setThreadState st tptr \<lbrace>\<lambda>_ s. P (ksCurDomain s) \<rbrace>"
+  apply (simp add: setThreadState_def)
+  apply wpsimp
+  done
+
+lemma setThreadState_ksDomSchedule[wp]:
+  "\<lbrace> \<lambda>s. P (ksDomSchedule s) \<rbrace> setThreadState st tptr \<lbrace>\<lambda>_ s. P (ksDomSchedule s) \<rbrace>"
+  apply (simp add: setThreadState_def)
+  apply wpsimp
+  done
+
 lemma setBoundNotification_ct_idle_or_in_cur_domain'[wp]:
   "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> setBoundNotification t a \<lbrace>\<lambda>rv. ct_idle_or_in_cur_domain'\<rbrace>"
   apply (simp add: setBoundNotification_def)
   apply (wp threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps | simp)+
   done
 
+lemma setBoundNotification_ksCurDomain[wp]:
+  "\<lbrace> \<lambda>s. P (ksCurDomain s) \<rbrace> setBoundNotification st tptr \<lbrace>\<lambda>_ s. P (ksCurDomain s) \<rbrace>"
+  apply (simp add: setBoundNotification_def)
+  apply wpsimp
+  done
+
+lemma setBoundNotification_ksDomSchedule[wp]:
+  "\<lbrace> \<lambda>s. P (ksDomSchedule s) \<rbrace> setBoundNotification st tptr \<lbrace>\<lambda>_ s. P (ksDomSchedule s) \<rbrace>"
+  apply (simp add: setBoundNotification_def)
+  apply wpsimp
+  done
+
 crunch rescheduleRequired, setBoundNotification, setThreadState
   for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
   and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  (wp: crunch_wps)
 
 lemma sts_utr[wp]:
   "\<lbrace>untyped_ranges_zero'\<rbrace> setThreadState st t \<lbrace>\<lambda>_. untyped_ranges_zero'\<rbrace>"
@@ -5685,46 +5709,6 @@ lemma sts_invs_minor':
   apply (frule tcb_in_valid_state', clarsimp+)
   by (cases st; simp add: valid_tcb_state'_def split: Structures_H.thread_state.split_asm)
 
-lemma valid_tcb_state'_same_tcb_st_refs_of':
-  "\<lbrakk>tcb_st_refs_of' st = tcb_st_refs_of' st'; valid_tcb_state' st s\<rbrakk>
-   \<Longrightarrow> valid_tcb_state' st' s"
-  apply (cases st'
-         ; clarsimp simp: valid_tcb_state'_def tcb_st_refs_of'_def
-                   split: Structures_H.thread_state.splits if_splits)
-  by (metis pair_inject reftype.distinct prod.inject)
-
-lemma sts_invs_minor':
-  "\<lbrace>st_tcb_at' (\<lambda>st'. (st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow>
-                       st' \<noteq> Inactive \<and> \<not> idle' st')
-                   \<and> (\<forall>rptr. st' = BlockedOnReply rptr \<longrightarrow>
-                             st = BlockedOnReply rptr)) t
-      and valid_tcb_state' st
-      and invs'\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: sts_sch_act' valid_irq_node_lift irqs_masked_lift setThreadState_ct_not_inQ
-              simp: cteCaps_of_def o_def pred_tcb_at'_eq_commute)
-  apply (intro conjI impI)
-    apply clarsimp
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-  apply (erule if_live_then_nonz_capE')
-  apply (clarsimp simp: pred_tcb_at'_def ko_wp_at'_def obj_at'_def projectKO_eq projectKO_tcb)
-  done
-
-lemma sts_invs':
-  "\<lbrace>(\<lambda>s. st \<noteq> Inactive \<and> \<not> idle' st \<longrightarrow> ex_nonz_cap_to' t s)
-      and (\<lambda>s. \<forall>rptr. st_tcb_at' ((=) (BlockedOnReply (Some rptr))) t s \<longrightarrow> (is_reply_linked rptr s) \<longrightarrow> st = BlockedOnReply (Some rptr))
-      and tcb_at' t
-      and valid_tcb_state' st
-      and invs'\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: sts_sch_act' valid_irq_node_lift irqs_masked_lift setThreadState_ct_not_inQ
-              simp: cteCaps_of_def o_def)
-  by metis
-
 lemma sts_cap_to'[wp]:
   "\<lbrace>ex_nonz_cap_to' p\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
   by (wp ex_nonz_cap_to_pres')
@@ -5743,17 +5727,6 @@ lemmas isTS_defs =
   isRestart_def isInactive_def
   isIdleThreadState_def
 
-(* FIXME: replace `sts_st_tcb_at'_cases`, which is missing the `tcb_at'` precondition. *)
-lemma setThreadState_st_tcb_at'_cases:
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow>
-          (t = t' \<longrightarrow> P st) \<and>
-          (t \<noteq> t' \<longrightarrow> st_tcb_at' P t' s)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_. st_tcb_at' P t'\<rbrace>"
-  unfolding setThreadState_def
-  apply (wpsimp wp: scheduleTCB_pred_tcb_at' threadSet_pred_tcb_at_state)
-  done
-
 lemma sts_st_tcb_at'_cases:
   "\<lbrace>\<lambda>s. ((t = t') \<longrightarrow> (P ts \<and> tcb_at' t' s)) \<and> ((t \<noteq> t') \<longrightarrow> st_tcb_at' P t' s)\<rbrace>
      setThreadState ts t
@@ -5762,13 +5735,6 @@ lemma sts_st_tcb_at'_cases:
   apply fastforce
   done
 
-lemma sts_st_tcb_at'_cases_strong:
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> (t = t' \<longrightarrow> P (P' ts)) \<and> (t \<noteq> t' \<longrightarrow> P (st_tcb_at' P' t' s))\<rbrace>
-   setThreadState ts t
-   \<lbrace>\<lambda>rv s. P (st_tcb_at' P' t' s) \<rbrace>"
-  unfolding setThreadState_def
-  by (wpsimp wp: scheduleTCB_pred_tcb_at' threadSet_pred_tcb_at_state)
-
 lemma threadSet_ct_running':
   "(\<And>tcb. tcbState (f tcb) = tcbState tcb) \<Longrightarrow>
   \<lbrace>ct_running'\<rbrace> threadSet f t \<lbrace>\<lambda>rv. ct_running'\<rbrace>"
@@ -5862,7 +5828,7 @@ proof -
 
   show ?thesis
     apply (wp dmo_invs' no_irq_storeWord no_irq)
-    apply (clarsimp simp: storeWord_def invs'_def)
+    apply (clarsimp simp: storeWord_def invs'_def valid_state'_def)
     apply (clarsimp simp: valid_machine_state'_def pointerInUserData_def
                assert_def simpler_modify_def fail_def bind_def return_def
                pageBits_def aligned_offset_ignore
@@ -5921,542 +5887,156 @@ lemma asUser_irq_handlers':
   apply (wpsimp wp: threadSet_irq_handlers' [OF all_tcbI, OF ball_tcb_cte_casesI] select_f_inv)
   done
 
-lemma archTcbUpdate_aux2: "(\<lambda>tcb. tcb\<lparr> tcbArch := f (tcbArch tcb)\<rparr>) = tcbArch_update f"
-  by (rule ext, case_tac tcb, simp)
-
-(* FIXME: rename. VER-1331 *)
-lemma threadSet_obj_at'_simple_strongest:
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow>
-          (t = t' \<longrightarrow> P (obj_at' (\<lambda>tcb. Q (f tcb)) t s)) \<and>
-          (t \<noteq> t' \<longrightarrow> P (obj_at' Q t' s))\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_ s. P (obj_at' (Q :: tcb \<Rightarrow> bool) t' s)\<rbrace>"
-  unfolding threadSet_def
-  apply (wpsimp wp: set_tcb'.setObject_obj_at'_strongest set_tcb'.getObject_wp)
-  apply (case_tac "t = t'"; clarsimp simp: obj_at'_def)
-  done
-
-(* Used as the "side condition template" for the `*_obj_at'_only_st_qd_ft` family of
-   `crunch`-able lemmas. Needs to keep the assumption about `f` separate from the hoare
-   triple so as to not pollute the side conditions that `crunch` will add to the final
-   lemma. *)
-lemma threadSet_obj_at'_only_st_qd_ft:
-  assumes "(\<forall>upd tcb. Q (tcbState_update upd tcb) = Q tcb) \<and>
-           (\<forall>upd tcb. Q (tcbQueued_update upd tcb) = Q tcb) \<and>
-           (\<forall>upd tcb. Q (tcbFault_update upd tcb) = Q tcb) \<longrightarrow>
-             (\<forall>tcb. Q (f tcb) = Q tcb)"
-  shows
-  "\<lbrace>\<lambda>s. P (obj_at' Q t' s) \<and>
-        (\<forall>upd tcb. Q (tcbState_update upd tcb) = Q tcb) \<and>
-        (\<forall>upd tcb. Q (tcbQueued_update upd tcb) = Q tcb) \<and>
-        (\<forall>upd tcb. Q (tcbFault_update upd tcb) = Q tcb)\<rbrace>
-   threadSet f t
-   \<lbrace>\<lambda>_ s. P (obj_at' Q t' s)\<rbrace>"
-  apply (wpsimp wp: threadSet_obj_at'_simple_strongest simp: assms)
-  done
+(* the brave can try to move this up to near setObject_update_TCB_corres' *)
 
-crunch scheduleTCB
-  for obj_at'_only_st_qd_ft: "\<lambda>s. P (obj_at' (Q :: tcb \<Rightarrow> bool) t s)"
-  (simp: crunch_simps wp: crunch_wps)
+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>"
 
-(* FIXME: Proved outside of `crunch` because without the `[where P=P]` constraint, the
-   postcondition unifies with the precondition in a wonderfully exponential way. VER-1337 *)
-lemma setThreadState_obj_at'_only_st_qd_ft:
-  "\<lbrace>\<lambda>s. P (obj_at' Q t' s) \<and>
-        (\<forall>upd tcb. Q (tcbState_update upd tcb) = Q tcb) \<and>
-        (\<forall>upd tcb. Q (tcbQueued_update upd tcb) = Q tcb) \<and>
-        (\<forall>upd tcb. Q (tcbFault_update upd tcb) = Q tcb)\<rbrace>
-   setThreadState st t
-   \<lbrace>\<lambda>_ s. P (obj_at' Q t' s)\<rbrace>"
-  unfolding setThreadState_def
-  apply (wpsimp wp: scheduleTCB_obj_at'_only_st_qd_ft threadSet_obj_at'_only_st_qd_ft[where P=P])
-  done
+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"
 
-crunch addToBitmap, setQueue
-  for ko_wp_at'[wp]: "\<lambda>s. P (ko_wp_at' Q p s)"
+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 tcbSchedEnqueue_tcb_obj_at'_no_change:
-  assumes [simp]: "\<And>tcb. Q (tcbQueued_update (\<lambda>_. True) tcb) = Q tcb"
-  shows "tcbSchedEnqueue t \<lbrace>\<lambda>s. P (obj_at' Q t' s)\<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply (wpsimp wp: threadSet_obj_at'_simple_strongest hoare_vcg_imp_lift threadGet_wp)
-  apply (clarsimp simp: obj_at'_def)
-  done
+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 setThreadState_tcb_obj_at'_no_change:
-  assumes [simp]: "\<And>tcb. Q (tcbState_update (\<lambda>_. st) tcb) = Q tcb"
-                  "\<And>tcb. Q (tcbQueued_update (\<lambda>_. True) tcb) = Q tcb"
-  shows "setThreadState st t \<lbrace>\<lambda>s. P (obj_at' Q t' s)\<rbrace>"
-  unfolding setThreadState_def scheduleTCB_def rescheduleRequired_def
-  apply (wpsimp wp: tcbSchedEnqueue_tcb_obj_at'_no_change hoare_vcg_if_lift2 isSchedulable_inv
-                    hoare_vcg_imp_lift threadSet_obj_at'_simple_strongest
-                    hoare_pre_cont[where f="isSchedulable x" and P="\<lambda>rv _. rv" for x]
-                    hoare_pre_cont[where f="isSchedulable x" and P="\<lambda>rv _. \<not>rv" for x])
-  done
-
-lemma setThreadState_oa:
-  "setThreadState st t
-   \<lbrace>\<lambda>s. P (obj_at' (\<lambda>tcb. Q (tcbCTable tcb) (tcbVTable tcb) (tcbIPCBufferFrame tcb)
-                            (tcbFaultHandler tcb) (tcbTimeoutHandler tcb) (tcbDomain tcb)
-                            (tcbMCP tcb) (tcbPriority tcb) (tcbQueued tcb) (tcbInReleaseQueue tcb)
-                            (tcbFault tcb))
-                   t' s) \<rbrace>"
-  unfolding setThreadState_def scheduleTCB_def rescheduleRequired_def tcbSchedEnqueue_def
-  apply (wpsimp wp: threadSet_obj_at'_simple_strongest hoare_vcg_imp_lift hoare_vcg_if_lift2
-                    threadGet_obj_at'_field isSchedulable_inv
-                    hoare_pre_cont[where f="isSchedulable x" and P="\<lambda>rv _. rv" for x]
-                    hoare_pre_cont[where f="isSchedulable x" and P="\<lambda>rv _. \<not>rv" for x])
-  done
-
-lemma getThreadState_only_rv_wp[wp]:
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> st_tcb_at' P t s\<rbrace>
-   getThreadState t
-   \<lbrace>\<lambda>rv _. P rv\<rbrace>"
-  apply (wpsimp wp: gts_wp')
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-  done
+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 getThreadState_only_state_wp[wp]:
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> P s\<rbrace>
-   getThreadState t
-   \<lbrace>\<lambda>_. P\<rbrace>"
-  apply (wpsimp wp: gts_wp')
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_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 projectKOs
+                        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 projectKOs
+                    split: if_split_asm)+
+   apply (clarsimp simp: aobj_relation_cuts_def split: ARM_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 pde_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 projectKOs 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 projectKOs non_exst_same_def split: option.splits)
+  apply (clarsimp simp: ready_queue_relation_def opt_map_def opt_pred_def obj_at'_def projectKOs
+                        inQ_def non_exst_same_def
+                 split: option.splits)
+  apply metis
   done
 
-(* FIXME: replace tcbSchedEnqueue_not_st. VER-1333 *)
-lemma tcbSchedEnqueue_obj_at':
-  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow>
-          (t = t' \<longrightarrow> P (obj_at' (\<lambda>tcb. Q (tcb\<lparr>tcbQueued := True\<rparr>)) t' s)) \<and>
-          (t \<noteq> t' \<longrightarrow> P (obj_at' Q t' s))\<rbrace>
-   tcbSchedEnqueue t
-   \<lbrace>\<lambda>_ s. P (obj_at' Q t' s)\<rbrace>"
-  unfolding tcbSchedEnqueue_def
-  apply (wpsimp wp: threadSet_obj_at'_simple_strongest hoare_vcg_imp_lift hoare_vcg_if_lift2
-                    threadGet_obj_at'_field)
-  apply (case_tac "t = t'"; clarsimp)
-  apply normalise_obj_at'
-  apply (case_tac "tcbQueued ko"; clarsimp)
-  apply (prop_tac "tcbQueued_update (\<lambda>_. True) ko = ko")
-   apply (case_tac ko; clarsimp)
+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: projectKOs 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: projectKOs 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 getCurSc_corres:
-  "corres (=) \<top> \<top> (gets cur_sc) (getCurSc)"
-  unfolding getCurSc_def
-  apply (rule corres_gets_trivial)
-  by (clarsimp simp: state_relation_def)
-
-crunch getScTime, scActive
-  for inv[wp]: P
-  (wp: crunch_wps)
-
-lemma threadSet_empty_tcbSchedContext_valid_tcbs'[wp]:
-  "threadSet (tcbSchedContext_update Map.empty) t \<lbrace>valid_tcbs'\<rbrace>"
-  by (wp threadSet_valid_tcbs') (simp add: valid_tcb'_def valid_tcbs'_def tcb_cte_cases_def)
-
-lemma threadSet_vrq_wp:
-  "\<lbrace>valid_release_queue and
-    (\<lambda>s. tptr \<in> set (ksReleaseQueue s) \<longrightarrow> obj_at' (\<lambda>obj. tcbInReleaseQueue (f obj)) tptr s)\<rbrace>
-   threadSet f tptr
-   \<lbrace>\<lambda>_. valid_release_queue\<rbrace>"
-  apply (clarsimp simp: valid_release_queue_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-  by (case_tac "x=tptr"; simp)
-
-lemma threadSet_vrq_inv:
-  "\<lbrace>valid_release_queue and
-    (\<lambda>s. (\<forall>obj. tcbInReleaseQueue (f obj) = tcbInReleaseQueue obj))\<rbrace>
-   threadSet f tptr
-   \<lbrace>\<lambda>_. valid_release_queue\<rbrace>"
-  apply (clarsimp simp: valid_release_queue_def)
-  by (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-
-lemma threadSet_vrq'_inv:
-  "\<lbrace>valid_release_queue' and
-    (\<lambda>s. (\<forall>obj. tcbInReleaseQueue (f obj) = tcbInReleaseQueue obj))\<rbrace>
-   threadSet f tptr
-   \<lbrace>\<lambda>_. valid_release_queue'\<rbrace>"
-  apply (clarsimp simp: valid_release_queue'_def)
-  by (wpsimp wp: threadSet_obj_at'_simple_strongest hoare_vcg_imp_lift' hoare_vcg_all_lift)
-
-lemma threadSet_enqueue_vrq:
-  "\<lbrace>(\<lambda>s. \<forall>a. a \<in> set (ksReleaseQueue s) \<longrightarrow> a\<noteq>t \<longrightarrow> obj_at' tcbInReleaseQueue a s)
-    and tcb_at' t\<rbrace>
-   threadSet (tcbInReleaseQueue_update (\<lambda>_. True)) t
-   \<lbrace>\<lambda>_. valid_release_queue\<rbrace>"
-  apply (clarsimp simp: valid_release_queue_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift)
-  by (case_tac "x=t"; simp)
-
-lemma threadSet_enqueue_vrq':
-  "\<lbrace>(\<lambda>s. \<forall>a. obj_at' tcbInReleaseQueue a s \<longrightarrow> a\<noteq>t \<longrightarrow> a \<in> set (ksReleaseQueue s))
-    and tcb_at' t
-    and (\<lambda>s. t \<in> set (ksReleaseQueue s))\<rbrace>
-   threadSet (tcbInReleaseQueue_update (\<lambda>_. True)) t
-   \<lbrace>\<lambda>_. valid_release_queue'\<rbrace>"
-  apply (clarsimp simp: valid_release_queue'_def)
-  apply (wpsimp wp: hoare_vcg_imp_lift hoare_vcg_all_lift threadSet_obj_at'_simple_strongest)
-  by (case_tac "x=t"; fastforce)
-
-lemma thread_set_empty_tcb_sched_context_weaker_valid_sched_action[wp]:
-  "thread_set (tcb_sched_context_update Map.empty) tcbPtr \<lbrace>weaker_valid_sched_action\<rbrace>"
-  apply (simp only: thread_set_def)
-  apply (wpsimp wp: set_object_wp)
-  apply (clarsimp simp: weaker_valid_sched_action_def pred_tcb_at_def)
-  apply (auto simp: is_tcb_def get_tcb_def obj_at_def  map_project_def tcbs_of_kh_def opt_map_def
-                    pred_map_def map_join_def tcb_scps_of_tcbs_def sc_refill_cfgs_of_scs_def
-             split: option.splits Structures_A.kernel_object.splits)
-  done
-
-end
-
-lemma setReleaseQueue_ksReleaseQueue[wp]:
-  "\<lbrace>\<lambda>_. P qs\<rbrace> setReleaseQueue qs \<lbrace>\<lambda>_ s. P (ksReleaseQueue s)\<rbrace>"
-  by (wpsimp simp: setReleaseQueue_def)
-
-lemma setReleaseQueue_pred_tcb_at'[wp]:
- "setReleaseQueue qs \<lbrace>\<lambda>s. P (pred_tcb_at' proj P' t' s)\<rbrace>"
-  by (wpsimp simp: setReleaseQueue_def)
-
-crunch tcbReleaseDequeue
-  for valid_pspace'[wp]: valid_pspace'
-  and state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
-  and list_refs_of_replies'[wp]: "\<lambda>s. P (list_refs_of_replies' s)"
-  and valid_global_refs'[wp]: valid_global_refs'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and irq_node'[wp]: "\<lambda>s. P (irq_node' s)"
-  and typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and valid_irq_states'[wp]: valid_irq_states'
-  and ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  and valid_machine_state'[wp]: valid_machine_state'
-  (simp: crunch_simps wp: crunch_wps)
-
-crunch tcbReleaseDequeue
-  for cur_tcb'[wp]: cur_tcb'
-  (simp: crunch_simps cur_tcb'_def wp: crunch_wps threadSet_cur ignore: threadSet)
-
-crunch tcbReleaseRemove
-  for pspace_aligned'[wp]: pspace_aligned'
-  and pspace_distinct'[wp]: pspace_distinct'
-  and pspace_bounded'[wp]: pspace_bounded'
-  and no_0_obj'[wp]: no_0_obj'
-  and ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  and list_refs_of_replies[wp]: "\<lambda>s. sym_refs (list_refs_of_replies' s)"
-  and state_refs_of'[wp]: "\<lambda>s. sym_refs (state_refs_of' s)"
-  and valid_global_refs'[wp]: valid_global_refs'
-  and valid_arch_state'[wp]: valid_arch_state'
-  and irq_node[wp]: "\<lambda>s. P (irq_node' s)"
-  and typ_at[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  and interrupt_state[wp]: "\<lambda>s. P (ksInterruptState s)"
-  and valid_irq_state'[wp]: valid_irq_states'
-  and pspace_domain_valid[wp]: pspace_domain_valid
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
-  and ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
-  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
-  and ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  and ksMachineState[wp]: "\<lambda>s. P (ksMachineState s)"
-  and valid_pde_mappings'[wp]: valid_pde_mappings'
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  (wp: crunch_wps simp: crunch_simps tcb_cte_cases_def)
-
-global_interpretation tcbReleaseRemove: typ_at_all_props' "tcbReleaseRemove tptr"
-  by typ_at_props'
-
-lemma tcbInReleaseQueue_update_tcb_cte_cases:
-  "(a, b) \<in> ran tcb_cte_cases \<Longrightarrow> a (tcbInReleaseQueue_update f tcb) = a tcb"
-  unfolding tcb_cte_cases_def
-  by (case_tac tcb; fastforce simp: tcbInReleaseQueue_update_def)
-
-lemma tcbInReleaseQueue_update_ctes_of[wp]:
-  "threadSet (tcbInReleaseQueue_update f) x \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace>"
-  by (wpsimp wp: threadSet_ctes_ofT simp: tcbInReleaseQueue_update_tcb_cte_cases)
-
-crunch tcbReleaseDequeue
-  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
-  and valid_idle'[wp]: valid_idle'
-  and valid_irq_handlers'[wp]: valid_irq_handlers'
-  and valid_pde_mappings'[wp]: valid_pde_mappings'
-  and ct_idle_or_in_cur_domain'[wp]: ct_idle_or_in_cur_domain'
-  and if_unsafe_then_cap'[wp]: if_unsafe_then_cap'
-  (ignore: threadSet
-     simp: crunch_simps tcbInReleaseQueue_update_tcb_cte_cases
-       wp: crunch_wps threadSet_idle' threadSet_irq_handlers' threadSet_ct_idle_or_in_cur_domain'
-           threadSet_ifunsafe'T)
-
-lemma tcbReleaseDequeue_valid_objs'[wp]:
-  "tcbReleaseDequeue \<lbrace>valid_objs'\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  by (wpsimp simp: setReprogramTimer_def setReleaseQueue_def wp: threadSet_valid_objs')
-
-lemma tcbReleaseDequeue_sch_act_wf[wp]:
-  "tcbReleaseDequeue \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  by (wpsimp simp: setReprogramTimer_def setReleaseQueue_def wp: threadSet_sch_act)
-
-lemma tcbReleaseDequeue_if_live_then_nonz_cap'[wp]:
-  "tcbReleaseDequeue \<lbrace>if_live_then_nonz_cap'\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  apply (wpsimp simp: setReprogramTimer_def setReleaseQueue_def tcbInReleaseQueue_update_tcb_cte_cases
-                  wp: threadSet_iflive'T)
-  by auto
-
-lemma tcbReleaseDequeue_ct_not_inQ[wp]:
-  "tcbReleaseDequeue \<lbrace>ct_not_inQ\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  by (wpsimp simp: setReprogramTimer_def setReleaseQueue_def wp: threadSet_not_inQ)
-
-lemma tcbReleaseDequeue_valid_queues[wp]:
-  "tcbReleaseDequeue \<lbrace>valid_queues\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  apply (wpsimp simp: setReprogramTimer_def setReleaseQueue_def wp: threadSet_valid_queues)
-  by (auto simp: valid_queues_def valid_queues_no_bitmap_def valid_bitmapQ_def bitmapQ_def
-                 bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def inQ_def)
-
-lemma tcbReleaseDequeue_valid_queues'[wp]:
-  "tcbReleaseDequeue \<lbrace>valid_queues'\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  apply (wpsimp simp: setReprogramTimer_def setReleaseQueue_def wp: threadSet_valid_queues')
-  by (auto simp: valid_queues'_def valid_queues_no_bitmap_def valid_bitmapQ_def bitmapQ_def
-                 bitmapQ_no_L2_orphans_def bitmapQ_no_L1_orphans_def inQ_def)
-
-lemma tcbReleaseDequeue_valid_release_queue[wp]:
-  "\<lbrace>valid_release_queue and (\<lambda>s. distinct (ksReleaseQueue s))\<rbrace>
-   tcbReleaseDequeue
-   \<lbrace>\<lambda>_. valid_release_queue\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  apply (wpsimp simp: setReprogramTimer_def setReleaseQueue_def wp: threadSet_valid_release_queue)
-  apply (clarsimp simp: valid_release_queue_def)
-  by (case_tac "ksReleaseQueue s"; simp)
-
-lemma tcbReleaseDequeue_valid_release_queue'[wp]:
-  "\<lbrace>valid_release_queue' and (\<lambda>s. ksReleaseQueue s \<noteq> [])\<rbrace>
-   tcbReleaseDequeue
-   \<lbrace>\<lambda>_. valid_release_queue'\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  apply (wpsimp simp: setReprogramTimer_def setReleaseQueue_def wp: threadSet_valid_release_queue')
-  apply (clarsimp simp: valid_release_queue'_def split: list.splits)
-  by (metis list.exhaust_sel set_ConsD)
-
-lemma tcbReleaseDequeue_invs'[wp]:
-  "\<lbrace>invs'
-    and (\<lambda>s. ksReleaseQueue s \<noteq> [])
-    and distinct_release_queue\<rbrace>
-   tcbReleaseDequeue
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  by (wpsimp simp: invs'_def valid_dom_schedule'_def
-               wp: valid_irq_node_lift irqs_masked_lift untyped_ranges_zero_lift
-                   cteCaps_of_ctes_of_lift)
-
-lemma tcbReleaseDequeue_ksCurThread[wp]:
-  "\<lbrace>\<lambda>s. P (hd (ksReleaseQueue s)) (ksCurThread s)\<rbrace>
-   tcbReleaseDequeue
-   \<lbrace>\<lambda>r s. P r (ksCurThread s)\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  by (wpsimp simp: setReprogramTimer_def setReleaseQueue_def)
-
-lemma tcbReleaseDequeue_runnable'[wp]:
-  "\<lbrace>\<lambda>s. st_tcb_at' runnable' (hd (ksReleaseQueue s)) s\<rbrace>
-   tcbReleaseDequeue
-   \<lbrace>\<lambda>r s. st_tcb_at' runnable' r s\<rbrace>"
-  unfolding tcbReleaseDequeue_def
-  by (wpsimp simp: setReprogramTimer_def wp: threadSet_pred_tcb_no_state)
-
-lemma tcbReleaseRemove_if_unsafe_then_cap'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>if_unsafe_then_cap'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def)
-  apply (wpsimp wp: threadSet_ifunsafe')
-  done
-
-lemma tcbReleaseRemove_valid_machine_state'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_machine_state'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def)
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift)
-  done
-
-lemma tcbReleaseRemove_ct_idle_or_in_cur_domain'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>ct_idle_or_in_cur_domain'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def)
-  apply (wpsimp wp: threadSet_ct_idle_or_in_cur_domain' hoare_vcg_imp_lift' hoare_vcg_disj_lift)
-  done
-
-crunch setReprogramTimer
-  for valid_queues[wp]: valid_queues
-  and ksReleaseQueue[wp]: "\<lambda>s. P (ksReleaseQueue s)"
-
-lemma tcbReleaseRemove_valid_queues_no_bitmap:
-  "\<lbrace>valid_queues\<rbrace>
-   tcbReleaseRemove tcbPtr
-   \<lbrace>\<lambda>_. valid_queues_no_bitmap\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: threadSet_valid_queues_no_bitmap_new)
-  apply (clarsimp simp: valid_queues_no_bitmap_def valid_queues_def)
-  apply (fastforce simp: obj_at'_def inQ_def)
-  done
-
-crunch setReleaseQueue, setReprogramTimer
-  for valid_bitmapQ[wp]: valid_bitmapQ
-  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
-  and bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
-  (simp: crunch_simps valid_bitmapQ_def bitmapQ_def bitmapQ_no_L2_orphans_def
-         bitmapQ_no_L1_orphans_def)
-
-crunch tcbReleaseRemove
-  for valid_bitmapQ[wp]: valid_bitmapQ
-  and bitmapQ_no_L2_orphans[wp]: bitmapQ_no_L2_orphans
-  and bitmapQ_no_L1_orphans[wp]: bitmapQ_no_L1_orphans
-
-lemma setReleaseQueue_obj_at'[wp]:
-  "setReleaseQueue Q \<lbrace>\<lambda>s. R (obj_at' P t s)\<rbrace>"
-  unfolding setReleaseQueue_def by wpsimp
-
-crunch setReleaseQueue
-  for ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
-
-lemma setReleaseQueue_valid_queues_no_bitmap[wp]:
-  "setReleaseQueue Q \<lbrace>valid_queues_no_bitmap\<rbrace>"
-  unfolding valid_queues_no_bitmap_def
-  by (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_all_lift hoare_vcg_ball_lift2)
-
-crunch tcbReleaseRemove
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' p"
-  (wp: threadSet_cap_to simp: tcb_cte_cases_def)
-
-lemma tcbReleaseRemove_valid_queues:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_queues\<rbrace>"
-  apply (wpsimp wp: tcbReleaseRemove_valid_queues_no_bitmap tcbReleaseRemove_valid_bitmapQ
-              simp: valid_queues_def)
-  done
-
-crunch setReleaseQueue, setReprogramTimer
-  for valid_queues'[wp]: valid_queues'
-  (simp: valid_queues'_def)
-
-lemma tcbReleaseRemove_valid_queues'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_queues'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: threadSet_valid_queues')
-  apply (clarsimp simp: valid_queues'_def inQ_def)
-  done
-
-crunch setReprogramTimer
-  for valid_release_queue[wp]: valid_release_queue
-  and valid_release_queue'[wp]: valid_release_queue'
-
-lemma tcbReleaseRemove_valid_release_queue[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_release_queue\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: threadSet_valid_release_queue)
-  apply (clarsimp simp: valid_release_queue_def)
-  done
-
-lemma tcbReleaseRemove_valid_release_queue'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_release_queue'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: threadSet_valid_release_queue')
-  apply (clarsimp simp: valid_release_queue'_def obj_at'_def)
-  done
-
-crunch setReprogramTimer
-  for valid_objs'[wp]: valid_objs'
-  and sch_act_wf[wp]: "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
-  and if_live_then_nonz_cap'[wp]: if_live_then_nonz_cap'
-  and valid_mdb'[wp]: valid_mdb'
-  and ct_not_inQ[wp]: ct_not_inQ
-  (simp: valid_mdb'_def)
-
-lemma tcbReleaseRemove_valid_objs'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_objs'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: threadSet_valid_objs')
-  done
-
-lemma tcbReleaseRemove_valid_mdb'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_mdb'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule_tac Q'="\<lambda>_. valid_mdb'" in bind_wp_fwd)
-   apply wpsimp
-   apply (clarsimp simp: valid_mdb'_def)
-  apply (wpsimp wp: setObject_tcb_mdb' getObject_tcb_wp simp: threadSet_def)
-  apply (fastforce simp: obj_at'_def projectKOs tcb_cte_cases_def)
-  done
-
-lemma tcbReleaseRemove_sch_act_wf[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>\<lambda>s. sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (wpsimp wp: threadSet_sch_act)
-  done
-
-lemma tcbReleaseRemove_if_live_then_nonz_cap'[wp]:
-  "\<lbrace>\<lambda>s. if_live_then_nonz_cap' s\<rbrace>
-   tcbReleaseRemove tptr
-   \<lbrace>\<lambda>_. if_live_then_nonz_cap'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: threadSet_iflive' setSchedContext_iflive' threadGet_wp)
-  apply (fastforce simp: obj_at'_def projectKOs)
-  done
-
-lemma tcbReleaseRemove_valid_idle'[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>valid_idle'\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (wpsimp wp: threadSet_idle')
-  done
-
-lemma tcbReleaseRemove_ct_not_inQ[wp]:
-  "tcbReleaseRemove tcbPtr \<lbrace>ct_not_inQ\<rbrace>"
-  apply (clarsimp simp: tcbReleaseRemove_def getReleaseQueue_def setReleaseQueue_def)
-  apply (rule bind_wp[OF _ gets_sp])
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: threadSet_not_inQ)
-  done
-
-lemma tcbReleaseRemove_invs':
-  "tcbReleaseRemove tcbPtr \<lbrace>invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift cur_tcb_lift
-                    untyped_ranges_zero_lift tcbReleaseRemove_valid_queues valid_replies'_lift
-              simp: cteCaps_of_def o_def)
+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
 
-crunch tcbReleaseRemove, tcbSchedDequeue
-  for sch_act_simple[wp]: sch_act_simple
-  and ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
-  (wp: crunch_wps simp: crunch_simps sch_act_simple_def)
-
-lemma tcbInReleaseQueue_update_st_tcb_at'[wp]:
-  "threadSet (tcbInReleaseQueue_update b) t \<lbrace>\<lambda>s. Q (st_tcb_at' P t' s)\<rbrace>"
-  apply (wpsimp wp: threadSet_wp)
-  apply (cases "t=t'")
-   apply (fastforce simp: obj_at_simps st_tcb_at'_def ps_clear_def)
-  apply (erule back_subst[where P=Q])
-  apply (fastforce simp: obj_at_simps st_tcb_at'_def ps_clear_def)
-  done
+lemmas ethread_set_corres =
+    ethread_set_corresT [OF _ all_tcbI, OF _ ball_tcb_cte_casesI]
 
-crunch tcbReleaseEnqueue
-  for st_tcb_at'[wp]: "\<lambda>s. Q (st_tcb_at' P tptr s)"
-  (wp: mapM_wp_inv ignore: threadSet)
+lemma archTcbUpdate_aux2: "(\<lambda>tcb. tcb\<lparr> tcbArch := f (tcbArch tcb)\<rparr>) = tcbArch_update f"
+  by (rule ext, case_tac tcb, simp)
 
 end
+end
diff --git a/proof/refine/ARM/Tcb_R.thy b/proof/refine/ARM/Tcb_R.thy
index 8ff36f6915..5a2291d9ac 100644
--- a/proof/refine/ARM/Tcb_R.thy
+++ b/proof/refine/ARM/Tcb_R.thy
@@ -8,7 +8,7 @@ theory Tcb_R
 imports CNodeInv_R
 begin
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma asUser_setNextPC_corres:
   "corres dc (tcb_at t and invs) (tcb_at' t and invs')
@@ -24,255 +24,243 @@ lemma activateIdleThread_corres:
     (arch_activate_idle_thread t) (activateIdleThread t)"
   by (simp add: arch_activate_idle_thread_def activateIdleThread_def)
 
-lemma gts_st_tcb':
-  "\<lbrace>tcb_at' t\<rbrace> getThreadState t \<lbrace>\<lambda>rv. st_tcb_at' (\<lambda>st. st = rv) t\<rbrace>"
-  apply (rule hoare_weaken_pre)
-   apply (rule hoare_post_imp[where Q'="\<lambda>rv s. \<exists>rv'. rv = rv' \<and> st_tcb_at' (\<lambda>st. st = rv') t s"])
-    apply simp
-   apply (wp hoare_vcg_ex_lift)
-  apply (clarsimp simp add: pred_tcb_at'_def obj_at'_def)
-  done
-
-lemma activateIdle_invs':
-  "activateIdleThread thread \<lbrace>invs'\<rbrace>"
-  by (simp add: activateIdleThread_def)
-
-lemma invs'_live_sc'_ex_nonz_cap_to':
-  "ko_at' ko scp s \<Longrightarrow> invs' s \<Longrightarrow> live_sc' ko \<longrightarrow> ex_nonz_cap_to' scp s"
-  apply (clarsimp simp: invs'_def if_live_then_nonz_cap'_def)
-  by (fastforce simp: obj_at'_real_def ko_wp_at'_def projectKO_sc)
-
 lemma activateThread_corres:
- "corres dc (invs and ct_in_state activatable) (invs' and ct_in_state' activatable' and sch_act_simple)
+ "corres dc (invs and ct_in_state activatable) (invs' and ct_in_state' activatable')
             activate_thread activateThread"
   supply subst_all [simp del]
-  apply add_cur_tcb'
   apply (simp add: activate_thread_def activateThread_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split_eqr[OF getCurThread_corres])
-      apply (rule corres_split[OF get_tcb_yield_to_corres])
-        apply (rule corres_split[OF corres_when])
-            apply clarsimp
-           apply (rule schedContextCompleteYieldTo_corres)
-          apply (rule_tac R="\<lambda>ts s. (activatable ts) \<and> invs s \<and> st_tcb_at ((=) ts) thread s"
-                      and R'="\<lambda>ts s. (activatable' ts) \<and> invs' s \<and> st_tcb_at' (\<lambda>ts'. ts' = ts) thread s"
-                      in  corres_split[OF getThreadState_corres])
-            apply (rule_tac F="idle rv \<or> runnable rv" in corres_req, clarsimp)
-            apply (rule_tac F="idle' rv' \<or> runnable' rv'" in corres_req, clarsimp)
-            apply (case_tac rv, simp_all add: isRunning_def isRestart_def, safe, simp_all)[1]
-             apply (rule corres_guard_imp)
-               apply (rule corres_split_eqr[OF asUser_getRestartPC_corres])
-                 apply (rule corres_split_nor[OF asUser_setNextPC_corres])
-                   apply (rule setThreadState_corres, simp)
-                  apply (rule_tac Q'="\<lambda>_. invs and tcb_at thread" in hoare_strengthen_post[rotated])
-                   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-                  apply wpsimp
-                 apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post[rotated])
-                  apply (fastforce simp: invs'_def dest: invs'_valid_tcbs')
-                 apply wp+
-              apply (clarsimp simp: st_tcb_at_tcb_at)
-             apply fastforce
-            apply (rule corres_guard_imp)
-              apply (rule activateIdleThread_corres)
-             apply (clarsimp elim!: st_tcb_weakenE)
-            apply (clarsimp elim!: pred_tcb'_weakenE)
-           apply (wp gts_st_tcb gts_st_tcb' gts_st_tcb_at complete_yield_to_invs)+
-        apply (wpsimp wp: schedContextCompleteYieldTo_invs' hoare_drop_imp)
-       apply (wp gts_st_tcb gts_st_tcb' gts_st_tcb_at complete_yield_to_invs
-                 get_tcb_obj_ref_wp threadGet_wp)+
-   apply (clarsimp simp: ct_in_state_def tcb_at_invs invs_def valid_state_def valid_pspace_def
+      apply (rule_tac R="\<lambda>ts s. valid_tcb_state ts s \<and> (idle ts \<or> runnable ts)
+                                \<and> invs s \<and> st_tcb_at ((=) ts) thread s"
+                  and R'="\<lambda>ts s. valid_tcb_state' ts s \<and> (idle' ts \<or> runnable' ts)
+                                \<and> invs' s \<and> st_tcb_at' (\<lambda>ts'. ts' = ts) thread s"
+                  in  corres_split[OF getThreadState_corres])
+        apply (rule_tac F="idle rv \<or> runnable rv" in corres_req, simp)
+        apply (rule_tac F="idle' rv' \<or> runnable' rv'" in corres_req, simp)
+        apply (case_tac rv, simp_all add:
+                  isRunning_def isRestart_def,
+                  safe, simp_all)[1]
+         apply (rule corres_guard_imp)
+           apply (rule corres_split_eqr[OF asUser_getRestartPC_corres])
+             apply (rule corres_split_nor[OF asUser_setNextPC_corres])
+               apply (rule setThreadState_corres)
+               apply (simp | wp weak_sch_act_wf_lift_linear)+
+          apply (clarsimp simp: st_tcb_at_tcb_at invs_distinct)
+         apply fastforce
+        apply (rule corres_guard_imp)
+          apply (rule activateIdleThread_corres)
+         apply (clarsimp elim!: st_tcb_weakenE)
+        apply (clarsimp elim!: pred_tcb'_weakenE)
+       apply (wp gts_st_tcb gts_st_tcb' gts_st_tcb_at)+
+   apply (clarsimp simp: ct_in_state_def tcb_at_invs invs_distinct invs_psp_aligned
                   elim!: st_tcb_weakenE)
-  apply (fastforce simp: ct_in_state'_def pred_tcb_at'_def obj_at'_def
-                  elim!: pred_tcb'_weakenE)
+  apply (clarsimp simp: tcb_at_invs' ct_in_state'_def
+                 elim!: pred_tcb'_weakenE)
   done
 
+
 lemma bindNotification_corres:
   "corres dc
          (invs and tcb_at t and ntfn_at a) (invs' and tcb_at' t and ntfn_at' a)
          (bind_notification t a) (bindNotification t a)"
-  unfolding bind_notification_def bindNotification_def
-  apply (simp add: bind_assoc update_sk_obj_ref_def)
+  apply (simp add: bind_notification_def bindNotification_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getNotification_corres])
       apply (rule corres_split[OF setNotification_corres])
          apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
         apply (rule setBoundNotification_corres)
-       apply wp+
-  by auto
+       apply (wp)+
+   apply auto
+  done
+
 
 abbreviation
   "ct_idle' \<equiv> ct_in_state' idle'"
 
-lemma activate_invs':
-  "activateThread \<lbrace>invs'\<rbrace>"
-  apply (simp add: activateThread_def)
-  apply (wpsimp wp: activateIdle_invs' sts_invs_minor' schedContextCompleteYieldTo_invs'
-                    hoare_vcg_imp_lift')
-  by (fastforce simp: pred_tcb_at'_def obj_at'_real_def ko_wp_at'_def sch_act_simple_def)
-
-declare not_psubset_eq[dest!] (* FIXME: remove, not a good dest rule *)
-
-crunch schedContextResume
-  for tcb_at'[wp]: "\<lambda>s. P (tcb_at' t s)"
-  (wp: crunch_wps)
-
-lemma setThreadState_Restart_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> tcb_at' t s \<and> ex_nonz_cap_to' t s
-        \<and> st_tcb_at' (Not \<circ> is_BlockedOnReply) t s\<rbrace>
-   setThreadState Restart t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_dom_schedule'_def)
-  apply (wpsimp wp: setThreadState_ct_not_inQ simp: pred_tcb_at'_eq_commute)
-  apply (auto dest: global'_no_ex_cap
-              simp: o_def pred_tcb_at'_def obj_at'_def)
+lemma gts_st_tcb':
+  "\<lbrace>tcb_at' t\<rbrace> getThreadState t \<lbrace>\<lambda>rv. st_tcb_at' (\<lambda>st. st = rv) t\<rbrace>"
+  apply (rule hoare_weaken_pre)
+   apply (rule hoare_post_imp[where Q'="\<lambda>rv s. \<exists>rv'. rv = rv' \<and> st_tcb_at' (\<lambda>st. st = rv') t s"])
+    apply simp
+   apply (wp hoare_vcg_ex_lift)
+  apply (clarsimp simp add: pred_tcb_at'_def obj_at'_def)
   done
 
-crunch cancel_ipc
-  for valid_sched_action[wp]: valid_sched_action
-  (wp: crunch_wps ignore: set_object thread_set update_sched_context)
+lemma activateIdle_invs:
+  "\<lbrace>invs' and ct_idle'\<rbrace>
+     activateIdleThread thread
+   \<lbrace>\<lambda>rv. invs' and ct_idle'\<rbrace>"
+  by (simp add: activateIdleThread_def)
 
-crunch cancel_ipc
-  for sc_tcb_sc_at[wp]: "sc_tcb_sc_at P t"
-  (wp: crunch_wps)
+lemma activate_invs':
+  "\<lbrace>invs' and sch_act_simple and ct_in_state' activatable'\<rbrace>
+     activateThread
+   \<lbrace>\<lambda>rv. invs' and (ct_running' or ct_idle')\<rbrace>"
+  apply (simp add: activateThread_def)
+  apply (rule bind_wp)
+   apply (rule_tac Q'="\<lambda>state s. invs' s \<and> sch_act_simple s
+                              \<and> st_tcb_at' (\<lambda>st. st = state) thread s
+                              \<and> thread = ksCurThread s
+                              \<and> (runnable' state \<or> idle' state)" in bind_wp)
+    apply (case_tac rv, simp_all add: isTS_defs hoare_pre_cont
+                       split del: if_splits cong: if_cong)
+      apply (wp)
+      apply (clarsimp simp: ct_in_state'_def)
+     apply (rule_tac Q'="\<lambda>rv. invs' and ct_idle'" in hoare_post_imp, simp)
+     apply (wp activateIdle_invs)
+     apply (clarsimp simp: ct_in_state'_def)
+    apply (rule_tac Q'="\<lambda>rv. invs' and ct_running' and sch_act_simple"
+                 in hoare_post_imp, simp)
+    apply (rule hoare_weaken_pre)
+     apply (wp ct_in_state'_set asUser_ct sts_invs_minor'
+          | wp (once) sch_act_simple_lift)+
+      apply (rule_tac Q'="\<lambda>_. st_tcb_at' runnable' thread
+                             and sch_act_simple and invs'
+                             and (\<lambda>s. thread = ksCurThread s)"
+               in hoare_post_imp, clarsimp)
+      apply (wp sch_act_simple_lift)+
+    apply (clarsimp simp: valid_idle'_def invs'_def valid_state'_def
+                          pred_tcb_at'_def obj_at'_def idle_tcb'_def
+                   elim!: pred_tcb'_weakenE)
+   apply (wp gts_st_tcb')+
+  apply (clarsimp simp: tcb_at_invs' ct_in_state'_def
+                         pred_disj_def)
+  done
+
+crunch activateIdleThread
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  (ignore: setNextPC)
+
+declare not_psubset_eq[dest!]
+
+lemma setThreadState_runnable_simp:
+  "runnable' ts \<Longrightarrow> setThreadState ts t =
+   threadSet (tcbState_update (\<lambda>x. ts)) t"
+  apply (simp add: setThreadState_def isRunnable_def isStopped_def liftM_def)
+  apply (subst bind_return[symmetric], rule bind_cong[OF refl])
+  apply (drule use_valid[OF _ threadSet_pred_tcb_at_state[where proj="itcbState" and p=t and P="(=) ts"]])
+   apply simp
+  apply (subst bind_known_operation_eq)
+       apply wp+
+     apply clarsimp
+    apply (subst eq_commute, erule conjI[OF _ refl])
+   apply (rule empty_fail_getThreadState)
+  apply (simp add: getCurThread_def getSchedulerAction_def exec_gets)
+  apply (auto simp: when_def split: Structures_H.thread_state.split)
+  done
+
+lemma activate_sch_act:
+  "\<lbrace>ct_in_state' activatable' and (\<lambda>s. P (ksSchedulerAction s))\<rbrace>
+     activateThread \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
+  apply (simp add: activateThread_def getCurThread_def
+             cong: if_cong Structures_H.thread_state.case_cong)
+  apply (rule bind_wp [OF _ gets_sp])
+  apply (rule bind_wp[where Q'="\<lambda>st s. (runnable' or idle') st
+                                          \<and> P (ksSchedulerAction s)"])
+   apply (rule hoare_pre)
+    apply (wp | wpc | simp add: setThreadState_runnable_simp)+
+  apply (clarsimp simp: ct_in_state'_def cur_tcb'_def pred_tcb_at'
+                 elim!: pred_tcb'_weakenE)
+  done
+
+lemma runnable_tsr:
+  "thread_state_relation ts ts' \<Longrightarrow> runnable' ts' = runnable ts"
+  by (case_tac ts, auto)
+
+lemma idle_tsr:
+  "thread_state_relation ts ts' \<Longrightarrow> idle' ts' = idle ts"
+  by (case_tac ts, auto)
+
+crunch cancelIPC
+  for cur[wp]: cur_tcb'
+  (wp: crunch_wps simp: crunch_simps o_def)
+
+crunch setupReplyMaster
+  for cur[wp]: cur_tcb'
+  (wp: crunch_wps simp: crunch_simps)
+
+lemma setCTE_weak_sch_act_wf[wp]:
+  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
+   setCTE c cte
+   \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: weak_sch_act_wf_def)
+  apply (wp hoare_vcg_all_lift hoare_convert_imp setCTE_pred_tcb_at' setCTE_tcb_in_cur_domain')
+  done
+
+lemma setupReplyMaster_weak_sch_act_wf[wp]:
+  "\<lbrace>\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>
+   setupReplyMaster thread
+   \<lbrace>\<lambda>rv s. weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
+  apply (simp add: setupReplyMaster_def)
+  apply (wp)
+    apply (rule_tac Q'="\<lambda>_ s. weak_sch_act_wf (ksSchedulerAction s) s"
+               in hoare_post_imp, clarsimp)
+    apply (wp)+
+  apply assumption
+  done
+
+crunch setup_reply_master, Tcb_A.restart, arch_post_modify_registers
+  for pspace_aligned[wp]: "pspace_aligned :: det_ext state \<Rightarrow> _"
+  and pspace_distinct[wp]: "pspace_distinct :: det_ext state \<Rightarrow> _"
+  (wp: crunch_wps simp: crunch_simps)
 
 lemma restart_corres:
-  "corres dc
-          (einvs and tcb_at t and ex_nonz_cap_to t and current_time_bounded)
-          (invs' and tcb_at' t and ex_nonz_cap_to' t)
-          (Tcb_A.restart t) (ThreadDecls_H.restart t)"
-  apply (simp add: Tcb_A.restart_def Thread_H.restart_def test_possible_switch_to_def
-                   get_tcb_obj_ref_def)
+  "corres dc (einvs  and tcb_at t) (invs' and tcb_at' t and ex_nonz_cap_to' t)
+      (Tcb_A.restart t) (ThreadDecls_H.restart t)"
+  apply (simp add: Tcb_A.restart_def Thread_H.restart_def)
   apply (simp add: isStopped_def2 liftM_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getThreadState_corres])
-      apply (rule corres_split[OF threadGet_corres[where r="(=)"]])
-         apply (clarsimp simp: tcb_relation_def)
-        apply (rename_tac scOpt)
-        apply (rule corres_when2)
-         apply (simp add: idle_tsr runnable_tsr)
-        apply (rule corres_split_nor[OF cancel_ipc_corres])
-          apply (rule corres_split_nor[OF setThreadState_corres])
-             apply (clarsimp simp: thread_state_relation_def)
-            apply (simp only:)
-            apply (rule corres_split [OF ifCondRefillUnblockCheck_corres])
-              apply (simp add: maybeM_when, fold dc_def)
-              apply (rule corres_split[OF corres_when2])
-                  apply clarsimp
-                 apply (rule schedContextResume_corres)
-                apply (rule corres_split[OF isSchedulable_corres])
-                  apply (rule corres_when2 [OF _ possibleSwitchTo_corres]; (solves simp)?)
-                 apply (wpsimp wp: is_schedulable_wp isSchedulable_wp)+
-               apply (rule_tac Q'="\<lambda>rv. invs and valid_sched_action and active_scs_valid and tcb_at t"
-                      in hoare_strengthen_post)
-                apply (wpsimp wp: sched_context_resume_valid_sched_action)
-               apply fastforce
-              apply (rule_tac Q'="\<lambda>rv. invs' and tcb_at' t" in hoare_strengthen_post)
-               apply wpsimp
-              apply (fastforce simp: invs'_def sch_act_wf_weak valid_pspace'_def)
-             apply (rule_tac Q'="\<lambda>rv. invs and valid_ready_qs and valid_release_q
-                                          and current_time_bounded
-                                          and (\<lambda>s. \<exists>scp. scOpt = Some scp \<longrightarrow> sc_not_in_release_q scp s)
-                                          and active_scs_valid and valid_sched_action
-                                          and scheduler_act_not t and bound_sc_tcb_at ((=) scOpt) t"
-                    in hoare_strengthen_post)
-              apply (wpsimp simp: if_cond_refill_unblock_check_def
-                              wp: refill_unblock_check_valid_release_q
-                                  refill_unblock_check_active_scs_valid)
-             apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-             apply (intro conjI; clarsimp)
-              apply (clarsimp simp: pred_tcb_at_tcb_at)
-              apply (subst (asm) sym_refs_bound_sc_tcb_iff_sc_tcb_sc_at[OF eq_commute refl])
-               apply fastforce
-              apply (fastforce simp: sc_at_pred_n_def obj_at_def
-                                     sym_refs_bound_sc_tcb_iff_sc_tcb_sc_at[OF eq_commute refl])
-             apply fastforce
-            apply (wpsimp simp: ifCondRefillUnblockCheck_def
-                            wp: refillUnblockCheck_invs')
-           apply (rule_tac Q'="\<lambda>rv. invs and valid_ready_qs and valid_release_q
-                                        and current_time_bounded
-                                        and (\<lambda>s. \<forall>scp. scOpt = Some scp \<longrightarrow> sc_not_in_release_q scp s)
-                                        and active_scs_valid and valid_sched_action
-                                        and scheduler_act_not t and bound_sc_tcb_at ((=) scOpt) t"
-                  in hoare_strengthen_post)
-            apply (wpsimp wp: sts_invs_minor set_thread_state_valid_sched_action
-                              set_thread_state_valid_ready_qs set_thread_state_valid_release_q)
-           apply (case_tac scOpt; clarsimp)
-           apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
-           apply (rule context_conjI)
-            apply (clarsimp simp: valid_objs_def)
-            apply (drule_tac x=t in bspec, clarsimp simp: pred_tcb_at_def obj_at_def)
-            apply (clarsimp simp: valid_obj_def valid_tcb_def pred_tcb_at_def obj_at_def valid_bound_obj_def
-                           dest!: sym[of "Some _"])
-           apply (clarsimp simp: obj_at_def opt_map_red opt_pred_def is_sc_obj)
-          apply (rule_tac Q'="\<lambda>rv. invs' and tcb_at' t" in hoare_strengthen_post[rotated])
-           apply (clarsimp simp: invs'_def valid_pspace'_def o_def)
-          apply (wpsimp wp: setThreadState_Restart_invs' hoare_drop_imps)
-         apply (rule_tac Q'="\<lambda>rv. invs and valid_sched and valid_sched_action and tcb_at t
-                                      and current_time_bounded
-                                      and (\<lambda>s. \<forall>scp. scOpt = Some scp \<longrightarrow> sc_not_in_release_q scp s)
-                                      and fault_tcb_at ((=) None) t and bound_sc_tcb_at ((=) scOpt) t
-                                      and st_tcb_at (\<lambda>st'. tcb_st_refs_of st' = {}) t
-                                      and scheduler_act_not t and ex_nonz_cap_to t"
-                in hoare_strengthen_post)
-          apply (wpsimp wp: cancel_ipc_no_refs cancel_ipc_ex_nonz_cap_to_tcb)
-         apply (fastforce simp: invs_def valid_state_def idle_no_ex_cap valid_pspace_def)
-        apply (rule_tac Q'="\<lambda>rv. invs' and tcb_at' t and ex_nonz_cap_to' t and st_tcb_at' simple' t"
-               in hoare_strengthen_post)
-         apply wpsimp
-        apply (fastforce simp: invs'_def sch_act_wf_weak valid_pspace'_def
-                         elim: pred_tcb'_weakenE)[1]
-       apply (wpsimp wp: gts_wp gts_wp' thread_get_wp')+
-   apply (prop_tac "scheduler_act_not t s")
-    apply (fastforce elim: valid_sched_scheduler_act_not simp: pred_tcb_at_def obj_at_def)
-   apply (clarsimp simp: pred_tcb_at_def obj_at_def is_tcb
-                         valid_sched_def invs_def valid_state_def valid_pspace_def)
-   apply (drule sym_refs_inv_tcb_scps)
-   apply (prop_tac "heap_ref_eq scp t (tcb_scps_of s)")
-    apply (clarsimp simp: vs_all_heap_simps)
-   apply (clarsimp simp: heap_refs_inv_def2)
-   apply (clarsimp simp: vs_all_heap_simps)
-   apply (drule valid_release_q_not_in_release_q_not_runnable)
-    apply (fastforce simp: pred_tcb_at_def obj_at_def o_def)
-   apply clarsimp
+      apply (clarsimp simp add: runnable_tsr idle_tsr when_def)
+      apply (rule corres_split_nor[OF cancel_ipc_corres])
+        apply (rule corres_split_nor[OF setupReplyMaster_corres])
+          apply (rule corres_split_nor[OF setThreadState_corres], simp)
+            apply (rule corres_split[OF tcbSchedEnqueue_corres possibleSwitchTo_corres])
+              apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
+                        sts_st_tcb' sts_valid_objs'
+                     | clarsimp simp: valid_tcb_state'_def | strengthen valid_objs'_valid_tcbs')+
+         apply (rule_tac Q'="\<lambda>rv. valid_sched and cur_tcb and pspace_aligned and pspace_distinct"
+                         in hoare_strengthen_post)
+          apply wp
+         apply (fastforce simp: valid_sched_def valid_sched_action_def)
+        apply (rule_tac Q'="\<lambda>rv. invs' and ex_nonz_cap_to' t" in hoare_strengthen_post)
+         apply wp
+        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 clarsimp
   done
 
-crunch schedContextResume, ifCondRefillUnblockCheck
-  for ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (wp: crunch_wps simp: crunch_simps)
-
 lemma restart_invs':
   "\<lbrace>invs' and ex_nonz_cap_to' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
    ThreadDecls_H.restart t \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  unfolding restart_def
-  apply (simp add: isStopped_def2)
-  apply (wp setThreadState_nonqueued_state_update isSchedulable_wp
-            cancelIPC_simple setThreadState_st_tcb sch_act_simple_lift)
-       apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post[rotated])
-        apply wpsimp
-        apply (clarsimp simp: isSchedulable_bool_def pred_map_pred_conj[simplified pred_conj_def]
-                              projectKO_opt_tcb pred_map_def pred_tcb_at'_def
-                              obj_at'_real_def ko_wp_at'_def
-                       elim!: opt_mapE)
-       apply (wpsimp wp: hoare_vcg_imp_lift')
-      apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post[rotated])
-       apply (fastforce elim: isSchedulable_bool_runnableE)
-       apply (wpsimp wp: ifCondRefillUnblockCheck_invs' hoare_vcg_imp_lift')
-      apply (wpsimp wp: setThreadState_nonqueued_state_update setThreadState_st_tcb
-                        hoare_vcg_if_lift2)
-     apply clarsimp
-     apply wp+
+  apply (simp add: restart_def isStopped_def2)
+  apply (wp setThreadState_nonqueued_state_update
+            cancelIPC_simple setThreadState_st_tcb
+       | wp (once) sch_act_simple_lift)+
+       apply (wp hoare_convert_imp)
+      apply (wp setThreadState_nonqueued_state_update
+                setThreadState_st_tcb)
+     apply (clarsimp)
+     apply (wp hoare_convert_imp)[1]
+    apply (clarsimp)
+    apply (wp)+
    apply (clarsimp simp: comp_def)
-   apply (rule hoare_strengthen_post[OF gts_sp'])
+   apply (rule hoare_strengthen_post, rule gts_sp')
    prefer 2
    apply assumption
-  apply (clarsimp simp: pred_tcb_at' invs'_def ct_in_state'_def)
+  apply (clarsimp simp: pred_tcb_at' invs'_def valid_state'_def
+                        ct_in_state'_def)
+  apply (fastforce simp: pred_tcb_at'_def obj_at'_def)
   done
 
-crunch "ThreadDecls_H.restart"
-  for tcb'[wp]: "tcb_at' t"
-  (wp: crunch_wps whileM_inv simp: crunch_simps)
+lemma restart_tcb'[wp]:
+  "\<lbrace>tcb_at' t'\<rbrace> ThreadDecls_H.restart t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
+  apply (simp add: restart_def isStopped_def2)
+  apply wpsimp
+  done
 
 lemma no_fail_setRegister: "no_fail \<top> (setRegister r v)"
   by (simp add: setRegister_def)
@@ -283,14 +271,17 @@ lemma updateRestartPC_ex_nonz_cap_to'[wp]:
   apply (rule asUser_cap_to')
   done
 
-crunch suspend
-  for cap_to': "ex_nonz_cap_to' p"
-  (wp: crunch_wps simp: crunch_simps)
+lemma suspend_cap_to'[wp]:
+  "\<lbrace>ex_nonz_cap_to' p\<rbrace> suspend t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
+  apply (simp add: suspend_def)
+  apply (wp threadSet_cap_to' | simp)+
+  done
 
 declare det_getRegister[simp]
 declare det_setRegister[simp]
 
-lemma no_fail_getRegister[wp]: "no_fail \<top> (getRegister r)"
+lemma
+  no_fail_getRegister[wp]: "no_fail \<top> (getRegister r)"
   by (simp add: getRegister_def)
 
 lemma invokeTCB_ReadRegisters_corres:
@@ -314,12 +305,19 @@ lemma invokeTCB_ReadRegisters_corres:
          apply simp
         apply (rule no_fail_mapM)
         apply (simp add: no_fail_getRegister)
-       apply (wp suspend_invs)+
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_idle_def
+       apply wp+
+   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
                   dest!: idle_no_ex_cap)
-  apply (clarsimp simp: invs'_def dest!: global'_no_ex_cap)
+  apply (clarsimp simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
   done
 
+crunch asUser
+  for sch_act_simple[wp]: "sch_act_simple"
+  (rule: sch_act_simple_lift)
+
+lemma einvs_valid_etcbs: "einvs s \<longrightarrow> valid_etcbs s"
+  by (clarsimp simp: valid_sched_def)
+
 lemma asUser_postModifyRegisters_corres:
   "corres dc \<top> (tcb_at' t)
      (arch_post_modify_registers ct t)
@@ -330,37 +328,49 @@ lemma asUser_postModifyRegisters_corres:
    by simp+
 
 crunch restart
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' tcbPtr"
-  (wp: crunch_wps threadSet_cap_to simp: crunch_simps tcb_cte_cases_def)
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  and valid_sched_pointers[wp]: valid_sched_pointers
+  (simp: crunch_simps wp: crunch_wps threadSet_sched_pointers threadSet_valid_sched_pointers)
 
 lemma invokeTCB_WriteRegisters_corres:
-  "corres (dc \<oplus> (=))
-          (einvs and simple_sched_action and tcb_at dest and ex_nonz_cap_to dest
-           and current_time_bounded)
-          (invs' and tcb_at' dest and ex_nonz_cap_to' dest)
-          (invoke_tcb (tcb_invocation.WriteRegisters dest resume values arch))
-          (invokeTCB (tcbinvocation.WriteRegisters dest resume values arch'))"
+  "corres (dc \<oplus> (=)) (einvs  and tcb_at dest and ex_nonz_cap_to dest)
+        (invs' and sch_act_simple and tcb_at' dest and ex_nonz_cap_to' dest)
+        (invoke_tcb (tcb_invocation.WriteRegisters dest resume values arch))
+        (invokeTCB (tcbinvocation.WriteRegisters dest resume values arch'))"
   apply (simp add: invokeTCB_def performTransfer_def arch_get_sanitise_register_info_def
                    frameRegisters_def gpRegisters_def getSanitiseRegisterInfo_def
                    sanitiseRegister_def sanitise_register_def)
-  apply (rule corres_underlying_split[rotated 2, OF gets_sp getCurThread_sp])
-   apply (corresKsimp corres: getCurThread_corres)
-  apply (rule corres_split_skip; (solves wpsimp)?)
-   apply (corresKsimp corres: asUser_corres
-                       simp: zipWithM_mapM getRestartPC_def setNextPC_def
-                         wp: no_fail_mapM no_fail_setRegister)
-  apply (rule corres_split_skip; (solves wpsimp)?)
-   apply (corresKsimp corres: asUser_postModifyRegisters_corres[simplified])
-  apply (rule_tac Q="\<lambda>_. einvs" and Q'="\<lambda>_. invs'" in corres_underlying_split[rotated 2])
-     apply (wpsimp wp: restart_valid_sched)
-     using idle_no_ex_cap apply fastforce
-    apply (wpsimp wp: restart_invs')
-    using global'_no_ex_cap apply fastforce
-   apply (corresKsimp corres: restart_corres)
-  apply (corresKsimp corres: rescheduleRequired_corres)
-  apply fastforce
+  apply (rule corres_guard_imp)
+    apply (rule corres_split[OF getCurThread_corres])
+      apply (rule corres_split_nor)
+         apply (rule asUser_corres)
+         apply (simp add: zipWithM_mapM getRestartPC_def setNextPC_def)
+         apply (rule corres_Id, simp+)
+         apply (wpsimp wp: no_fail_mapM no_fail_setRegister)+
+        apply (rule corres_split_nor[OF asUser_postModifyRegisters_corres[simplified]])
+          apply (rule corres_split_nor[OF corres_when[OF refl restart_corres]])
+            apply (rule corres_split_nor[OF corres_when[OF refl rescheduleRequired_corres]])
+              apply (rule_tac P=\<top> and P'=\<top> in corres_inst)
+              apply simp
+             apply (wp+)[2]
+           apply ((wp hoare_weak_lift_imp restart_invs'
+                   | strengthen valid_sched_weak_strg einvs_valid_etcbs
+                                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'
+                   | clarsimp simp: invs_def valid_state_def valid_sched_def invs'_def valid_state'_def
+                             dest!: global'_no_ex_cap idle_no_ex_cap)+)[2]
+         apply (rule_tac Q'="\<lambda>_. einvs and tcb_at dest and ex_nonz_cap_to dest" in hoare_strengthen_post[rotated])
+          apply (fastforce simp: invs_def valid_sched_weak_strg valid_sched_def valid_state_def dest!: idle_no_ex_cap)
+         prefer 2
+         apply (rule_tac Q'="\<lambda>_. invs' and tcb_at' dest and ex_nonz_cap_to' dest" in hoare_strengthen_post[rotated])
+          apply (fastforce simp: sch_act_wf_weak invs'_def valid_state'_def dest!: global'_no_ex_cap)
+         apply (wp | clarsimp)+
   done
 
+crunch suspend
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+
 lemma tcbSchedDequeue_ResumeCurrentThread_imp_notct[wp]:
   "\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
    tcbSchedDequeue t
@@ -375,23 +385,11 @@ lemma updateRestartPC_ResumeCurrentThread_imp_notct[wp]:
   apply (wp hoare_convert_imp)
   done
 
-lemma schedContextCancelYieldTo_ResumeCurrentThread_imp_notct[wp]:
-  "\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
-   schedContextCancelYieldTo t
-   \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
-  by (wp hoare_convert_imp)
-
-lemma tcbReleaseRemove_ResumeCurrentThread_imp_notct[wp]:
-  "\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
-   tcbReleaseRemove t
-   \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
-  by (wp hoare_convert_imp)
-
 lemma suspend_ResumeCurrentThread_imp_notct[wp]:
   "\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
    suspend t
    \<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
-  by (wpsimp simp: suspend_def wp_del: getThreadState_only_state_wp)
+  by (wpsimp simp: suspend_def)
 
 crunch restart, suspend
   for cur_tcb'[wp]: cur_tcb'
@@ -400,7 +398,7 @@ crunch restart, suspend
 lemma invokeTCB_CopyRegisters_corres:
   "corres (dc \<oplus> (=))
         (einvs and simple_sched_action and tcb_at dest and tcb_at src and ex_nonz_cap_to src and
-          ex_nonz_cap_to dest and current_time_bounded)
+          ex_nonz_cap_to dest)
         (invs' and sch_act_simple and tcb_at' dest and tcb_at' src
           and ex_nonz_cap_to' src and ex_nonz_cap_to' dest)
         (invoke_tcb (tcb_invocation.CopyRegisters dest src susp resume frames ints arch))
@@ -467,89 +465,75 @@ proof -
                apply (rule corres_when[OF refl])
                apply (rule R[OF refl refl])
                apply (simp add: gpRegisters_def)
-              apply (rule corres_split_eqr [OF getCurThread_corres])
+              apply (rule corres_split_eqr[OF getCurThread_corres])
                 apply (rule corres_split_nor[OF asUser_postModifyRegisters_corres[simplified]])
                   apply (rule corres_split[OF corres_when[OF refl rescheduleRequired_corres]])
                     apply (rule_tac P=\<top> and P'=\<top> in corres_inst)
                     apply simp
                    apply (solves \<open>wp hoare_weak_lift_imp\<close>)+
-             apply (rule_tac Q'="\<lambda>_. einvs and tcb_at dest" in hoare_strengthen_post[rotated])
-              apply (clarsimp simp: invs_def valid_sched_weak_strg valid_sched_def valid_state_def
-                                    valid_pspace_def)
+             apply (rule_tac Q'="\<lambda>_. einvs and tcb_at dest" in hoare_post_imp)
+              apply (fastforce simp: invs_def valid_state_def valid_pspace_def valid_sched_weak_strg valid_sched_def)
              prefer 2
-             apply (rule_tac Q'="\<lambda>_. invs' and tcb_at' dest" in hoare_strengthen_post[rotated])
-              apply (clarsimp simp: invs'_def valid_pspace'_def)
-             apply ((wp mapM_x_wp' hoare_weak_lift_imp | simp)+)[4]
-         apply ((wp hoare_weak_lift_imp restart_invs' restart_valid_sched | wpc | clarsimp simp: if_apply_def2)+)[2]
-       apply (rule_tac Q'="\<lambda>_. einvs and tcb_at dest and tcb_at src and ex_nonz_cap_to dest
-                              and simple_sched_action and current_time_bounded"
-              in hoare_strengthen_post[rotated])
-        apply (clarsimp simp: invs_def valid_sched_weak_strg valid_sched_def valid_state_def
-                              valid_pspace_def valid_idle_def
-                       dest!: idle_no_ex_cap )
-       apply (wp suspend_nonz_cap_to_tcb hoare_weak_lift_imp suspend_invs suspend_cap_to'
-                 suspend_valid_sched
-              | simp add: if_apply_def2)+
-     apply (fastforce simp: invs_def valid_state_def valid_pspace_def valid_idle_def
+             apply (rule_tac Q'="\<lambda>_. invs' and tcb_at' dest" in hoare_post_imp)
+              apply (fastforce simp: invs'_def valid_state'_def invs_weak_sch_act_wf cur_tcb'_def)
+             apply ((wp mapM_x_wp' hoare_weak_lift_imp | (simp add: cur_tcb'_def[symmetric])+)+)[8]
+         apply ((wp hoare_weak_lift_imp restart_invs' | wpc | clarsimp simp: if_apply_def2)+)[2]
+       apply (wp suspend_nonz_cap_to_tcb hoare_weak_lift_imp | simp add: if_apply_def2)+
+     apply (fastforce simp: invs_def valid_state_def valid_pspace_def
                      dest!: idle_no_ex_cap)
-    apply (fastforce simp: invs'_def dest!: global'_no_ex_cap)
-    done
+    by (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
 qed
 
 lemma readreg_invs':
-  "\<lbrace>invs' and tcb_at' src and ex_nonz_cap_to' src\<rbrace>
+  "\<lbrace>invs' and sch_act_simple and tcb_at' src and ex_nonz_cap_to' src\<rbrace>
      invokeTCB (tcbinvocation.ReadRegisters src susp n arch)
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   by (simp add: invokeTCB_def performTransfer_def | wp
-       | clarsimp simp: invs'_def
+       | clarsimp simp: invs'_def valid_state'_def
                  dest!: global'_no_ex_cap)+
 
+crunch getSanitiseRegisterInfo
+  for invs'[wp]: invs'
+
+crunch getSanitiseRegisterInfo
+  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' d"
+  and it'[wp]: "\<lambda>s. P (ksIdleThread s)"
+  and tcb_at'[wp]: "tcb_at' a"
+
+
 lemma writereg_invs':
-  "\<lbrace>invs' and tcb_at' dest and ex_nonz_cap_to' dest\<rbrace>
+  "\<lbrace>invs' and sch_act_simple and tcb_at' dest and ex_nonz_cap_to' dest\<rbrace>
      invokeTCB (tcbinvocation.WriteRegisters dest resume values arch)
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   by (simp add: invokeTCB_def performTransfer_def  | wp restart_invs' | rule conjI
        | clarsimp
-       | clarsimp simp: invs'_def
+       | clarsimp simp: invs'_def valid_state'_def
                  dest!: global'_no_ex_cap)+
 
 lemma copyreg_invs'':
-  "\<lbrace>invs' and tcb_at' src and tcb_at' dest and ex_nonz_cap_to' src and ex_nonz_cap_to' dest\<rbrace>
+  "\<lbrace>invs' and sch_act_simple and tcb_at' src and tcb_at' dest and ex_nonz_cap_to' src and ex_nonz_cap_to' dest\<rbrace>
      invokeTCB (tcbinvocation.CopyRegisters dest src susp resume frames ints arch)
    \<lbrace>\<lambda>rv. invs' and tcb_at' dest\<rbrace>"
-  supply if_split [split del] if_weak_cong[cong]
-  unfolding invokeTCB_def performTransfer_def
-  apply (wpsimp wp: mapM_x_wp' restart_invs' hoare_vcg_if_lift2 hoare_drop_imp suspend_cap_to')
-  by (fastforce simp: invs'_def dest!: global'_no_ex_cap split: if_split)
+  supply if_weak_cong[cong]
+  apply (simp add: invokeTCB_def performTransfer_def if_apply_def2)
+  apply (wp mapM_x_wp' restart_invs' | simp)+
+   apply (rule conjI)
+    apply (wp | clarsimp)+
+  by (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
 
 lemma copyreg_invs':
-  "\<lbrace>invs' and tcb_at' src and
+  "\<lbrace>invs' and sch_act_simple and tcb_at' src and
           tcb_at' dest and ex_nonz_cap_to' src and ex_nonz_cap_to' dest\<rbrace>
      invokeTCB (tcbinvocation.CopyRegisters dest src susp resume frames ints arch)
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   by (rule hoare_strengthen_post, rule copyreg_invs'', simp)
 
-lemma isRunnable_corres':
-  "t = t' \<Longrightarrow>
-   corres (\<lambda>ts runn. runnable ts = runn)
-     (tcb_at t and pspace_aligned and pspace_distinct) \<top>
-     (get_thread_state t) (isRunnable t')"
-  apply (rule_tac Q="tcb_at' t" in corres_cross_add_guard)
-   apply (fastforce dest!: state_relationD elim!: tcb_at_cross)
+lemma isRunnable_corres:
+  "corres (\<lambda>ts runn. runnable ts = runn)
+          (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+          (get_thread_state t) (isRunnable t)"
   apply (simp add: isRunnable_def)
   apply (subst bind_return[symmetric])
-  apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getThreadState_corres'], clarsimp)
-      apply (case_tac rv, clarsimp+)
-     apply (wp hoare_TrueI)+
-   apply auto
-  done
-
-lemma isBlocked_corres:
-  "corres (\<lambda>ts blocked. ipc_queued_thread_state ts = blocked) (tcb_at t) (tcb_at' t)
-     (get_thread_state t) (isBlocked t)"
-  apply (simp add: isBlocked_def)
-  apply (subst bind_return[symmetric])
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF getThreadState_corres])
       apply (case_tac rv, clarsimp+)
@@ -565,7 +549,7 @@ lemma tcbSchedDequeue_not_queued:
   apply (rule_tac Q'="\<lambda>rv. obj_at' (\<lambda>obj. tcbQueued obj = rv) t"
                in hoare_post_imp)
    apply (clarsimp simp: obj_at'_def)
-  apply (wp threadGet_sp' [where P=\<top>, simplified] | simp)+
+  apply (wp tg_sp' [where P=\<top>, simplified] | simp)+
   done
 
 lemma threadSet_ct_in_state':
@@ -584,18 +568,16 @@ lemma tcbSchedDequeue_ct_in_state'[wp]:
   apply (rule hoare_lift_Pf [where f=ksCurThread]; wp)
   done
 
-lemma valid_tcb'_tcbPriority_update:
-  "\<lbrakk> valid_tcb' tcb s; f (tcbPriority tcb) \<le> maxPriority \<rbrakk>
-     \<Longrightarrow> valid_tcb' (tcbPriority_update f tcb) s"
+lemma valid_tcb'_tcbPriority_update: "\<lbrakk>valid_tcb' tcb s; f (tcbPriority tcb) \<le> maxPriority \<rbrakk> \<Longrightarrow> valid_tcb' (tcbPriority_update f tcb) s"
   apply (simp add: valid_tcb'_def tcb_cte_cases_def)
   done
 
 lemma threadSet_valid_objs_tcbPriority_update:
-  "\<lbrace>valid_objs' and (\<lambda>_. prio \<le> maxPriority)\<rbrace>
-   threadSetPriority t prio
+  "\<lbrace>valid_objs' and (\<lambda>_. x \<le> maxPriority)\<rbrace>
+     threadSet (tcbPriority_update (\<lambda>_. x)) t
    \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
   including no_pre
-  apply (simp add: threadSetPriority_def threadSet_def)
+  apply (simp add: threadSet_def)
   apply wp
    prefer 2
    apply (rule getObject_tcb_sp)
@@ -611,395 +593,69 @@ lemma threadSet_valid_objs_tcbPriority_update:
     apply (fastforce  simp: obj_at'_def)+
   done
 
-lemma tcbEPDequeueAppend_valid_ntfn'_rv:
-  "\<lbrace>valid_ntfn' ntfn and K (ntfnObj ntfn = WaitingNtfn qs \<and> t \<in> set qs)\<rbrace>
-   do qs' \<leftarrow> tcbEPDequeue t qs;
-      tcbEPAppend t qs'
-   od
-   \<lbrace>\<lambda>rv s. valid_ntfn' (ntfnObj_update (\<lambda>_. WaitingNtfn rv) ntfn) s\<rbrace>"
-  apply (simp only: tcbEPAppend_def tcbEPDequeue_def)
-  apply (wp tcbEPFindIndex_wp)
-  apply (rule conjI)
-   apply (clarsimp simp: valid_ntfn'_def split: option.split)
-  apply (clarsimp simp: valid_ntfn'_def simp del: imp_disjL dest!: findIndex_member)
-  apply (intro conjI; clarsimp?)
-          apply (fastforce dest: in_set_takeD in_set_dropD)
-         apply (fastforce dest: in_set_dropD)
-        apply (fastforce dest: in_set_dropD)
-       apply (fastforce dest: in_set_dropD)
-      apply (fastforce dest: in_set_takeD)
-     apply (clarsimp simp: Int_Un_distrib set_take_disj_set_drop_if_distinct)
-     apply (rule disjoint_subset_both[OF set_take_subset set_drop_subset])
-     apply (simp add: Int_commute)
-    apply (fastforce dest: in_set_takeD)
-   apply (clarsimp simp: Int_Un_distrib set_take_disj_set_drop_if_distinct)
-   apply (fastforce dest: in_set_takeD in_set_dropD)
-  apply (clarsimp split: option.split)
-  apply (rename_tac ys zs i j tcb tcba tptr)
-  apply (case_tac ys; clarsimp)
-  done
-
-lemma reorderNtfn_invs':
-  "\<lbrace>invs' and st_tcb_at' (\<lambda>st. ntfnBlocked st = Some ntfnPtr) tptr\<rbrace>
-   reorderNtfn ntfnPtr tptr
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp only: reorderNtfn_def)
-  apply (subst bind_assoc[symmetric, where m="tcbEPDequeue tptr _"])
-  apply (rule bind_wp | simp only: K_bind_def)+
-        apply (wp set_ntfn_minor_invs')
-       apply (simp add: pred_conj_def live_ntfn'_def)
-       apply (wpsimp wp: getNotification_wp tcbEPDequeueAppend_valid_ntfn'_rv hoare_vcg_conj_lift)+
-  apply (frule ntfn_ko_at_valid_objs_valid_ntfn', fastforce)
-  apply (clarsimp simp: sym_refs_asrt_def valid_ntfn'_def pred_tcb_at'_def
-                        obj_at'_def projectKO_eq projectKO_tcb projectKO_ntfn)
-  apply (case_tac "tcbState obj"; clarsimp simp: ntfnBlocked_def getntfnQueue_def split: ntfn.splits)
-  apply (frule_tac ko=obj and p=tptr in sym_refs_ko_atD'[rotated])
-   apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb)
-  apply (clarsimp simp: invs'_def valid_idle'_def live_ntfn'_def
-                        if_live_then_nonz_cap'_def refs_of_rev' get_refs_def
-                        ko_wp_at'_def obj_at'_def projectKO_eq projectKO_tcb
-                 split: option.splits)
-  done
-
-lemma set_ep_minor_invs':
-  "\<lbrace>invs' and obj_at' (\<lambda>ep. ep_q_refs_of' ep = ep_q_refs_of' val) ptr
-          and valid_ep' val
-          and (\<lambda>s. live' (KOEndpoint val) \<longrightarrow> ex_nonz_cap_to' ptr s)\<rbrace>
-   setEndpoint ptr val
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (clarsimp simp add: invs'_def cteCaps_of_def valid_dom_schedule'_def)
-  apply (wpsimp wp: irqs_masked_lift valid_irq_node_lift untyped_ranges_zero_lift simp: o_def)
-  done
-
-lemma getEpQueue_wp[wp]: "\<lbrace>\<lambda>s. ep \<noteq> IdleEP \<longrightarrow> P (epQueue ep) s\<rbrace> getEpQueue ep \<lbrace>P\<rbrace>"
-  unfolding getEpQueue_def by wpsimp auto
-
-lemma updateEpQueue_triv: "ep \<noteq> IdleEP \<Longrightarrow> updateEpQueue ep (epQueue ep) = ep"
-  by (cases ep; clarsimp simp: updateEpQueue_def)
+crunch tcbSchedDequeue
+  for cur[wp]: cur_tcb'
 
-lemma updateEPQueue_IdleEP[simp]: "(updateEpQueue ep qs = IdleEP) = (ep = IdleEP)"
-  by (cases ep; simp add: updateEpQueue_def)
+crunch tcbSchedDequeue
+  for st_tcb_at'[wp]: "\<lambda>s. P (st_tcb_at' st tcbPtr s)"
 
-lemma reorderEp_invs':
-  "\<lbrace>invs' and st_tcb_at' (\<lambda>st. epBlocked st = Some ntfnPtr) tptr\<rbrace>
-   reorderEp ntfnPtr tptr
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp only: reorderEp_def)
-  apply (subst bind_assoc[symmetric, where m="tcbEPDequeue tptr _"])
-  apply (wp set_ep_minor_invs')
-       apply (simp add: pred_conj_def live_ntfn'_def)
-       apply (wpsimp wp: getEndpoint_wp tcbEPAppend_valid_ep' tcbEPAppend_rv_wf' tcbEPAppend_rv_wf''
-                         tcbEPDequeue_valid_ep' tcbEPDequeue_rv_wf' tcbEPDequeue_rv_wf'')+
-  apply (frule ep_ko_at_valid_objs_valid_ep', fastforce)
-  apply (clarsimp simp: updateEpQueue_triv sym_refs_asrt_def valid_ep'_def pred_tcb_at'_def
-                        obj_at'_def projectKO_eq projectKO_tcb projectKO_ep)
-  apply (frule_tac ko=obj and p=tptr in sym_refs_ko_atD'[rotated])
-   apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb)
-  apply (case_tac "tcbState obj"; clarsimp simp: epBlocked_def split: ntfn.splits if_splits)
-    apply (auto simp: invs'_def if_live_then_nonz_cap'_def
-                      refs_of_rev' get_refs_def ko_wp_at'_def obj_at'_def projectKO_eq projectKO_tcb
-               split: option.splits)
-  done
-
-lemma threadSetPriority_invs':
-  "\<lbrace>invs' and obj_at' (Not \<circ> tcbQueued) t and K (p \<le> maxPriority)\<rbrace>
-   threadSetPriority t p
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (rule hoare_gen_asm)
-  apply (wpsimp wp: threadSet_invs_trivial simp: threadSetPriority_def)
-  by (fastforce simp: tcb_cte_cases_def invs'_def inQ_def obj_at'_def
-                      valid_queues_def valid_queues_no_bitmap_def valid_release_queue'_def)+
-
-crunch reorderEp, threadSetPriority
-  for st_tcb_at'[wp]: "st_tcb_at' P t"
-  (wp: crunch_wps threadSet_st_tcb_at2)
-
-lemma threadSetPriority_onRunning_invs':
-   "\<lbrace>\<lambda>s. invs' s \<and> ready_qs_runnable s \<and> ct_active' s \<and> p \<le> maxPriority\<rbrace>
-    threadSetPriority_onRunning t p
-    \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp only: threadSetPriority_onRunning_def)
-  apply (wpsimp wp: hoare_vcg_const_imp_lift rescheduleRequired_invs' hoare_vcg_all_lift)
-       apply (wpsimp wp: threadGet_wp threadSetPriority_invs' tcbSchedDequeue_not_queued)+
-  apply (drule invs_queues')
-  apply (fastforce simp: ready_qs_runnable_def valid_queues'_def inQ_def
-                         obj_at'_def ct_in_state'_def runnable_eq_active')
-  done
-
-lemma runnable'_case_thread_state_If:
-  "(case rv of Structures_H.thread_state.Running \<Rightarrow> threadSetPriority_onRunning t x
-             | Structures_H.thread_state.Restart \<Rightarrow> threadSetPriority_onRunning t x
-             | _ \<Rightarrow> P) =
-   (if runnable' rv then threadSetPriority_onRunning t x else P)"
-  by (cases rv; clarsimp)
-
-lemma setP_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> ready_qs_runnable s \<and> ct_active' s \<and> p \<le> maxPriority\<rbrace>
-   setPriority t p
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp add: setPriority_def runnable'_case_thread_state_If)
-  apply (wpsimp wp: threadSetPriority_onRunning_invs' threadSetPriority_invs' reorderEp_invs'
-                    reorderNtfn_invs' gts_wp' hoare_vcg_all_lift hoare_vcg_const_imp_lift)
-  apply (drule invs_queues')
-  apply (fastforce simp: ready_qs_runnable_def valid_queues'_def inQ_def
-                         pred_tcb_at'_def obj_at'_def projectKO_eq)
-  done
-
-lemma reorder_ntfn_corres:
-  "ntfn = ntfn' \<Longrightarrow> corres dc (invs and st_tcb_at (\<lambda>st. ntfn_blocked st = Some ntfn) t)
-                              (invs' and st_tcb_at' (\<lambda>st. ntfnBlocked st = Some ntfn) t)
-                              (reorder_ntfn ntfn t) (reorderNtfn ntfn' t)"
-  apply add_sym_refs
-  apply (clarsimp simp: reorder_ntfn_def reorderNtfn_def)
-  apply (rule corres_stateAssert_assume)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split)
-        apply (rule getNotification_corres)
-       apply (rule corres_assert_opt_assume_l)
-       apply (rule corres_assert_assume_r)
-       apply (rule corres_split)
-          apply (rule tcbEPDequeue_corres)
-          apply (clarsimp simp: ntfn_relation_def get_ntfn_queue_def getntfnQueue_def
-                         split: Structures_A.ntfn.splits)
-         apply (rule corres_split)
-            apply clarsimp
-            apply (rule tcbEPAppend_corres)
-           apply (rule setNotification_corres)
-           apply (clarsimp simp: ntfn_relation_def)
-          apply wp
-         apply wp
-        apply (rule tcb_ep_dequeue_rv_wf')
-       apply (rule tcbEPDequeue_rv_wf')
-      apply (wp get_simple_ko_wp)
-     apply (wp getNotification_wp)
-    apply (clarsimp simp: pred_tcb_at_def obj_at_def ntfn_blocked_def)
-    apply (clarsimp split: Structures_A.thread_state.splits)
-    apply (frule invs_valid_objs)
-    apply (erule (1) valid_objsE[where x=t])
-    apply (clarsimp simp: valid_obj_def valid_tcb_def valid_tcb_state_def obj_at_def)
-    apply (frule invs_valid_objs)
-    apply (erule (1) valid_objsE[where x=ntfn'])
-    apply (clarsimp simp: valid_obj_def valid_ntfn_def)
-    apply (frule invs_sym_refs)
-    apply (drule_tac p=t in sym_refs_ko_atD[rotated])
-     apply (simp add: obj_at_def)
-    apply clarsimp
-    apply (clarsimp simp: refs_of_rev obj_at_def get_ntfn_queue_def is_tcb_def is_ntfn_def)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKO_eq projectKO_tcb ntfnBlocked_def)
-   apply (clarsimp split: thread_state.splits)
-   apply (frule invs_valid_objs')
-   apply (erule (1) valid_objsE'[where x=t])
-   apply (clarsimp simp: valid_obj'_def valid_tcb'_def valid_tcb_state'_def
-                         obj_at'_def projectKO_eq projectKO_ntfn)
-   apply (frule invs_valid_objs')
-   apply (erule (1) valid_objsE'[where x=ntfn'])
-   apply (clarsimp simp: valid_obj'_def valid_ntfn'_def)
-   apply (drule_tac p=t and ko=obj in sym_refs_ko_atD'[rotated])
-    apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb)
-   apply clarsimp
-   apply (clarsimp simp: refs_of_rev' ko_wp_at'_def getntfnQueue_def
-                         obj_at'_def projectKO_eq projectKO_tcb)
-  apply (clarsimp simp: sym_refs_asrt_def)
+lemma sp_corres2:
+  "corres dc
+     (valid_etcbs and 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)
+     (set_priority t x) (setPriority t x)"
+  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 isRunnable_corres])
+          apply (erule corres_when)
+          apply(rule corres_split[OF getCurThread_corres])
+            apply (wp corres_if; clarsimp)
+             apply (rule rescheduleRequired_corres)
+            apply (rule possibleSwitchTo_corres)
+           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 ((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
+              | 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
+                dest: pspace_relation_tcb_at intro: st_tcb_at_opeqI)
+  apply clarsimp
   done
 
-lemma reorder_ep_corres:
-  "a = a' \<Longrightarrow> corres dc (invs and st_tcb_at (\<lambda>st. ep_blocked st = Some a) t)
-                        (invs' and st_tcb_at' (\<lambda>st. epBlocked st = Some a) t)
-                        (reorder_ep a t) (reorderEp a' t)"
-  apply add_sym_refs
-  apply (clarsimp simp: reorder_ep_def reorderEp_def)
-  apply (rule corres_stateAssert_assume)
-   apply (rule corres_guard_imp)
-     apply (rule corres_split)
-        apply (rule getEndpoint_corres)
-       apply (rename_tac ep ep')
-       apply (rule_tac F="ep \<noteq> Structures_A.endpoint.IdleEP" in corres_gen_asm)
-       apply (rule_tac r'="(=)" in corres_split)
-          apply (rule corres_trivial)
-          apply (case_tac ep; clarsimp simp: get_ep_queue_def getEpQueue_def ep_relation_def)
-         apply clarsimp
-         apply (rule corres_split)
-            apply (rule tcbEPDequeue_corres)
-            apply clarsimp
-           apply (rule corres_split)
-              apply clarsimp
-              apply (rule tcbEPAppend_corres)
-             apply (rule setEndpoint_corres)
-             apply (case_tac ep; clarsimp simp: ep_relation_def updateEpQueue_def)
-            apply wp
-           apply wp
-          apply (rule tcb_ep_dequeue_rv_wf')
-         apply (rule tcbEPDequeue_rv_wf')
-        apply clarsimp
-        apply (wpsimp simp: get_ep_queue_def)
-       apply (wpsimp simp: getEpQueue_def)
-      apply (wp get_simple_ko_wp)
-     apply (wp getEndpoint_wp)
-    apply (clarsimp simp: pred_tcb_at_def obj_at_def ep_blocked_def)
-    apply (frule invs_valid_objs)
-    apply (erule (1) valid_objsE[where x=t])
-    apply (clarsimp simp: valid_obj_def valid_tcb_def )
-    apply (prop_tac "ep_at a' s")
-     apply (clarsimp simp: valid_tcb_state_def split: Structures_A.thread_state.splits)
-    apply (clarsimp simp: obj_at_def)
-    apply (frule invs_valid_objs)
-    apply (erule (1) valid_objsE[where x=a'])
-    apply (clarsimp simp: valid_obj_def valid_ep_def)
-    apply (frule invs_sym_refs)
-    apply (drule_tac p=t in sym_refs_ko_atD[rotated])
-     apply (simp add: obj_at_def)
-    apply (fastforce simp: obj_at_def is_tcb_def split: if_splits Structures_A.thread_state.splits)
-   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKO_eq projectKO_tcb epBlocked_def)
-   apply (frule invs_valid_objs')
-   apply (erule (1) valid_objsE'[where x=t])
-   apply (clarsimp simp: valid_obj'_def valid_tcb'_def)
-   apply (prop_tac "ep_at' a' s")
-    apply (clarsimp simp: valid_tcb_state'_def obj_at'_def projectKO_eq projectKO_ep
-                   split: thread_state.splits)
-   apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_ep)
-   apply (frule invs_valid_objs')
-   apply (erule (1) valid_objsE'[where x=a'])
-   apply (clarsimp simp: valid_obj'_def valid_ep'_def)
-   apply (drule_tac p=t and ko=obj in sym_refs_ko_atD'[rotated])
-    apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb)
-   apply (fastforce simp: refs_of_rev' ko_wp_at'_def obj_at'_def projectKO_eq projectKO_tcb
-                   split: thread_state.splits if_splits endpoint.splits)
-  apply (clarsimp simp: sym_refs_asrt_def)
-  done
-
-lemma threadSetPriority_valid_tcbs'[wp]:
-  "\<lbrace>valid_tcbs' and K (prio \<le> maxPriority)\<rbrace>
-   threadSet (tcbPriority_update (\<lambda>_. prio)) t
-   \<lbrace>\<lambda>_. valid_tcbs'\<rbrace>"
-  apply (wp threadSet_valid_tcbs')
-  apply (fastforce simp: valid_tcbs'_def valid_tcb'_def tcb_cte_cases_def
-                         obj_at'_def projectKO_eq projectKO_tcb)
-  done
-
-lemma threadSetPriority_onRunning_corres:
-  "corres dc (valid_pspace and weak_valid_sched_action and active_scs_valid
-              and tcb_at t and K (prio \<le> maxPriority))
-             (\<lambda>s. invs' s \<and> tcb_at' t s)
-             (do d <- thread_get tcb_domain t;
-                 p <- thread_get tcb_priority t;
-                 queue <- get_tcb_queue d p;
-                 cur <- gets cur_thread;
-                 if t \<in> set queue \<or> t = cur
-                 then do y <- tcb_sched_action tcb_sched_dequeue t;
-                         y <- thread_set_priority t prio;
-                         y <- tcb_sched_action tcb_sched_enqueue t;
-                         reschedule_required od
-                 else thread_set_priority t prio od)
-             (threadSetPriority_onRunning t prio)"
-  apply (rule corres_gen_asm')
-  apply (simp add: threadSetPriority_onRunning_def thread_set_priority_def
-                   threadSetPriority_def epBlocked_def ntfnBlocked_def get_tcb_queue_def)
-  apply (rule corres_symb_exec_l[OF _ _ thread_get_sp])
-    apply (rule corres_symb_exec_l[OF _ _ thread_get_sp])
-      apply (rule corres_symb_exec_l[OF _ _ gets_sp])
-        apply (rule corres_symb_exec_r[OF _ threadGet_sp'])
-          apply (rule stronger_corres_guard_imp)
-            apply (rule_tac F="t \<in> set (queues d p) = queued" in corres_gen_asm)
-            apply (rule corres_split)
-               apply (rule getCurThread_corres)
-              apply (rule corres_if)
-                apply clarsimp
-               apply (rule corres_split_nor)
-                  apply (rule tcbSchedDequeue_corres)
-                 apply (rule corres_split_nor)
-                    apply (rule threadset_corresT)
-                      apply (clarsimp simp: tcb_relation_def)
-                     apply (clarsimp simp: tcb_cap_cases_def)
-                    apply (clarsimp simp: tcb_cte_cases_def)
-                   apply (rule corres_split_nor)
-                      apply (rule tcbSchedEnqueue_corres)
-                     apply (rule rescheduleRequired_corres)
-                    apply wp
-                   apply wp
-                  apply (wpsimp wp: thread_set_weak_valid_sched_action)
-                 apply (wpsimp wp: threadSet_valid_queues_no_state threadSet_valid_queues'_no_state
-                                   threadSet_valid_release_queue threadSet_valid_release_queue')
-                apply wp
-               apply (rule_tac Q'="\<lambda>_ s. tcb_at' t s \<and> valid_tcbs' s \<and>
-                                        valid_queues s \<and> valid_queues' s \<and>
-                                        valid_release_queue s \<and> valid_release_queue' s \<and>
-                                        (\<forall>d p. t \<notin> set (ksReadyQueues s (d,p)))"
-                            in hoare_strengthen_post[rotated])
-                apply (clarsimp simp: valid_release_queue'_def obj_at'_def)
-               apply (wp tcbSchedDequeue_nonq tcbSchedDequeue_valid_queues hoare_vcg_all_lift)
-              apply (rule threadset_corresT)
-                apply (clarsimp simp: tcb_relation_def)
-               apply (clarsimp simp: tcb_cap_cases_def)
-              apply (clarsimp simp: tcb_cte_cases_def)
-             apply wp
-            apply wp
-           apply (frule state_relation_pspace_relation)
-           apply (clarsimp simp: invs'_def valid_pspace_def pspace_relation_def
-                                  obj_at_def is_tcb_def obj_at'_def projectKO_eq projectKO_tcb)
-           apply (drule_tac x=t in bspec)
-            apply clarsimp
-           apply (clarsimp simp: other_obj_relation_def)
-           apply (drule state_relation_ready_queues_relation)
-           apply (fastforce simp: tcb_relation_def ready_queues_relation_def
-                                  obj_at'_def projectKO_eq projectKO_tcb inQ_def
-                                  valid_queues_def valid_queues'_def valid_queues_no_bitmap_def)
-          apply clarsimp
-          apply (frule invs'_valid_tcbs')
-          apply (clarsimp simp: invs'_def valid_tcbs'_def
-                                valid_tcb'_def obj_at'_def projectKO_eq projectKO_tcb)
-         apply (wpsimp wp: thread_get_exs_valid simp: thread_get_def tcb_at_def)+
-  done
-
-lemma setPriority:
-  "corres dc (einvs and tcb_at t) (invs' and tcb_at' t and (\<lambda>_. prio \<le> maxPriority))
-             (set_priority t prio) (setPriority t prio)"
-  apply (simp add: setPriority_def set_priority_def runnable'_case_thread_state_If)
-  apply (rule stronger_corres_guard_imp)
-    apply (rule_tac r'=thread_state_relation in corres_split)
-       apply (rule getThreadState_corres)
-      apply (rule corres_if)
-        apply (case_tac rv; simp add: thread_state_relation_def)
-       apply (rule threadSetPriority_onRunning_corres)
-      apply (rule corres_split)
-         apply (wpsimp wp: threadset_corresT simp: thread_set_priority_def threadSetPriority_def)
-           apply (clarsimp simp: tcb_relation_def)
-          apply (clarsimp simp: tcb_cap_cases_def)
-         apply (clarsimp simp: tcb_cte_cases_def)
-        apply (rule corres_split)
-           apply (clarsimp simp: maybeM_def case_option_If2 split del: if_split)
-           apply (rule corres_if)
-             apply (case_tac rv; simp add: ep_blocked_def epBlocked_def)
-            apply (rule reorder_ep_corres)
-            apply (case_tac rv; simp add: ep_blocked_def epBlocked_def)
-           apply clarsimp
-          apply (clarsimp simp: maybeM_def case_option_If2 split del: if_split)
-          apply (rule corres_if)
-            apply (case_tac rv; simp add: ntfn_blocked_def ntfnBlocked_def)
-           apply (rule reorder_ntfn_corres)
-           apply (case_tac rv; simp add: ntfn_blocked_def ntfnBlocked_def)
-          apply (rule corres_trivial, clarsimp)
-         apply (wpsimp wp: hoare_vcg_const_imp_lift simp: if_fun_split)
-        apply (wpsimp wp: hoare_vcg_const_imp_lift reorderEp_invs' simp: if_fun_split)
-       apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_vcg_all_lift simp: if_fun_split)
-      apply (subgoal_tac "ep_blocked rv = epBlocked rv' \<and> ntfn_blocked rv = ntfnBlocked rv'")
-       apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_vcg_all_lift
-                         threadSet_valid_objs_tcbPriority_update threadSetPriority_invs'
-                   simp: if_fun_split)
-      apply (case_tac rv; simp add: ep_blocked_def epBlocked_def ntfn_blocked_def ntfnBlocked_def)
-     apply (wp gts_wp)
-    apply (wp gts_wp')
-   apply (fastforce simp: pred_tcb_at_def obj_at_def)
-  apply (drule ready_qs_runnable_cross; clarsimp simp: ready_qs_runnable_def)
-  apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
-  apply (fastforce simp: invs'_def pred_tcb_at'_def obj_at'_def projectKO_eq projectKO_tcb
-                  dest!: valid_queues_not_runnable_not_queued)
+lemma setPriority_corres:
+  "corres dc
+     (einvs and tcb_at t)
+     (invs' and tcb_at' t and valid_objs' and (\<lambda>_. x \<le> maxPriority))
+     (set_priority t x) (setPriority t x)"
+  apply (rule corres_guard_imp)
+    apply (rule sp_corres2)
+   apply (simp add: valid_sched_def valid_sched_action_def invs_psp_aligned invs_distinct invs_def)
+  apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak)
   done
 
-lemma setMCPriority_corres: "corres dc (tcb_at t) (tcb_at' t) (set_mcpriority t mcp) (setMCPriority t mcp)"
+lemma setMCPriority_corres:
+  "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \<top>
+             (set_mcpriority t x) (setMCPriority t x)"
   apply (rule corres_guard_imp)
     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)+
+  by (clarsimp simp: tcb_relation_def tcb_cap_cases_tcb_mcpriority
+                     tcb_cte_cases_def cteSizeBits_def exst_same_def)+
 
 definition
  "out_rel fn fn' v v' \<equiv>
@@ -1011,15 +667,18 @@ definition
 lemma out_corresT:
   assumes x: "\<And>tcb v. \<forall>(getF, setF)\<in>ran tcb_cap_cases. getF (fn v tcb) = getF tcb"
   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)"
   shows
   "out_rel fn fn' v v' \<Longrightarrow>
      corres dc (tcb_at t and pspace_aligned and pspace_distinct)
                \<top>
        (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 add: threadset_corresT [OF _ x y])
+  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])
   done
 
 lemmas out_corres = out_corresT [OF _ all_tcbI, OF ball_tcb_cap_casesI ball_tcb_cte_casesI]
@@ -1065,13 +724,15 @@ lemma setP_invs':
 
 crunch setPriority, setMCPriority
   for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: crunch_wps)
+  (simp: crunch_simps)
+
+lemmas setPriority_typ_ats [wp] = typ_at_lifts [OF setPriority_typ_at']
+
+crunch setPriority, setMCPriority
+  for valid_cap[wp]: "valid_cap' c"
+  (wp: getObject_inv_tcb)
+
 
-global_interpretation setPriority: typ_at_all_props' "setPriority t prio"
-  by typ_at_props'
-global_interpretation setMCPriority: typ_at_all_props' "setMCPriority t prio"
-  by typ_at_props'
 definition
   newroot_rel :: "(cap \<times> cslot_ptr) option \<Rightarrow> (capability \<times> machine_word) option \<Rightarrow> bool"
 where
@@ -1091,8 +752,6 @@ termination recursive
   apply simp
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
-
 lemma cte_map_tcb_0:
   "cte_map (t, tcb_cnode_index 0) = t"
   by (simp add: cte_map_def tcb_cnode_index_def)
@@ -1116,7 +775,7 @@ lemma sameObject_corres2:
    apply (case_tac d'; simp)
   apply (rename_tac arch_cap)
   apply clarsimp
-  apply (case_tac d, (simp_all split: arch_cap.split)[13])
+  apply (case_tac d, (simp_all split: arch_cap.split)[11])
   apply (rename_tac arch_capa)
   apply (clarsimp simp add: ARM_H.sameObjectAs_def Let_def)
   apply (intro conjI impI)
@@ -1165,24 +824,32 @@ defs
 lemma checkCapAt_cteInsert_corres:
   "cap_relation new_cap newCap \<Longrightarrow>
    corres dc (einvs and cte_wp_at (\<lambda>c. c = cap.NullCap) (target, ref)
-                    and cte_at slot and K (is_cnode_or_valid_arch new_cap \<or> is_ep_cap new_cap)
-                    and K (is_pt_cap new_cap \<or> is_pd_cap new_cap \<longrightarrow> cap_asid new_cap \<noteq> None)
-                    and (\<lambda>s. is_ep_cap new_cap
-                             \<longrightarrow> cte_wp_at (\<lambda>c. c = new_cap \<or> c = cap.NullCap) src_slot s)
-                    and cte_wp_at (\<lambda>c. obj_refs c = obj_refs new_cap
-                                       \<longrightarrow> table_cap_ref c = table_cap_ref new_cap \<and>
-                                           pt_pd_asid c = pt_pd_asid new_cap) src_slot)
+               and cte_at slot and K (is_cnode_or_valid_arch new_cap
+                                        \<and> (is_pt_cap new_cap \<or> is_pd_cap new_cap
+                                               \<longrightarrow> cap_asid new_cap \<noteq> None))
+               and cte_wp_at (\<lambda>c. obj_refs c = obj_refs new_cap
+                                \<longrightarrow> table_cap_ref c = table_cap_ref new_cap \<and>
+                                    pt_pd_asid c = pt_pd_asid new_cap) src_slot)
              (invs' and cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) (cte_map (target, ref))
-                    and valid_cap' newCap)
+               and valid_cap' newCap)
      (check_cap_at new_cap src_slot
       (check_cap_at (cap.ThreadCap target) slot
        (cap_insert new_cap src_slot (target, ref))))
      (checkCapAt newCap (cte_map src_slot)
       (checkCapAt (ThreadCap target) (cte_map slot)
        (assertDerived (cte_map src_slot) newCap (cteInsert newCap (cte_map src_slot) (cte_map (target, ref))))))"
-  (is "_ \<Longrightarrow> corres _ (?pre1) (?pre2) _ _")
   apply (rule corres_guard_imp)
-    apply (rule_tac P="?pre1" and P'="?pre2" in checkCapAt_corres, assumption)
+  apply (rule_tac P="cte_wp_at (\<lambda>c. c = cap.NullCap) (target, ref) and
+                           cte_at slot and
+                           cte_wp_at (\<lambda>c. obj_refs c = obj_refs new_cap
+                                   \<longrightarrow> table_cap_ref c = table_cap_ref new_cap \<and> pt_pd_asid c = pt_pd_asid new_cap) src_slot
+                           and einvs and K (is_cnode_or_valid_arch new_cap
+                                            \<and> (is_pt_cap new_cap \<or> is_pd_cap new_cap
+                                                 \<longrightarrow> cap_asid new_cap \<noteq> None))"
+                        and
+                        P'="cte_wp_at' (\<lambda>c. cteCap c = NullCap) (cte_map (target, ref))
+                            and invs' and valid_cap' newCap"
+                       in checkCapAt_corres, assumption)
       apply (rule checkCapAt_weak_corres, simp)
       apply (unfold assertDerived_def)[1]
       apply (rule corres_stateAssert_implied [where P'=\<top>])
@@ -1208,9 +875,21 @@ lemma checkCapAt_cteInsert_corres:
       apply (clarsimp simp: cap_master_cap_simps is_cnode_or_valid_arch_def
                             is_cap_simps is_valid_vtable_root_def
                      dest!: cap_master_cap_eqDs)
-     apply (erule disjE)
-      apply (erule(1) checked_insert_is_derived)
-      apply (fastforce simp: is_derived_def is_cap_simps same_object_as_def cte_wp_at_caps_of_state)+
+     apply (erule(1) checked_insert_is_derived)
+      apply simp
+     apply simp
+    apply fastforce
+   apply (clarsimp simp: cte_wp_at_caps_of_state)
+  apply clarsimp
+  apply fastforce
+  done
+
+lemma capBadgeNone_masters:
+  "capMasterCap cap = capMasterCap cap'
+      \<Longrightarrow> (capBadge cap = None) = (capBadge cap' = None)"
+  apply (rule master_eqI)
+   apply (auto simp add: capBadge_def capMasterCap_def isCap_simps
+             split: capability.split)
   done
 
 definition
@@ -1230,6 +909,7 @@ lemmas pt_pd_asid'_simps [simp] =
 lemma checked_insert_tcb_invs'[wp]:
   "\<lbrace>invs' and cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) slot
          and valid_cap' new_cap
+         and K (capBadge new_cap = None)
          and K (slot \<in> cte_refs' (ThreadCap target) 0)
          and K (\<not> isReplyCap new_cap \<and> \<not> isIRQControlCap new_cap)\<rbrace>
      checkCapAt new_cap src_slot
@@ -1248,12 +928,13 @@ lemma checked_insert_tcb_invs'[wp]:
                         ex_cte_cap_to'_cteCap)
   apply (erule sameObjectAsE)+
   apply (clarsimp simp: badge_derived'_def)
+  apply (frule capBadgeNone_masters, simp)
   apply (rule conjI)
    apply (rule_tac x=slot' in exI)
-   apply fastforce
+   subgoal by fastforce
   apply (clarsimp simp: isCap_simps cteCaps_of_def)
   apply (erule(1) valid_irq_handlers_ctes_ofD)
-  apply (clarsimp simp: invs'_def)
+  apply (clarsimp simp: invs'_def valid_state'_def)
   done
 
 lemma checkCap_inv:
@@ -1280,8 +961,11 @@ lemma isValidVTableRootD:
   "isValidVTableRoot cap
      \<Longrightarrow> isArchObjectCap cap \<and> isPageDirectoryCap (capCap cap)
              \<and> capPDMappedASID (capCap cap) \<noteq> None"
-  by (simp add: isValidVTableRoot_def isCap_simps
-         split: capability.split_asm arch_capability.split_asm option.split_asm)
+  by (simp add: isValidVTableRoot_def
+                ARM_H.isValidVTableRoot_def
+                isCap_simps
+         split: capability.split_asm arch_capability.split_asm
+                option.split_asm)
 
 lemma assertDerived_wp:
   "\<lbrace>P and (\<lambda>s. cte_wp_at' (is_derived' (ctes_of s) slot cap o cteCap) slot s)\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow>
@@ -1308,9 +992,7 @@ lemma setMCPriority_invs':
   unfolding setMCPriority_def
   apply (rule hoare_gen_asm)
   apply (rule hoare_pre)
-  apply (wp threadSet_invs_trivial, (clarsimp simp: inQ_def)+)
-  apply (clarsimp dest!: invs_valid_release_queue' simp: valid_release_queue'_def obj_at'_def)
-  done
+  by (wp threadSet_invs_trivial, (clarsimp simp: inQ_def)+)
 
 lemma valid_tcb'_tcbMCP_update:
   "\<lbrakk>valid_tcb' tcb s \<and> f (tcbMCP tcb) \<le> maxPriority\<rbrakk> \<Longrightarrow> valid_tcb' (tcbMCP_update f tcb) s"
@@ -1332,9 +1014,9 @@ lemma setMCPriority_valid_objs'[wp]:
    apply (simp add: projectKOs)
   apply (simp add: valid_obj'_def)
   apply (subgoal_tac "tcb_at' t s")
-   apply simp
-   apply (rule valid_tcb'_tcbMCP_update)
-   apply (fastforce  simp: obj_at'_def)+
+  apply simp
+  apply (rule valid_tcb'_tcbMCP_update)
+  apply (fastforce  simp: obj_at'_def)+
   done
 
 crunch setMCPriority
@@ -1345,125 +1027,124 @@ abbreviation "valid_option_prio \<equiv> case_option True (\<lambda>(p, auth). p
 
 definition valid_tcb_invocation :: "tcbinvocation \<Rightarrow> bool" where
    "valid_tcb_invocation i \<equiv> case i of
-        ThreadControlSched _ _ _ p mcp _ \<Rightarrow> valid_option_prio p \<and> valid_option_prio mcp
+        ThreadControl _ _ _ mcp p _ _ _ \<Rightarrow> valid_option_prio p \<and> valid_option_prio mcp
       | _                           \<Rightarrow> True"
 
 lemma threadcontrol_corres_helper1:
-  "thread_set (tcb_ipc_buffer_update f) tptr \<lbrace>weak_valid_sched_action\<rbrace>"
-  by (wpsimp wp: thread_set_weak_valid_sched_action)
-
-lemma threadcontrol_corres_helper2:
-  "is_aligned a msg_align_bits \<Longrightarrow>
-   \<lbrace>invs' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' t\<rbrace>
-   threadSet (tcbIPCBuffer_update (\<lambda>_. a)) t
-   \<lbrace>\<lambda>_ s. Invariants_H.valid_queues s \<and> valid_queues' s \<and> weak_sch_act_wf (ksSchedulerAction s) s\<rbrace>"
-  by (wp threadSet_invs_trivial threadSet_sch_act
-      | strengthen  invs_valid_queues' invs_queues sch_act_wf_weak
-      | clarsimp dest!: invs_valid_release_queue' simp: inQ_def valid_release_queue'_def obj_at'_def)+
+  "\<lbrace> einvs and simple_sched_action\<rbrace>
+     thread_set (tcb_ipc_buffer_update f) a
+           \<lbrace>\<lambda>x. weak_valid_sched_action and valid_etcbs\<rbrace>"
+  apply (rule hoare_pre)
+   apply (simp add: thread_set_def set_object_def get_object_def)
+   apply wp
+  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 (erule_tac x=a in allE)+
+  apply (clarsimp simp: is_tcb_def)
+  done
+
+lemma thread_set_ipc_weak_valid_sched_action:
+  "\<lbrace> einvs and simple_sched_action\<rbrace>
+   thread_set (tcb_ipc_buffer_update f) a
+   \<lbrace>\<lambda>x. weak_valid_sched_action\<rbrace>"
+  apply (rule hoare_pre)
+   apply (simp add: thread_set_def)
+   apply (wp set_object_wp)
+  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)
+  done
 
 lemma threadcontrol_corres_helper3:
-  "\<lbrace> einvs and simple_sched_action\<rbrace>
-   check_cap_at aaa (ab, ba) (check_cap_at (cap.ThreadCap a) slot (cap_insert aaa (ab, ba) (a, tcb_cnode_index 4)))
-   \<lbrace>\<lambda>_. weak_valid_sched_action \<rbrace>"
-  apply (wp check_cap_inv | simp add:)+
-  by (clarsimp simp: weak_valid_sched_action_def get_tcb_def obj_at_def  valid_sched_def
-                     valid_sched_action_def)
+  "\<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
+          \<and> pspace_aligned s \<and> pspace_distinct s\<rbrace>"
+   apply (wpsimp
+          | strengthen valid_sched_valid_queues valid_queues_in_correct_ready_q
+                       valid_sched_weak_strg[rule_format] valid_queues_ready_qs_distinct)+
+   apply (wpsimp wp: check_cap_inv)
+  apply (fastforce simp: valid_sched_def)
+  done
 
 lemma threadcontrol_corres_helper4:
   "isArchObjectCap ac \<Longrightarrow>
-  \<lbrace>invs' and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)
-   and cte_wp_at' (\<lambda>cte. cteCap cte = capability.NullCap) (cte_map (a, tcb_cnode_index 4))
-   and valid_cap' ac \<rbrace>
+  \<lbrace>invs' and cte_wp_at' (\<lambda>cte. cteCap cte = capability.NullCap) (cte_map (a, tcb_cnode_index 4))
+         and valid_cap' ac\<rbrace>
   checkCapAt ac (cte_map (ab, ba))
     (checkCapAt (capability.ThreadCap a) (cte_map slot)
        (assertDerived (cte_map (ab, ba)) ac (cteInsert ac (cte_map (ab, ba)) (cte_map (a, tcb_cnode_index 4)))))
-  \<lbrace>\<lambda>_. Invariants_H.valid_queues and valid_queues' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)\<rbrace>"
-  apply (wpsimp | strengthen invs_valid_queues' invs_queues sch_act_wf_weak)+
-  apply (wp checkCap_inv assertDerived_wp_weak)+
-  apply (case_tac ac;
-          clarsimp simp: capBadge_def isArchObjectCap_def isNotificationCap_def isEndpointCap_def
-                         isReplyCap_def isIRQControlCap_def tcb_cnode_index_def cte_map_def cte_wp_at'_def
-                         cte_level_bits_def)
-  done
+  \<lbrace>\<lambda>_ s. sym_heap_sched_pointers s \<and> valid_sched_pointers s \<and> valid_tcbs' s\<rbrace>"
+  apply (wpsimp wp:
+         | strengthen invs_sym_heap_sched_pointers invs_valid_sched_pointers
+                      invs_valid_objs' valid_objs'_valid_tcbs')+
+  by (case_tac ac;
+      clarsimp simp: capBadge_def isCap_simps tcb_cnode_index_def cte_map_def cte_wp_at'_def
+                     cte_level_bits_def)
 
 lemma threadSet_invs_trivialT2:
-  assumes x: "\<forall>tcb. \<forall>(getF,setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
-  assumes z: "\<forall>tcb. tcbState (F tcb) = tcbState tcb"
-  assumes a: "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
-  assumes s: "\<forall>tcb. tcbSchedContext (F tcb) = tcbSchedContext tcb"
-  assumes y: "\<forall>tcb. tcbYieldTo (F tcb) = tcbYieldTo tcb"
-  assumes v: "\<forall>tcb. tcbDomain tcb \<le> maxDomain \<longrightarrow> tcbDomain (F tcb) \<le> maxDomain"
-  assumes u: "\<forall>tcb. tcbPriority tcb \<le> maxPriority \<longrightarrow> tcbPriority (F tcb) \<le> maxPriority"
-  assumes b: "\<forall>tcb. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
+  assumes
+    "\<forall>tcb. \<forall>(getF,setF) \<in> ran tcb_cte_cases. getF (F tcb) = getF tcb"
+    "\<forall>tcb. tcbState (F tcb) = tcbState tcb"
+    "\<forall>tcb. tcbBoundNotification (F tcb) = tcbBoundNotification tcb"
+    "\<forall>tcb. tcbSchedPrev (F tcb) = tcbSchedPrev tcb"
+    "\<forall>tcb. tcbSchedNext (F tcb) = tcbSchedNext tcb"
+    "\<forall>tcb. tcbQueued (F tcb) = tcbQueued tcb"
+    "\<forall>tcb. tcbDomain (F tcb) = tcbDomain tcb"
+    "\<forall>tcb. tcbPriority (F tcb) = tcbPriority tcb"
+    "\<forall>tcb. tcbDomain tcb \<le> maxDomain \<longrightarrow> tcbDomain (F tcb) \<le> maxDomain"
+    "\<forall>tcb. tcbPriority tcb \<le> maxPriority \<longrightarrow> tcbPriority (F tcb) \<le> maxPriority"
+    "\<forall>tcb. tcbMCP tcb \<le> maxPriority \<longrightarrow> tcbMCP (F tcb) \<le> maxPriority"
   shows
-  "\<lbrace>\<lambda>s. invs' s
-        \<and> (\<forall>tcb. is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits)
-        \<and> tcb_at' t s
-        \<and> (\<forall>d p. (\<exists>tcb. inQ d p tcb \<and> \<not> inQ d p (F tcb)) \<longrightarrow> t \<notin> set (ksReadyQueues s (d, p)))
-        \<and> (\<forall>ko d p. ko_at' ko t s \<and> inQ d p (F ko) \<and> \<not> inQ d p ko \<longrightarrow> t \<in> set (ksReadyQueues s (d, p)))
-        \<and> ((\<exists>tcb. tcbInReleaseQueue tcb \<and> \<not> tcbInReleaseQueue (F tcb)) \<longrightarrow> t \<notin> set (ksReleaseQueue s))
-        \<and> (\<forall>ko. ko_at' ko t s \<and> tcbInReleaseQueue (F ko) \<and> \<not> tcbInReleaseQueue ko \<longrightarrow> t \<in> set (ksReleaseQueue s))
-        \<and> ((\<exists>tcb. \<not> tcbQueued tcb \<and> tcbQueued (F tcb)) \<longrightarrow> ex_nonz_cap_to' t s)\<rbrace>
-        threadSet F t
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-proof -
-  note threadSet_sch_actT_P[where P=False, simplified]
-  have r: "\<forall>tcb. tcb_st_refs_of' (tcbState (F tcb)) = tcb_st_refs_of' (tcbState tcb) \<and>
-                 valid_tcb_state' (tcbState (F tcb)) = valid_tcb_state' (tcbState tcb)"
-    by (auto simp: z)
-  show ?thesis
-    apply (simp add: invs'_def split del: if_split)
-    apply (rule hoare_pre)
-  apply (rule hoare_gen_asm [where P="(\<forall>tcb. is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits)"])
-     apply (wp x v u b
-               threadSet_valid_pspace'T
-               threadSet_sch_actT_P[where P=False, simplified]
-               threadSet_valid_queues threadSet_valid_release_queue
-               threadSet_state_refs_of'T[where f'=id]
-               threadSet_iflive'T
-               threadSet_ifunsafe'T
-               threadSet_idle'T
-               threadSet_global_refsT
-               irqs_masked_lift
-               valid_irq_node_lift
-               valid_irq_handlers_lift''
-               threadSet_ctes_ofT
-               threadSet_not_inQ
-               threadSet_ct_idle_or_in_cur_domain'
-               threadSet_valid_dom_schedule'
-               threadSet_valid_queues' threadSet_valid_release_queue'
-               threadSet_cur
-               untyped_ranges_zero_lift
-            | clarsimp simp: r y z a s cteCaps_of_def | rule refl)+
-   apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def valid_release_queue'_def)
-   apply (clarsimp simp: cur_tcb'_def valid_irq_node'_def valid_queues'_def  o_def)
-   by (intro conjI; fastforce)
-qed
-
-lemma threadSet_valid_queues'_no_state2:
-  "\<lbrakk> \<And>tcb. tcbQueued tcb = tcbQueued (f tcb);
-     \<And>tcb. tcbState tcb = tcbState (f tcb);
-     \<And>tcb. tcbPriority tcb = tcbPriority (f tcb);
-     \<And>tcb. tcbDomain tcb = tcbDomain (f tcb) \<rbrakk>
-   \<Longrightarrow> \<lbrace>valid_queues'\<rbrace> threadSet f t \<lbrace>\<lambda>_. valid_queues'\<rbrace>"
-  apply (simp add: valid_queues'_def threadSet_def obj_at'_real_def
-              split del: if_split)
-  apply (simp only: imp_conv_disj)
-  apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
-     apply (wp setObject_ko_wp_at | simp add: objBits_simps')+
-    apply (wp getObject_tcb_wp updateObject_default_inv
-           | simp split del: if_split)+
-  apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs
-                        objBits_simps addToQs_def
-             split del: if_split cong: if_cong)
-  apply (fastforce simp: projectKOs inQ_def split: if_split_asm)
-  done
+  "\<lbrace>\<lambda>s. invs' s \<and> (\<forall>tcb. is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits)\<rbrace>
+   threadSet F t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  apply (simp add: invs'_def valid_state'_def)
+  apply (rule hoare_pre)
+   apply (rule hoare_gen_asm [where P="\<forall>tcb. is_aligned (tcbIPCBuffer (F tcb)) msg_align_bits"])
+   apply (wp threadSet_valid_pspace'T
+             threadSet_iflive'T
+             threadSet_ifunsafe'T
+             threadSet_global_refsT
+             valid_irq_node_lift
+             valid_irq_handlers_lift''
+             threadSet_ctes_ofT
+             threadSet_valid_dom_schedule'
+             untyped_ranges_zero_lift
+             sym_heap_sched_pointers_lift threadSet_valid_sched_pointers
+             threadSet_tcbSchedPrevs_of threadSet_tcbSchedNexts_of
+             threadSet_sch_actT_P[where P=False, simplified]
+             threadSet_state_refs_of'T[where f'=id]
+             threadSet_idle'T
+             threadSet_not_inQ
+             threadSet_ct_idle_or_in_cur_domain'
+             threadSet_cur
+          | clarsimp simp: assms cteCaps_of_def | rule refl)+
+  apply (clarsimp simp: o_def)
+  by (auto simp: obj_at'_def)
 
 lemma getThreadBufferSlot_dom_tcb_cte_cases:
   "\<lbrace>\<top>\<rbrace> getThreadBufferSlot a \<lbrace>\<lambda>rv s. rv \<in> (+) a ` dom tcb_cte_cases\<rbrace>"
   by (wpsimp simp: tcb_cte_cases_def getThreadBufferSlot_def locateSlot_conv cte_level_bits_def
                    tcbIPCBufferSlot_def)
 
+lemma tcb_at'_cteInsert[wp]:
+  "\<lbrace>\<lambda>s. tcb_at' (ksCurThread s) s\<rbrace> cteInsert t x y \<lbrace>\<lambda>_ s. tcb_at' (ksCurThread s) s\<rbrace>"
+  by (rule hoare_weaken_pre, wps cteInsert_ct, wp, simp)
+
+lemma tcb_at'_asUser[wp]:
+  "\<lbrace>\<lambda>s. tcb_at' (ksCurThread s) s\<rbrace> asUser a (setTCBIPCBuffer b) \<lbrace>\<lambda>_ s. tcb_at' (ksCurThread s) s\<rbrace>"
+  by (rule hoare_weaken_pre, wps asUser_typ_ats(1), wp, simp)
+
+lemma tcb_at'_threadSet[wp]:
+  "\<lbrace>\<lambda>s. tcb_at' (ksCurThread s) s\<rbrace> threadSet (tcbIPCBuffer_update (\<lambda>_. b)) a \<lbrace>\<lambda>_ s. tcb_at' (ksCurThread s) s\<rbrace>"
+  by (rule hoare_weaken_pre, wps threadSet_tcb', wp, simp)
+
 lemma cteDelete_it [wp]:
   "\<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> cteDelete slot e \<lbrace>\<lambda>_ s. P (ksIdleThread s)\<rbrace>"
   by (rule cteDelete_preservation) (wp | clarsimp)+
@@ -1476,12 +1157,489 @@ lemma valid_tcb_ipc_buffer_update:
    \<Longrightarrow> (\<forall>tcb. valid_tcb' tcb s \<longrightarrow> valid_tcb' (tcbIPCBuffer_update (\<lambda>_. buf) tcb) s)"
   by (simp add: valid_tcb'_def tcb_cte_cases_def)
 
+lemma threadSet_invs_tcbIPCBuffer_update:
+  "\<lbrace>\<lambda>s. invs' s \<and> (\<forall>tcb. is_aligned (tcbIPCBuffer (tcbIPCBuffer_update f tcb)) msg_align_bits)\<rbrace>
+   threadSet (tcbIPCBuffer_update f) t
+   \<lbrace>\<lambda>_. invs'\<rbrace>"
+  by (wp threadSet_invs_trivialT2; simp add: tcb_cte_cases_def cteSizeBits_def)
+
+lemma transferCaps_corres:
+  assumes x: "newroot_rel e e'"
+  assumes y: "newroot_rel f f'"
+  assumes z: "(case g of None \<Rightarrow> g' = None
+                       | Some (vptr, g'') \<Rightarrow> \<exists>g'''. g' = Some (vptr, g''')
+                              \<and> newroot_rel g'' g''')"
+  assumes sl: "{e, f, option_map undefined g} \<noteq> {None} \<longrightarrow> sl' = cte_map slot"
+  shows
+    "corres (dc \<oplus> (=))
+    (einvs and simple_sched_action and tcb_at a and
+     (\<lambda>s. {e, f, option_map undefined g} \<noteq> {None} \<longrightarrow> cte_at slot s) and
+     case_option \<top> (valid_cap o fst) e and
+     case_option \<top> (cte_at o snd) e and
+     case_option \<top> (no_cap_to_obj_dr_emp o fst) e and
+     K (case_option True (is_cnode_cap o fst) e) and
+     case_option \<top> (valid_cap o fst) f and
+     case_option \<top> (cte_at o snd) f and
+     case_option \<top> (no_cap_to_obj_dr_emp o fst) f and
+     K (case_option True (is_valid_vtable_root o fst) f)
+      and case_option \<top> (case_option \<top> (cte_at o snd) o snd) g
+      and case_option \<top> (case_option \<top> (no_cap_to_obj_dr_emp o fst) o snd) g
+      and case_option \<top> (case_option \<top> (valid_cap o fst) o snd) g
+      and K (case_option True ((\<lambda>v. is_aligned v msg_align_bits) o fst) g)
+      and K (case_option True (\<lambda>v. case_option True ((swp valid_ipc_buffer_cap (fst v)
+                                  and is_arch_cap and is_cnode_or_valid_arch) o fst) (snd v)) g)
+      and (\<lambda>s. case_option True (\<lambda>(pr, auth). mcpriority_tcb_at (\<lambda>m. pr \<le> m) auth s) p_auth) \<comment> \<open>only set prio \<le> mcp\<close>
+      and (\<lambda>s. case_option True (\<lambda>(mcp, auth). mcpriority_tcb_at (\<lambda>m. mcp \<le> m) auth s) mcp_auth) \<comment> \<open>only set mcp \<le> prev_mcp\<close>)
+    (invs' and sch_act_simple and case_option \<top> (valid_cap' o fst) e' and
+     (\<lambda>s. {e', f', option_map undefined g'} \<noteq> {None} \<longrightarrow> cte_at' (cte_map slot) s) and
+     K (case_option True (isCNodeCap o fst) e') and
+     case_option \<top> (valid_cap' o fst) f' and
+     K (case_option True (isValidVTableRoot o fst) f') and
+     K (case_option True ((\<lambda>v. is_aligned v msg_align_bits) o fst) g') and
+     K (case_option True (case_option True (isArchObjectCap o fst) o snd) g') and
+     case_option \<top> (case_option \<top> (valid_cap' o fst) o snd) g' and
+     tcb_at' a and ex_nonz_cap_to' a and K (valid_option_prio p_auth \<and> valid_option_prio mcp_auth) and
+     (\<lambda>s. case_option True (\<lambda>(pr, auth). mcpriority_tcb_at' ((\<le>) pr) auth s) p_auth) and
+     (\<lambda>s. case_option True (\<lambda>(m, auth). mcpriority_tcb_at' ((\<le>) m) auth s) mcp_auth))
+    (invoke_tcb (tcb_invocation.ThreadControl a slot (option_map to_bl b') mcp_auth p_auth e f g))
+    (invokeTCB (tcbinvocation.ThreadControl a sl' b' mcp_auth p_auth e' f' g'))"
+proof -
+  have P: "\<And>t v. corres dc
+               (tcb_at t and pspace_aligned and pspace_distinct)
+               \<top>
+               (option_update_thread t (tcb_fault_handler_update o (%x _. x))
+               (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 (case_tac v, simp_all add: out_rel_def)
+    apply (safe, case_tac tcb', simp add: tcb_relation_def split: option.split)
+    done
+  have R: "\<And>t v. corres dc
+               (tcb_at t and pspace_aligned and pspace_distinct)
+               \<top>
+               (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 (case_tac v, simp_all add: out_rel_def)
+    apply (safe, case_tac tcb', simp add: tcb_relation_def)
+    done
+  have S: "\<And>t x. corres dc (einvs and tcb_at t) (invs' and tcb_at' t and valid_objs' and K (valid_option_prio p_auth))
+                   (case_option (return ()) (\<lambda>(p, auth). set_priority t p) p_auth)
+                   (case_option (return ()) (\<lambda>p'. setPriority t (fst p')) p_auth)"
+    apply (case_tac p_auth; clarsimp simp: setPriority_corres)
+    done
+  have S': "\<And>t x. corres dc
+                    (tcb_at t and pspace_aligned and pspace_distinct)
+                    \<top>
+                    (case_option (return ()) (\<lambda>(mcp, auth). set_mcpriority t mcp) mcp_auth)
+                    (case_option (return ()) (\<lambda>mcp'. setMCPriority t (fst mcp')) mcp_auth)"
+    apply(case_tac mcp_auth; clarsimp simp: setMCPriority_corres)
+    done
+  have T: "\<And>x x' ref getfn target.
+      \<lbrakk> newroot_rel x x'; getfn = return (cte_map (target, ref));
+             x \<noteq> None \<longrightarrow> {e, f, option_map undefined g} \<noteq> {None} \<rbrakk> \<Longrightarrow>
+      corres (dc \<oplus> dc)
+
+             (einvs and simple_sched_action and cte_at (target, ref) and emptyable (target, ref) and
+              (\<lambda>s. \<forall>(sl, c) \<in> (case x of None \<Rightarrow> {} | Some (c, sl) \<Rightarrow> {(sl, c), (slot, c)}).
+                        cte_at sl s \<and> no_cap_to_obj_dr_emp c s \<and> valid_cap c s)
+              and K (case x of None \<Rightarrow> True
+                       | Some (c, sl) \<Rightarrow> is_cnode_or_valid_arch c))
+             (invs' and sch_act_simple and cte_at' (cte_map (target, ref)) and
+              (\<lambda>s. \<forall>cp \<in> (case x' of None \<Rightarrow> {} | Some (c, sl) \<Rightarrow> {c}). s \<turnstile>' cp))
+          (case x of None \<Rightarrow> returnOk ()
+           | Some pr \<Rightarrow> case_prod (\<lambda>new_cap src_slot.
+               doE cap_delete (target, ref);
+                   liftE $ check_cap_at new_cap src_slot $
+                           check_cap_at (cap.ThreadCap target) slot $
+                           cap_insert new_cap src_slot (target, ref)
+               odE) pr)
+          (case x' of
+              None \<Rightarrow> returnOk ()
+              | Some pr \<Rightarrow> (\<lambda>(newCap, srcSlot).
+                  do slot \<leftarrow> getfn;
+                     doE uu \<leftarrow> cteDelete slot True;
+                         liftE (checkCapAt newCap srcSlot
+                               (checkCapAt (capability.ThreadCap target) sl'
+                               (assertDerived srcSlot newCap (cteInsert newCap srcSlot slot))))
+                     odE
+                  od) pr)"
+    apply (case_tac "x = None")
+     apply (simp add: newroot_rel_def returnOk_def)
+    apply (drule(1) mp, drule mp [OF sl])
+    apply (clarsimp simp add: newroot_rel_def returnOk_def split_def)
+    apply (rule corres_gen_asm)
+    apply (rule corres_guard_imp)
+      apply (rule corres_split_norE[OF cteDelete_corres])
+        apply (simp del: dc_simp)
+        apply (erule checkCapAt_cteInsert_corres)
+       apply (fold validE_R_def)
+       apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap
+                    | strengthen use_no_cap_to_obj_asid_strg)+
+      apply (wp cteDelete_invs' cteDelete_deletes)
+     apply (clarsimp dest!: is_cnode_or_valid_arch_cap_asid)
+    apply clarsimp
+    done
+  have U2: "getThreadBufferSlot a = return (cte_map (a, tcb_cnode_index 4))"
+    by (simp add: getThreadBufferSlot_def locateSlot_conv
+                  cte_map_def tcb_cnode_index_def tcbIPCBufferSlot_def
+                  cte_level_bits_def)
+  have T2: "corres (dc \<oplus> dc)
+     (einvs and simple_sched_action and tcb_at a and
+         (\<lambda>s. \<forall>(sl, c) \<in> (case g of None \<Rightarrow> {} | Some (x, v) \<Rightarrow> {(slot, cap.NullCap)} \<union>
+             (case v of None \<Rightarrow> {} | Some (c, sl) \<Rightarrow> {(sl, c), (slot, c)})).
+                   cte_at sl s \<and> no_cap_to_obj_dr_emp c s \<and> valid_cap c s)
+         and K (case g of None \<Rightarrow> True | Some (x, v) \<Rightarrow> (case v of
+                   None \<Rightarrow> True | Some (c, sl) \<Rightarrow> is_cnode_or_valid_arch c
+                                                 \<and> is_arch_cap c
+                                                 \<and> valid_ipc_buffer_cap c x
+                                                 \<and> is_aligned x msg_align_bits)))
+     (invs' and sch_act_simple and tcb_at' a and
+       (\<lambda>s. \<forall>cp \<in> (case g' of None \<Rightarrow> {} | Some (x, v) \<Rightarrow> (case v of
+                              None \<Rightarrow> {} | Some (c, sl) \<Rightarrow> {c})). s \<turnstile>' cp) and
+       K (case g' of None \<Rightarrow> True | Some (x, v) \<Rightarrow> is_aligned x msg_align_bits
+       \<and> (case v of None \<Rightarrow> True | Some (ac, _) \<Rightarrow> isArchObjectCap ac)) )
+     (case_option (returnOk ())
+       (case_prod
+         (\<lambda>ptr frame.
+             doE cap_delete (a, tcb_cnode_index 4);
+                 do y \<leftarrow> thread_set (tcb_ipc_buffer_update (\<lambda>_. ptr)) a;
+                    y \<leftarrow> case_option (return ())
+                          (case_prod
+                          (\<lambda>new_cap src_slot.
+                            check_cap_at new_cap src_slot $
+                            check_cap_at (cap.ThreadCap a) slot $
+                            cap_insert new_cap src_slot (a, tcb_cnode_index 4)))
+                          frame;
+                    cur \<leftarrow> gets cur_thread;
+                    liftE $ when (cur = a) (reschedule_required)
+                 od
+             odE))
+       g)
+     (case_option (returnOk ())
+        (\<lambda>(ptr, frame).
+            do bufferSlot \<leftarrow> getThreadBufferSlot a;
+            doE y \<leftarrow> cteDelete bufferSlot True;
+            do y \<leftarrow> threadSet (tcbIPCBuffer_update (\<lambda>_. ptr)) a;
+               y \<leftarrow> (case_option (return ())
+                      (case_prod
+                        (\<lambda>newCap srcSlot.
+                            checkCapAt newCap srcSlot $
+                            checkCapAt
+                             (capability.ThreadCap a)
+                             sl' $
+                            assertDerived srcSlot newCap $
+                            cteInsert newCap srcSlot bufferSlot))
+                      frame);
+               cur \<leftarrow> getCurThread;
+               liftE $ when (cur = a) rescheduleRequired
+            od odE od)
+        g')" (is "corres _ ?T2_pre ?T2_pre' _ _")
+    using z sl
+    apply -
+    apply (rule corres_guard_imp[where P=P and P'=P'
+                                  and Q="P and cte_at (a, tcb_cnode_index 4)"
+                                  and Q'="P' and cte_at' (cte_map (a, cap))" for P P' a cap])
+      apply (cases g)
+       apply (simp, simp add: returnOk_def)
+      apply (clarsimp simp: liftME_def[symmetric] U2 liftE_bindE)
+      apply (case_tac b, simp_all add: newroot_rel_def)
+       apply (rule corres_guard_imp)
+         apply (rule corres_split_norE)
+            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 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)
+           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
+                            valid_sched_valid_queues invs_psp_aligned invs_distinct)+
+          apply wp
+         apply (clarsimp simp: pred_conj_def)
+         apply (strengthen invs_sym_heap_sched_pointers invs_valid_sched_pointers
+                           valid_objs'_valid_tcbs' invs_valid_objs')
+         apply (wpsimp wp: cteDelete_invs' hoare_vcg_conj_lift)
+        apply (fastforce simp: emptyable_def)
+       apply fastforce
+      apply clarsimp
+      apply (rule corres_guard_imp)
+        apply (rule corres_split_norE[OF cteDelete_corres])
+          apply (rule_tac F="is_aligned aa msg_align_bits"
+                        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 corres_split)
+               apply (erule checkCapAt_cteInsert_corres)
+              apply (rule corres_split[OF getCurThread_corres], clarsimp)
+                apply (rule corres_when[OF refl rescheduleRequired_corres])
+               apply (wp gct_wp)+
+             apply (wp hoare_drop_imp threadcontrol_corres_helper3)[1]
+            apply (wp hoare_drop_imp threadcontrol_corres_helper4)[1]
+           apply (wp thread_set_tcb_ipc_buffer_cap_cleared_invs
+                     thread_set_cte_wp_at_trivial thread_set_not_state_valid_sched
+                       | simp add: ran_tcb_cap_cases)+
+          apply (wp threadSet_invs_trivial
+                    threadSet_cte_wp_at' | simp)+
+         apply (wp cap_delete_deletes cap_delete_cte_at
+                   cap_delete_valid_cap cteDelete_deletes
+                   cteDelete_invs'
+                   | strengthen use_no_cap_to_obj_asid_strg invs_psp_aligned invs_distinct
+                   | clarsimp simp: inQ_def)+
+       apply (clarsimp simp: cte_wp_at_caps_of_state
+                      dest!: is_cnode_or_valid_arch_cap_asid)
+       apply (fastforce simp: emptyable_def)
+      apply (clarsimp simp: inQ_def)
+     apply (clarsimp simp: obj_at_def is_tcb)
+     apply (rule cte_wp_at_tcbI, simp, fastforce, simp)
+    apply (clarsimp simp: cte_map_def tcb_cnode_index_def obj_at'_def projectKOs objBits_simps)
+    apply (erule(2) cte_wp_at_tcbI', fastforce simp: objBits_defs cte_level_bits_def, simp)
+    done
+  have U: "getThreadCSpaceRoot a = return (cte_map (a, tcb_cnode_index 0))"
+    apply (clarsimp simp add: getThreadCSpaceRoot)
+    apply (simp add: cte_map_def tcb_cnode_index_def
+                     cte_level_bits_def word_bits_def)
+    done
+  have V: "getThreadVSpaceRoot a = return (cte_map (a, tcb_cnode_index 1))"
+    apply (clarsimp simp add: getThreadVSpaceRoot)
+    apply (simp add: cte_map_def tcb_cnode_index_def to_bl_1 objBits_defs
+                     cte_level_bits_def word_bits_def)
+    done
+  have X: "\<And>x P Q R M. (\<And>y. x = Some y \<Longrightarrow> \<lbrace>P y\<rbrace> M y \<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace>)
+               \<Longrightarrow> \<lbrace>case_option (Q ()) P x\<rbrace> case_option (returnOk ()) M x \<lbrace>Q\<rbrace>,\<lbrace>R\<rbrace>"
+    by (case_tac x, simp_all, wp)
+  have Y: "\<And>x P Q M. (\<And>y. x = Some y \<Longrightarrow> \<lbrace>P y\<rbrace> M y \<lbrace>Q\<rbrace>,-)
+               \<Longrightarrow> \<lbrace>case_option (Q ()) P x\<rbrace> case_option (returnOk ()) M x \<lbrace>Q\<rbrace>,-"
+    by (case_tac x, simp_all, wp)
+  have Z: "\<And>P f R Q x. \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. Q and R\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. case_option Q (\<lambda>y. R) x\<rbrace>"
+    apply (rule hoare_post_imp)
+     defer
+     apply assumption
+    apply (case_tac x, simp_all)
+    done
+  have A: "\<And>x P Q M. (\<And>y. x = Some y \<Longrightarrow> \<lbrace>P y\<rbrace> M y \<lbrace>Q\<rbrace>)
+               \<Longrightarrow> \<lbrace>case_option (Q ()) P x\<rbrace> case_option (return ()) M x \<lbrace>Q\<rbrace>"
+    by (case_tac x, simp_all, wp)
+  have B: "\<And>t v. \<lbrace>invs' and tcb_at' t\<rbrace> threadSet (tcbFaultHandler_update v) t \<lbrace>\<lambda>rv. invs'\<rbrace>"
+    by (wp threadSet_invs_trivial | clarsimp simp: inQ_def)+
+  note stuff = Z B out_invs_trivial hoare_case_option_wp
+    hoare_vcg_const_Ball_lift hoare_vcg_const_Ball_liftE_R
+    cap_delete_deletes cap_delete_valid_cap out_valid_objs
+    cap_insert_objs
+    cteDelete_deletes cteDelete_sch_act_simple
+    out_valid_cap out_cte_at out_tcb_valid out_emptyable
+    CSpaceInv_AI.cap_insert_valid_cap cap_insert_cte_at cap_delete_cte_at
+    cap_delete_tcb cteDelete_invs' checkCap_inv [where P="valid_cap' c0" for c0]
+    check_cap_inv[where P="tcb_at p0" for p0] checkCap_inv [where P="tcb_at' p0" for p0]
+    check_cap_inv[where P="cte_at p0" for p0] checkCap_inv [where P="cte_at' p0" for p0]
+    check_cap_inv[where P="valid_cap c" for c] checkCap_inv [where P="valid_cap' c" for c]
+    check_cap_inv[where P="tcb_cap_valid c p1" for c p1]
+    check_cap_inv[where P=valid_sched]
+    check_cap_inv[where P=simple_sched_action]
+    checkCap_inv [where P=sch_act_simple]
+    out_no_cap_to_trivial [OF ball_tcb_cap_casesI]
+    checked_insert_no_cap_to
+  note if_cong [cong] option.case_cong [cong]
+  \<comment> \<open>This proof is quite fragile and was written when bind_wp was added to the wp set later
+     in the theory dependencies, and so was matched with before alternatives. We re-add it here to
+     create a similar environment and avoid needing to rework the proof.\<close>
+  note bind_wp[wp]
+  show ?thesis
+    apply (simp add: invokeTCB_def liftE_bindE)
+    apply (simp only: eq_commute[where a= "a"])
+    apply (rule corres_guard_imp)
+      apply (rule corres_split_nor[OF P])
+        apply (rule corres_split_nor[OF S', simplified])
+          apply (rule corres_split_norE[OF T [OF x U], simplified])
+            apply (rule corres_split_norE[OF T [OF y V], simplified])
+              apply (rule corres_split_norE)
+                 apply (rule T2[simplified])
+                apply (rule corres_split_nor[OF S, simplified])
+                  apply (rule corres_returnOkTT, simp)
+                 apply wp
+                apply wp
+               apply (wpsimp wp: hoare_vcg_const_imp_liftE_R hoare_vcg_const_imp_lift
+                                 hoare_vcg_all_liftE_R hoare_vcg_all_lift
+                                 as_user_invs thread_set_ipc_tcb_cap_valid
+                                 thread_set_tcb_ipc_buffer_cap_cleared_invs
+                                 thread_set_cte_wp_at_trivial
+                                 thread_set_valid_cap
+                                 reschedule_preserves_valid_sched
+                                 check_cap_inv[where P=valid_sched] (* from stuff *)
+                                 check_cap_inv[where P="tcb_at p0" for p0]
+                                 thread_set_not_state_valid_sched
+                                 check_cap_inv[where P=simple_sched_action]
+                                 cap_delete_deletes hoare_drop_imps
+                                 cap_delete_valid_cap
+                           simp: ran_tcb_cap_cases
+                      | strengthen simple_sched_action_sched_act_not)+
+                apply (strengthen use_no_cap_to_obj_asid_strg)
+                apply (wpsimp wp: cap_delete_cte_at cap_delete_valid_cap)
+               apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_drop_imps hoare_vcg_all_lift
+                                 threadSet_invs_tcbIPCBuffer_update threadSet_cte_wp_at'
+                      | strengthen simple_sched_action_sched_act_not)+
+                apply ((wpsimp wp: stuff hoare_vcg_all_liftE_R hoare_vcg_all_lift
+                                   hoare_vcg_const_imp_liftE_R hoare_vcg_const_imp_lift
+                                   threadSet_valid_objs' thread_set_not_state_valid_sched
+                                   thread_set_tcb_ipc_buffer_cap_cleared_invs thread_set_cte_wp_at_trivial
+                                   thread_set_no_cap_to_trivial getThreadBufferSlot_dom_tcb_cte_cases
+                                   assertDerived_wp_weak threadSet_cap_to' out_pred_tcb_at_preserved
+                                   checkCap_wp assertDerived_wp_weak cap_insert_objs'
+                        | simp add: ran_tcb_cap_cases split_def U V
+                                  emptyable_def
+                        | strengthen tcb_cap_always_valid_strg
+                                   tcb_at_invs
+                                   use_no_cap_to_obj_asid_strg
+                        | (erule exE, clarsimp simp: word_bits_def) | wp (once) hoare_drop_imps)+)
+                apply (strengthen valid_tcb_ipc_buffer_update)
+                apply (strengthen invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct')
+                apply (wpsimp wp: cteDelete_invs' hoare_vcg_imp_lift' hoare_vcg_all_lift)
+               apply wpsimp
+              apply wpsimp
+             apply (clarsimp cong: imp_cong conj_cong simp: emptyable_def)
+             apply (rule_tac Q'="\<lambda>_. ?T2_pre" in hoare_strengthen_postE_R[simplified validE_R_def, rotated])
+              (* beginning to deal with is_nondevice_page_cap *)
+              apply (clarsimp simp: emptyable_def is_nondevice_page_cap_simps is_cap_simps
+                                    is_cnode_or_valid_arch_def obj_ref_none_no_asid cap_asid_def
+                              cong: conj_cong imp_cong
+                             split: option.split_asm)
+              (* newly added proof scripts for dealing with is_nondevice_page_cap *)
+              apply (simp add: case_bool_If valid_ipc_buffer_cap_def is_nondevice_page_cap_arch_def
+                        split: arch_cap.splits if_splits)
+             (* is_nondevice_page_cap discharged *)
+             apply ((wp stuff checkCap_wp assertDerived_wp_weak cap_insert_objs'
+                     | simp add: ran_tcb_cap_cases split_def U V emptyable_def
+                     | wpc | strengthen tcb_cap_always_valid_strg use_no_cap_to_obj_asid_strg)+)[1]
+            apply (clarsimp cong: imp_cong conj_cong)
+            apply (rule_tac Q'="\<lambda>_. ?T2_pre' and (\<lambda>s. valid_option_prio p_auth)"
+                         in hoare_strengthen_postE_R[simplified validE_R_def, rotated])
+             apply (case_tac g'; clarsimp simp: isCap_simps ; clarsimp elim: invs_valid_objs' cong:imp_cong)
+            apply (wp add: stuff hoare_vcg_all_liftE_R hoare_vcg_all_lift
+                                 hoare_vcg_const_imp_liftE_R hoare_vcg_const_imp_lift setMCPriority_invs'
+                                 threadSet_valid_objs' thread_set_not_state_valid_sched setP_invs'
+                                 typ_at_lifts [OF setPriority_typ_at']
+                                 typ_at_lifts [OF setMCPriority_typ_at']
+                                 threadSet_cap_to' out_pred_tcb_at_preserved assertDerived_wp
+                      del: cteInsert_invs
+                   | simp add: ran_tcb_cap_cases split_def U V
+                               emptyable_def
+                   | wpc | strengthen tcb_cap_always_valid_strg
+                                      use_no_cap_to_obj_asid_strg invs_psp_aligned invs_distinct
+                   | wp add: sch_act_simple_lift hoare_drop_imps del: cteInsert_invs
+                   | (erule exE, clarsimp simp: word_bits_def))+
+     (* the last two subgoals *)
+     apply (clarsimp simp: tcb_at_cte_at_0 tcb_at_cte_at_1[simplified] tcb_at_st_tcb_at[symmetric]
+                           tcb_cap_valid_def is_cnode_or_valid_arch_def invs_valid_objs emptyable_def
+                           obj_ref_none_no_asid no_cap_to_obj_with_diff_ref_Null is_valid_vtable_root_def
+                           is_cap_simps cap_asid_def vs_cap_ref_def arch_cap_fun_lift_def
+                     cong: conj_cong imp_cong
+                    split: option.split_asm)
+    by (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def objBits_defs
+                       cte_map_tcb_0 cte_map_tcb_1[simplified] tcb_at_cte_at' cte_at_tcb_at_16'
+                       isCap_simps domIff valid_tcb'_def tcb_cte_cases_def
+                split: option.split_asm
+                dest!: isValidVTableRootD)
+qed
+
+lemma isReplyCapD:
+  "isReplyCap cap \<Longrightarrow> \<exists>ptr master grant. cap = capability.ReplyCap ptr master grant"
+  by (simp add: isCap_simps)
+
+lemmas threadSet_ipcbuffer_trivial
+    = threadSet_invs_trivial[where F="tcbIPCBuffer_update F'" for F',
+                              simplified inQ_def, simplified]
+
+crunch setPriority, setMCPriority
+  for cap_to'[wp]: "ex_nonz_cap_to' a"
+  (simp: crunch_simps)
+
+lemma cteInsert_sa_simple[wp]:
+  "\<lbrace>sch_act_simple\<rbrace> cteInsert newCap srcSlot destSlot \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
+  by (simp add: sch_act_simple_def, wp)
+
+lemma tc_invs':
+  "\<lbrace>invs' and sch_act_simple and tcb_at' a and ex_nonz_cap_to' a and
+    K (valid_option_prio d \<and> valid_option_prio mcp) and
+    case_option \<top> (valid_cap' o fst) e' and
+    K (case_option True (isCNodeCap o fst) e') and
+    case_option \<top> (valid_cap' o fst) f' and
+    K (case_option True (isValidVTableRoot o fst) f') and
+    case_option \<top> (valid_cap') (case_option None (case_option None (Some o fst) o snd) g) and
+    K (case_option True isArchObjectCap (case_option None (case_option None (Some o fst) o snd) g))
+    and K (case_option True (swp is_aligned msg_align_bits o fst) g) \<rbrace>
+      invokeTCB (tcbinvocation.ThreadControl a sl b' mcp d e' f' g)
+   \<lbrace>\<lambda>rv. invs'\<rbrace>" (is "\<lbrace>?PRE\<rbrace> _ \<lbrace>_\<rbrace>")
+  apply (rule hoare_gen_asm)
+  apply (simp add: split_def invokeTCB_def getThreadCSpaceRoot getThreadVSpaceRoot
+                   getThreadBufferSlot_def locateSlot_conv
+             cong: option.case_cong)
+  apply (simp only: eq_commute[where a="a"])
+  apply (rule hoare_walk_assmsE)
+    apply (clarsimp simp: pred_conj_def option.splits [where P="\<lambda>x. x s" for s])
+    apply ((wp case_option_wp threadSet_invs_trivial hoare_weak_lift_imp
+               hoare_vcg_all_lift threadSet_cap_to' | clarsimp simp: inQ_def)+)[2]
+  apply (rule hoare_walk_assmsE)
+    apply (clarsimp simp: pred_conj_def option.splits [where P="\<lambda>x. x s" for s])
+    apply ((wp case_option_wp threadSet_invs_trivial hoare_weak_lift_imp setMCPriority_invs'
+               typ_at_lifts[OF setMCPriority_typ_at']
+               hoare_vcg_all_lift threadSet_cap_to' | clarsimp simp: inQ_def)+)[2]
+  apply (wp add: setP_invs' hoare_weak_lift_imp hoare_vcg_all_lift)+
+      apply (rule case_option_wp_None_return[OF setP_invs'[simplified pred_conj_assoc]])
+      apply clarsimp
+      apply wpfix
+      apply assumption
+     apply (rule case_option_wp_None_returnOk)
+      apply (wpsimp wp: hoare_weak_lift_imp hoare_vcg_all_lift
+                        checkCap_inv[where P="tcb_at' t" for t] assertDerived_wp_weak
+                        threadSet_invs_trivial2 threadSet_tcb'  hoare_vcg_all_lift threadSet_cte_wp_at')+
+       apply (wpsimp wp: hoare_weak_lift_impE_R cteDelete_deletes
+                         hoare_vcg_all_liftE_R hoare_vcg_conj_liftE1 hoare_vcg_const_imp_liftE_R hoare_vcg_propE_R
+                         cteDelete_invs' cteDelete_invs' cteDelete_typ_at'_lifts)+
+     apply (assumption | clarsimp cong: conj_cong imp_cong | (rule case_option_wp_None_returnOk)
+            | wpsimp wp: hoare_weak_lift_imp hoare_vcg_all_lift checkCap_inv[where P="tcb_at' t" for t] assertDerived_wp_weak
+                         hoare_vcg_imp_lift' hoare_vcg_all_lift checkCap_inv[where P="tcb_at' t" for t]
+                         checkCap_inv[where P="valid_cap' c" for c] checkCap_inv[where P=sch_act_simple]
+                         hoare_vcg_const_imp_liftE_R assertDerived_wp_weak hoare_weak_lift_impE_R cteDelete_deletes
+                         hoare_vcg_all_liftE_R hoare_vcg_conj_liftE1 hoare_vcg_const_imp_liftE_R hoare_vcg_propE_R
+                         cteDelete_invs' cteDelete_typ_at'_lifts cteDelete_sch_act_simple)+
+  apply (clarsimp simp: tcb_cte_cases_def cte_level_bits_def objBits_defs tcbIPCBufferSlot_def)
+  by (auto dest!: isCapDs isReplyCapD isValidVTableRootD simp: isCap_simps)
+
+lemma setSchedulerAction_invs'[wp]:
+  "\<lbrace>invs' and sch_act_wf sa
+          and (\<lambda>s. sa = ResumeCurrentThread
+                     \<longrightarrow> obj_at' (Not \<circ> tcbQueued) (ksCurThread s) s)
+          and (\<lambda>s. sa = ResumeCurrentThread
+          \<longrightarrow> ksCurThread s = ksIdleThread s \<or> tcb_in_cur_domain' (ksCurThread s) s)\<rbrace>
+    setSchedulerAction sa
+   \<lbrace>\<lambda>rv. invs'\<rbrace>"
+  apply (simp add: setSchedulerAction_def)
+  apply wp
+  apply (clarsimp simp add: invs'_def valid_state'_def valid_irq_node'_def
+                valid_queues_def bitmapQ_defs cur_tcb'_def
+                ct_not_inQ_def)
+  apply (simp add: ct_idle_or_in_cur_domain'_def)
+  done
+
 end
 
 consts
   copyregsets_map :: "arch_copy_register_sets \<Rightarrow> Arch.copy_register_sets"
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 primrec
   tcbinv_relation :: "tcb_invocation \<Rightarrow> tcbinvocation \<Rightarrow> bool"
@@ -1492,18 +1650,15 @@ where
     = (x = tcbinvocation.WriteRegisters a b c (copyregsets_map d))"
 | "tcbinv_relation (tcb_invocation.CopyRegisters a b c d e f g) x
     = (x = tcbinvocation.CopyRegisters a b c d e f (copyregsets_map g))"
-| "tcbinv_relation (tcb_invocation.ThreadControlCaps t slot fault_h time_h croot vroot ipcb) x
-   = (\<exists>sl' fault_h' time_h' croot' vroot' ipcb'.
-        ({fault_h, time_h, croot, vroot, option_map undefined ipcb} \<noteq> {None} \<longrightarrow> sl' = cte_map slot) \<and>
-        newroot_rel fault_h fault_h' \<and> newroot_rel time_h time_h' \<and>
-        newroot_rel croot croot' \<and> newroot_rel vroot vroot' \<and>
-        (case ipcb of None \<Rightarrow> ipcb' = None
-                    | Some (vptr, g'') \<Rightarrow> \<exists>g'''. ipcb' = Some (vptr, g''') \<and> newroot_rel g'' g''') \<and>
-        (x = tcbinvocation.ThreadControlCaps t sl' fault_h' time_h' croot' vroot' ipcb'))"
-| "tcbinv_relation (tcb_invocation.ThreadControlSched t sl sc_fault_h mcp prio sc_opt) x
-    = (\<exists>sl' sc_fault_h'.
-         newroot_rel sc_fault_h sc_fault_h'\<and> (sc_fault_h \<noteq> None \<longrightarrow> sl' = cte_map sl) \<and>
-         x = tcbinvocation.ThreadControlSched t sl' sc_fault_h' mcp prio sc_opt)"
+| "tcbinv_relation (tcb_invocation.ThreadControl a sl flt_ep mcp prio croot vroot buf) x
+    = (\<exists>flt_ep' croot' vroot' sl' buf'. flt_ep = option_map to_bl flt_ep' \<and>
+                        newroot_rel croot croot' \<and> newroot_rel vroot vroot' \<and>
+                        ({croot, vroot, option_map undefined buf} \<noteq> {None}
+                           \<longrightarrow> sl' = cte_map sl) \<and>
+                        (case buf of None \<Rightarrow> buf' = None
+                          | Some (vptr, g'') \<Rightarrow> \<exists>g'''. buf' = Some (vptr, g''')
+                               \<and> newroot_rel g'' g''') \<and>
+       x = tcbinvocation.ThreadControl a sl' flt_ep' mcp prio croot' vroot' buf')"
 | "tcbinv_relation (tcb_invocation.Suspend a) x
     = (x = tcbinvocation.Suspend a)"
 | "tcbinv_relation (tcb_invocation.Resume a) x
@@ -1520,30 +1675,21 @@ where
              = (tcb_at' t and ex_nonz_cap_to' t)"
 | "tcb_inv_wf' (tcbinvocation.Resume t)
              = (tcb_at' t and ex_nonz_cap_to' t)"
-| "tcb_inv_wf' (tcbinvocation.ThreadControlCaps t slot fault_h time_h croot vroot ipcb)
-             = (tcb_at' t and ex_nonz_cap_to' t and
-                case_option \<top> (valid_cap' o fst) fault_h and
-                case_option \<top> (valid_cap' o fst) time_h and
-                case_option \<top> (valid_cap' o fst) croot and
-                K (case_option True (isCNodeCap o fst) croot) and
-                case_option \<top> (valid_cap' o fst) vroot and
-                K (case_option True (isValidVTableRoot o fst) vroot) and
-                K (case_option True (isValidFaultHandler o fst) fault_h) and
-                K (case_option True (isValidFaultHandler o fst) time_h) and
-                K (case_option True ((\<lambda>v. is_aligned v msg_align_bits) o fst) ipcb) and
-                K (case_option True (case_option True (isArchObjectCap o fst) o snd) ipcb) and
-                case_option \<top> (case_option \<top> (valid_cap' o fst) o snd) ipcb and
-                (\<lambda>s. {fault_h, time_h, croot, vroot, option_map undefined ipcb} \<noteq> {None} \<longrightarrow>
-                     cte_at' slot s))"
-| "tcb_inv_wf' (tcbinvocation.ThreadControlSched t slot sc_fault_h mcp_auth p_auth sc_opt)
+| "tcb_inv_wf' (tcbinvocation.ThreadControl t sl fe mcp p croot vroot buf)
              = (tcb_at' t and ex_nonz_cap_to' t and
-                case_option \<top> (valid_cap' o fst) sc_fault_h and
-                K (case_option True (isValidFaultHandler o fst) sc_fault_h) and
-                (\<lambda>s. sc_fault_h \<noteq> None \<longrightarrow> cte_at' slot s) and
-                K (valid_option_prio p_auth \<and> valid_option_prio mcp_auth) and
-                (\<lambda>s. case_option True (\<lambda>(pr, auth). mcpriority_tcb_at' ((\<le>) pr) auth s) p_auth) and
-                (\<lambda>s. case_option True (\<lambda>(m, auth). mcpriority_tcb_at' ((\<le>) m) auth s) mcp_auth) and
-                case_option \<top> (\<lambda>sc_opt'. case_option \<top> (\<lambda>p. sc_at' p and ex_nonz_cap_to' p) sc_opt') sc_opt)"
+               K (valid_option_prio p \<and> valid_option_prio mcp) and
+               case_option \<top> (valid_cap' o fst) croot and
+               K (case_option True (isCNodeCap o fst) croot) and
+               case_option \<top> (valid_cap' o fst) vroot and
+               K (case_option True (isValidVTableRoot o fst) vroot) and
+               case_option \<top> (case_option \<top> (valid_cap' o fst) o snd) buf and
+               case_option \<top> (case_option \<top> (cte_at' o snd) o snd) buf and
+               K (case_option True (swp is_aligned msg_align_bits o fst) buf) and
+               K (case_option True (case_option True (isArchObjectCap o fst) o snd) buf) and
+               (\<lambda>s. {croot, vroot, option_map undefined buf} \<noteq> {None}
+                     \<longrightarrow> cte_at' sl s) and
+               (\<lambda>s. case_option True (\<lambda>(pr, auth). mcpriority_tcb_at' ((\<le>) pr) auth s) p) and
+               (\<lambda>s. case_option True (\<lambda>(m, auth). mcpriority_tcb_at' ((\<le>) m) auth s) mcp))"
 | "tcb_inv_wf' (tcbinvocation.ReadRegisters src susp n arch)
              = (tcb_at' src and ex_nonz_cap_to' src)"
 | "tcb_inv_wf' (tcbinvocation.WriteRegisters dest resume values arch)
@@ -1561,961 +1707,50 @@ where
 | "tcb_inv_wf' (tcbinvocation.SetTLSBase ref w)
              = (tcb_at' ref and ex_nonz_cap_to' ref)"
 
-lemma installTCBCap_corres_helper:
-  "n \<in> {0,1,3,4} \<Longrightarrow>
-   (if n = 0 then withoutPreemption $ getThreadCSpaceRoot target
-    else if n = 1 then withoutPreemption $ getThreadVSpaceRoot target
-         else if n = 3 then withoutPreemption $ getThreadFaultHandlerSlot target
-               else if n = 4 then withoutPreemption $ getThreadTimeoutHandlerSlot target
-                    else haskell_fail []) = returnOk (cte_map (target, tcb_cnode_index n))"
-  by (auto simp: getThreadFaultHandlerSlot_def getThreadVSpaceRoot_def getThreadCSpaceRoot_def
-                 getThreadTimeoutHandlerSlot_def locateSlotTCB_def locateSlot_conv returnOk_def
-                 return_def liftE_def bind_def tcbFaultHandlerSlot_def tcbTimeoutHandlerSlot_def
-                 tcbCTableSlot_def tcbVTableSlot_def tcb_cnode_index_def cte_map_def to_bl_def)
-
-lemma installTCBCap_corres:
-  "\<lbrakk> newroot_rel slot_opt slot_opt'; slot_opt \<noteq> None \<longrightarrow> slot' = cte_map slot; n \<in> {0,1,3,4} \<rbrakk> \<Longrightarrow>
-     corres (dc \<oplus> dc)
-            (\<lambda>s. einvs s \<and> valid_machine_time s \<and> simple_sched_action s
-                 \<and> cte_at (target, tcb_cnode_index n) s \<and> current_time_bounded s \<and>
-                 (\<forall>new_cap src_slot.
-                   slot_opt = Some (new_cap, src_slot) \<longrightarrow>
-                   (is_cnode_or_valid_arch new_cap \<or> valid_fault_handler new_cap) \<and>
-                   (new_cap \<noteq> cap.NullCap \<longrightarrow>
-                     s \<turnstile> new_cap \<and>
-                     (is_ep_cap new_cap \<and> (target,tcb_cnode_index n) \<noteq> src_slot \<longrightarrow>
-                        cte_wp_at valid_fault_handler (target, tcb_cnode_index n) s \<and>
-                        cte_wp_at ((=) new_cap) src_slot s) \<and>
-                     no_cap_to_obj_dr_emp new_cap s \<and>
-                     cte_at src_slot s \<and> cte_at slot s)))
-            (\<lambda>s. invs' s \<and> sch_act_simple s \<and> cte_at' (cte_map (target, tcb_cnode_index n)) s \<and>
-                 (\<forall>newCap srcSlot.
-                   slot_opt' = Some (newCap, srcSlot) \<longrightarrow>
-                   newCap \<noteq> NullCap \<longrightarrow>
-                     valid_cap' newCap s))
-            (install_tcb_cap target slot n slot_opt)
-            (installTCBCap target slot' n slot_opt')"
-  apply (simp only: install_tcb_cap_def installTCBCap_def
-                    installTCBCap_corres_helper unlessE_whenE)
-  apply (case_tac slot_opt; clarsimp simp: newroot_rel_def corres_returnOk)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_norE)
-       apply (rule cteDelete_corres)
-      apply (rule corres_whenE)
-        apply fastforce
-       apply clarsimp
-       apply (rule checkCapAt_cteInsert_corres)
-       apply simp
-      apply simp
-     apply ((wp cap_delete_valid_sched cap_delete_deletes_fh cap_delete_deletes cap_delete_cte_at
-                cap_delete_valid_cap cteDelete_invs' cteDelete_deletes hoare_vcg_const_imp_liftE_R
-             | strengthen use_no_cap_to_obj_asid_strg)+)
-   apply (fastforce simp: is_cap_simps valid_fault_handler_def
-                          is_cnode_or_valid_arch_def cte_wp_at_def)+
-  done
-
-lemma installTCBCap_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> (\<forall>newCap srcSlot. slot_opt = Some (newCap,srcSlot) \<longrightarrow>
-                                      sch_act_simple s \<and> valid_cap' newCap s \<and>
-                                      \<not> isReplyCap newCap \<and> \<not> isIRQControlCap newCap)\<rbrace>
-   installTCBCap target slot n slot_opt
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (simp only: installTCBCap_def tcbCTableSlot_def tcbVTableSlot_def tcbFaultHandlerSlot_def
-                    getThreadCSpaceRoot_def getThreadVSpaceRoot_def getThreadFaultHandlerSlot_def)
-  apply (wpsimp split_del: if_split
-                       wp: checked_insert_tcb_invs cteDelete_invs'
-                           cteDelete_deletes hoare_vcg_const_imp_liftE_R hoare_vcg_if_lift_ER
-                     simp: locateSlotBasic_def maybe_def returnOk_bindE
-                           getThreadTimeoutHandlerSlot_def locateSlotTCB_def)+
-  apply (auto simp: objBits_def objBitsKO_def cteSizeBits_def tcbTimeoutHandlerSlot_def)
-  done
-
-lemma installThreadBuffer_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> (\<forall>newCap srcSlot. slot_opt = Some (newCap,srcSlot) \<longrightarrow>
-                                     sch_act_simple s \<and> tcb_at' target s \<and>
-                                     is_aligned newCap msg_align_bits \<and>
-                                     (\<forall>x. (\<exists>y. srcSlot = Some (x, y)) \<longrightarrow>
-                                          valid_cap' x s \<and> capBadge x = None \<and>
-                                          \<not> isReplyCap x \<and> \<not> isIRQControlCap x))\<rbrace>
-   installThreadBuffer target slot slot_opt
-   \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  unfolding installThreadBuffer_def maybe_def returnOk_bindE
-  apply (wpsimp wp: hoare_weak_lift_imp hoare_vcg_all_lift threadSet_invs_trivial2)
-     apply (wpsimp wp: threadSet_cte_wp_at'T)
-      apply (clarsimp simp: tcbIPCBuffer_update_def)
-      apply (case_tac tcb; fastforce simp: tcb_cte_cases_def)
-     apply wpsimp+
-    apply (wpsimp wp: cteDelete_invs' cteDelete_deletes getThreadBufferSlot_inv
-                      getThreadBufferSlot_dom_tcb_cte_cases hoare_vcg_const_imp_liftE_R
-                      hoare_vcg_all_liftE_R hoare_vcg_imp_lift hoare_vcg_all_lift)+
-  done
-
-crunch installTCBCap
-  for tcb_at'[wp]: "tcb_at' a"
-  and cte_at'[wp]: "cte_at' p"
-  (wp: crunch_wps checkCap_inv assertDerived_wp_weak simp: crunch_simps)
-
-lemma installTCBCap_valid_cap'[wp]:
-  "installTCBCap pa pb pc pd \<lbrace>valid_cap' c\<rbrace>"
-  unfolding getThreadTimeoutHandlerSlot_def getThreadFaultHandlerSlot_def
-            getThreadVSpaceRoot_def getThreadCSpaceRoot_def installTCBCap_def
-  by (wpsimp wp: checkCap_inv crunch_wps assertDerived_wp_weak | intro conjI)+
-
-lemma cteInsert_sa_simple[wp]:
-  "cteInsert newCap srcSlot destSlot \<lbrace>sch_act_simple\<rbrace>"
-  by (simp add: sch_act_simple_def, wp)
-
-lemma installTCBCap_sch_act_simple:
-  "\<lbrace>invs' and sch_act_simple and tcb_at' a\<rbrace>
-    installTCBCap a sl n sl_opt
-   \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
-  unfolding getThreadTimeoutHandlerSlot_def getThreadFaultHandlerSlot_def
-            getThreadVSpaceRoot_def getThreadCSpaceRoot_def installTCBCap_def
-  by (wpsimp wp: checkCap_inv assertDerived_wp_weak cteDelete_sch_act_simple | rule conjI)+
-
-lemma is_aligned_tcb_ipc_buffer_update:
-  "is_aligned aa msg_align_bits \<longrightarrow>
-   valid_tcb a tcb s \<longrightarrow> valid_tcb a (tcb\<lparr>tcb_ipc_buffer := aa\<rparr>) s"
-  by (clarsimp simp: valid_tcb_def ran_tcb_cap_cases valid_ipc_buffer_cap_def
-              split: cap.splits arch_cap.splits bool.splits)
-
-lemma is_aligned_tcbIPCBuffer_update:
-  "is_aligned aa msg_align_bits \<longrightarrow>
-   valid_tcb' tcb s \<longrightarrow> valid_tcb' (tcbIPCBuffer_update (\<lambda>_. aa) tcb) s"
-  by (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
-
-lemma checkCap_inv2:
-  assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
-  shows      "\<lbrace>P and Q ()\<rbrace> checkCapAt cap slot f \<lbrace>Q\<rbrace>"
-  unfolding checkCapAt_def
-  by (wp x getCTE_wp', clarsimp)
-
-crunch cteInsert
-  for valid_release_queue[wp]: "valid_release_queue"
-  and valid_release_queue'[wp]: "valid_release_queue'"
-  and valid_queues'[wp]: "valid_queues'"
-  (wp: crunch_wps simp: crunch_simps)
-
-lemma installThreadBuffer_corres_helper:
-  "getThreadBufferSlot a = return (cte_map (a, tcb_cnode_index 2))"
-  by (simp add: getThreadBufferSlot_def locateSlot_conv cte_map_def
-                cte_level_bits_def tcb_cnode_index_def tcbIPCBufferSlot_def)
-
-lemma installThreadBuffer_corres:
-  assumes "case_option (g' = None) (\<lambda>(vptr,g''). \<exists>g'''. g' = Some (vptr, g''') \<and> newroot_rel g'' g''') g"
-  and     "g \<noteq> None \<longrightarrow> sl' = cte_map slot"
-  shows "corres (dc \<oplus> dc)
-         (einvs and valid_machine_time and simple_sched_action and tcb_at a
-                and (case_option \<top> (\<lambda>(_,sl). cte_at slot and current_time_bounded and
-                        (case_option \<top> (\<lambda>(newCap,srcSlot). cte_at srcSlot and valid_cap newCap and
-                                                            no_cap_to_obj_dr_emp newCap) sl)) g)
-                and K (case_option True (\<lambda>(x,v).
-                           case_option True (\<lambda>(c,sl). is_cnode_or_valid_arch c \<and> is_arch_cap c \<and>
-                                                      is_aligned x msg_align_bits \<and>
-                                                      valid_ipc_buffer_cap c x) v) g))
-         (invs' and sch_act_simple and tcb_at' a
-                and (case_option \<top> (\<lambda>(_,sl).
-                         (case_option \<top> (\<lambda>(newCap,srcSlot). valid_cap' newCap) sl)) g')
-                and K (case_option True (\<lambda>(x, v). is_aligned x msg_align_bits \<and>
-                           (case_option True (\<lambda>(ac, _). isArchObjectCap ac) v)) g'))
-         (install_tcb_frame_cap a slot g)
-         (installThreadBuffer a sl' g')"
-  using assms
-  apply -
-  apply (simp only: install_tcb_frame_cap_def installThreadBuffer_def K_def)
-  apply (rule corres_gen_asm2)
-  apply (rule corres_guard_imp[where P=P and P'=P' and Q="P and cte_at (a, tcb_cnode_index 2)"
-                                         and Q'="P' and cte_at' (cte_map (a, cap))" for P P' a cap])
-    apply (cases g, simp add: returnOk_def)
-    apply (clarsimp simp: installThreadBuffer_corres_helper bind_liftE_distrib liftE_bindE)
-    apply (rule corres_guard_imp)
-      apply (rule corres_split_norE)
-         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)
-          apply (rule corres_split_nor)
-             apply (simp only: case_option_If2)
-             apply (rule corres_if3)
-               apply (clarsimp simp: newroot_rel_def split: if_splits)
-              apply (clarsimp simp: newroot_rel_def)
-              apply wpfix
-              apply (erule checkCapAt_cteInsert_corres)
-             apply (rule_tac P=\<top> and P'=\<top> in corres_inst, clarsimp)
-            apply (rule corres_split[OF getCurThread_corres], clarsimp)
-              apply (rule corres_when[OF refl rescheduleRequired_corres])
-             apply (rule_tac Q'="\<lambda>_. valid_objs and weak_valid_sched_action
-                                    and active_scs_valid and pspace_aligned and pspace_distinct"
-                          in hoare_strengthen_post[rotated], fastforce)
-             apply wp
-            apply (rule_tac Q'="\<lambda>_. valid_objs' and valid_release_queue_iff
-                                               and valid_queues and valid_queues'"
-                         in hoare_strengthen_post[rotated], fastforce)
-            apply wp
-           apply (wpsimp wp: check_cap_inv2 cap_insert_ct)
-          apply (wpsimp wp: checkCap_inv2 assertDerived_wp_weak)
-         apply (clarsimp simp: option.case_eq_if if_fun_split)
-         apply (wpsimp simp: ran_tcb_cap_cases
-                         wp: hoare_vcg_all_lift hoare_vcg_const_imp_lift
-                             thread_set_tcb_ipc_buffer_cap_cleared_invs
-                             thread_set_not_state_valid_sched thread_set_valid_objs'
-                             thread_set_cte_wp_at_trivial thread_set_ipc_tcb_cap_valid)
-        apply (clarsimp simp: option.case_eq_if if_fun_split)
-        apply (wpsimp wp: hoare_vcg_const_imp_lift hoare_vcg_all_lift threadSet_invs_trivial
-                          threadSet_cte_wp_at' threadSet_valid_objs' threadSet_valid_release_queue
-                          threadSet_valid_release_queue' threadSet_valid_queues threadSet_valid_queues')
-       apply ((wp cap_delete_deletes cap_delete_valid_sched cap_delete_cte_at cap_delete_deletes_fh
-                  hoare_vcg_const_imp_liftE_R hoare_vcg_all_liftE_R hoare_vcg_disj_lift_R
-               | strengthen use_no_cap_to_obj_asid_strg is_aligned_tcb_ipc_buffer_update invs_valid_objs2
-                            invs_psp_aligned_strg invs_distinct[atomized] valid_sched_weak_strg
-                            valid_sched_active_scs_valid)+)[1]
-      apply (rule_tac Q'="\<lambda>_ s. invs' s \<and> tcb_at' a s \<and>
-                               (g''' \<noteq> None \<longrightarrow> valid_cap' (fst (the g''')) s) \<and>
-                               cte_wp_at' (\<lambda>a. cteCap a = capability.NullCap)
-                                          (cte_map (a, tcb_cnode_index 2)) s"
-                   in hoare_strengthen_postE[rotated])
-        apply (clarsimp simp: valid_pspace'_def is_aligned_tcbIPCBuffer_update
-                              valid_release_queue_def valid_release_queue'_def obj_at'_def invs'_def)
-       apply assumption
-      apply (wp cteDelete_invs' cteDelete_deletes hoare_vcg_const_imp_liftE_R)
-     apply (fastforce simp: tcb_ep_slot_cte_wp_ats cte_wp_at_caps_of_state
-                            valid_fault_handler_def is_cap_simps valid_ipc_buffer_cap_def
-                      dest: is_cnode_or_valid_arch_cap_asid
-                     split: arch_cap.splits bool.splits option.splits)
-    apply (fastforce split: option.splits)
-   apply (fastforce simp: obj_at_def is_tcb intro: cte_wp_at_tcbI)
-  apply (fastforce simp: cte_map_def tcb_cnode_index_def obj_at'_def
-                         projectKOs cte_level_bits_def objBits_simps cte_wp_at_tcbI')
-  done
-
-lemma tcb_at_cte_at'_0: "tcb_at' a s \<Longrightarrow> cte_at' (cte_map (a, tcb_cnode_index 0)) s"
-  apply (clarsimp simp: obj_at'_def projectKO_def fail_def return_def projectKO_tcb oassert_opt_def
-                 split: option.splits)
-  apply (rule_tac ptr'=a in cte_wp_at_tcbI'; simp add: objBitsKO_def)
-  apply (simp add: cte_map_def tcb_cnode_index_def cte_level_bits_def)
-  done
-
-lemma tcb_at_cte_at'_1: "tcb_at' a s \<Longrightarrow> cte_at' (cte_map (a, tcb_cnode_index (Suc 0))) s"
-  apply (clarsimp simp: obj_at'_def projectKO_def fail_def return_def projectKO_tcb oassert_opt_def
-                 split: option.splits)
-  apply (rule_tac ptr'=a in cte_wp_at_tcbI'; simp add: objBitsKO_def)
-  apply (simp add: cte_map_def tcb_cnode_index_def cte_level_bits_def of_bl_def)
-  done
-
-lemma tcb_at_cte_at'_3: "tcb_at' a s \<Longrightarrow> cte_at' (cte_map (a, tcb_cnode_index 3)) s"
-  apply (clarsimp simp: obj_at'_def projectKO_def fail_def return_def projectKO_tcb oassert_opt_def
-                 split: option.splits)
-  apply (rule_tac ptr'=a in cte_wp_at_tcbI'; simp add: objBitsKO_def)
-  apply (simp add: cte_map_def tcb_cnode_index_def cte_level_bits_def)
-  done
-
-lemma tcb_at_cte_at'_4: "tcb_at' a s \<Longrightarrow> cte_at' (cte_map (a, tcb_cnode_index 4)) s"
-  apply (clarsimp simp: obj_at'_def projectKO_def fail_def return_def projectKO_tcb oassert_opt_def
-                 split: option.splits)
-  apply (rule_tac ptr'=a in cte_wp_at_tcbI'; simp add: objBitsKO_def)
-  apply (simp add: cte_map_def tcb_cnode_index_def cte_level_bits_def)
-  done
-
-lemma tc_corres_caps:
-  fixes t slot fault_h time_h croot vroot ipcb sl' fault_h' time_h' croot' vroot' ipcb'
-  defines "tc_caps_inv \<equiv> tcb_invocation.ThreadControlCaps t slot fault_h time_h croot vroot ipcb"
-  defines "tc_caps_inv' \<equiv> tcbinvocation.ThreadControlCaps t sl' fault_h' time_h' croot' vroot' ipcb'"
-  assumes "tcbinv_relation tc_caps_inv tc_caps_inv'"
-  defines "valid_tcap c \<equiv> case_option \<top> (valid_cap o fst) c and
-                          case_option \<top> (real_cte_at o snd) c and
-                          case_option \<top> (no_cap_to_obj_dr_emp o fst) c"
-  shows
-    "corres (dc \<oplus> (=))
-    (einvs and valid_machine_time and simple_sched_action and active_scs_valid
-     and tcb_at t and tcb_inv_wf tc_caps_inv and current_time_bounded)
-    (invs' and sch_act_simple and tcb_inv_wf' tc_caps_inv')
-    (invoke_tcb tc_caps_inv)
-    (invokeTCB tc_caps_inv')"
-  using assms
-  apply -
-  apply (simp add: invokeTCB_def liftE_bindE)
-  apply (rule corres_guard_imp)
-    apply (rule corres_split_norE, (rule installTCBCap_corres; clarsimp))+
-            apply (rule corres_split_norE)
-               apply (rule installThreadBuffer_corres; clarsimp)
-              apply (rule corres_trivial, clarsimp simp: returnOk_def)
-             apply wpsimp+
-           apply (wpsimp wp: install_tcb_cap_invs hoare_case_option_wpR)
-          apply (wpsimp wp: installTCBCap_invs' installTCBCap_sch_act_simple hoare_case_option_wpR)
-         apply ((wp hoare_case_option_wpR hoare_vcg_all_liftE_R hoare_vcg_const_imp_liftE_R
-                    install_tcb_cap_invs install_tcb_cap_cte_at install_tcb_cap_cte_wp_at_ep
-                 | strengthen tcb_cap_always_valid_strg)+)[1]
-        apply (wp installTCBCap_invs' installTCBCap_sch_act_simple
-                          hoare_case_option_wpR hoare_vcg_all_liftE_R hoare_vcg_const_imp_liftE_R)
-       apply ((wp hoare_case_option_wpR hoare_vcg_all_liftE_R hoare_vcg_const_imp_liftE_R
-                  install_tcb_cap_invs install_tcb_cap_cte_at install_tcb_cap_cte_wp_at_ep
-               | strengthen tcb_cap_always_valid_strg)+)[1]
-      apply (wp installTCBCap_invs' installTCBCap_sch_act_simple
-                        hoare_case_option_wpR hoare_vcg_all_liftE_R hoare_vcg_const_imp_liftE_R)
-     apply ((wp hoare_case_option_wpR hoare_vcg_all_liftE_R hoare_vcg_const_imp_liftE_R
-                install_tcb_cap_invs install_tcb_cap_cte_at install_tcb_cap_cte_wp_at_ep
-             | strengthen tcb_cap_always_valid_strg)+)[1]
-    apply (wp installTCBCap_invs' installTCBCap_sch_act_simple
-                      hoare_case_option_wpR hoare_vcg_all_liftE_R hoare_vcg_const_imp_liftE_R)
-   apply ((clarsimp simp: tcb_at_cte_at_0 tcb_at_cte_at_1[simplified] tcb_at_cte_at_3 tcb_at_cte_at_4
-                          tcb_cap_valid_def tcb_at_st_tcb_at[symmetric] is_nondevice_page_cap_def
-                          is_nondevice_page_cap_arch_def is_cnode_or_valid_arch_def is_cap_simps
-                          is_valid_vtable_root_def valid_ipc_buffer_cap tcb_ep_slot_cte_wp_at
-                          cte_wp_at_disj cte_wp_at_eq_simp real_cte_at_cte  real_cte_at_not_tcb_at
-                   split: option.split
-          | intro conjI | fastforce simp: valid_fault_handler_def)+)[1]
-  apply (clarsimp simp: tcb_at_cte_at'_0 tcb_at_cte_at'_1 tcb_at_cte_at'_3
-                        tcb_at_cte_at'_4 isCap_simps case_option_If2
-                        isValidFaultHandler_def isValidVTableRoot_def | intro conjI)+
-  done
-
-lemma sched_context_resume_weak_valid_sched_action:
-  "\<lbrace>\<lambda>s. weak_valid_sched_action s \<and>
-        (\<forall>ya. sc_tcb_sc_at ((=) (Some ya)) scp s \<longrightarrow> scheduler_act_not ya s)\<rbrace>
-   sched_context_resume scp
-   \<lbrace>\<lambda>_. weak_valid_sched_action\<rbrace>"
-  unfolding sched_context_resume_def
-  by (wpsimp wp: postpone_weak_valid_sched_action thread_get_wp' is_schedulable_wp')
-
-crunch sched_context_resume
-  for sc_at_ppred[wp]: "sc_at_ppred n P ptr"
-  (wp: crunch_wps)
-
-lemma setSchedContext_scTCB_update_valid_refills[wp]:
-  "\<lbrace>ko_at' sc ptr and valid_refills' ptr'\<rbrace>
-   setSchedContext ptr (scTCB_update f sc)
-   \<lbrace>\<lambda>_. valid_refills' ptr'\<rbrace>"
-  apply (wpsimp wp: set_sc'.set_wp)
-  by (clarsimp simp: valid_refills'_def obj_at_simps opt_map_red opt_pred_def)
-
-lemma schedContextBindTCB_corres:
-  "corres dc (valid_objs and pspace_aligned and pspace_distinct and (\<lambda>s. sym_refs (state_refs_of s))
-              and valid_sched and simple_sched_action and bound_sc_tcb_at ((=) None) t
-              and current_time_bounded
-              and active_scs_valid and sc_tcb_sc_at ((=) None) ptr and ex_nonz_cap_to t and ex_nonz_cap_to ptr)
-             (invs' and ex_nonz_cap_to' t and ex_nonz_cap_to' ptr)
-             (sched_context_bind_tcb ptr t) (schedContextBindTCB ptr t)"
-  apply (simp only: sched_context_bind_tcb_def schedContextBindTCB_def)
-  apply (rule stronger_corres_guard_imp)
-    apply clarsimp
-    apply (rule corres_symb_exec_r')
-       apply (rule corres_split_nor)
-         apply (clarsimp simp: set_tcb_obj_ref_thread_set sc_relation_def)
-          apply (rule threadset_corres; clarsimp simp: tcb_relation_def)
-         apply (rule corres_split_nor)
-            apply (rule_tac f'="scTCB_update (\<lambda>_. Some t)"
-                         in update_sc_no_reply_stack_update_ko_at'_corres; clarsimp?)
-             apply (clarsimp simp: sc_relation_def)
-            apply (clarsimp simp: objBits_def objBitsKO_def)
-           apply (rule corres_split[OF ifCondRefillUnblockCheck_corres])
-             apply (rule corres_split_nor)
-                apply (rule schedContextResume_corres)
-               apply (rule corres_split_eqr)
-                  apply (rule isSchedulable_corres)
-                 apply (rule corres_when, simp)
-                 apply (rule corres_split_nor)
-                    apply (rule tcbSchedEnqueue_corres)
-                   apply (rule rescheduleRequired_corres)
-                  apply wp
-                 apply wp
-                apply (wpsimp simp: is_schedulable_def)
-               apply (wpsimp wp: threadGet_wp getTCB_wp simp: isSchedulable_def inReleaseQueue_def)
-              apply (rule_tac Q'="\<lambda>rv. valid_objs and pspace_aligned and pspace_distinct and (\<lambda>s. sym_refs (state_refs_of s)) and
-                                      weak_valid_sched_action and active_scs_valid and
-                                      sc_tcb_sc_at ((=) (Some t)) ptr and current_time_bounded and
-                                      bound_sc_tcb_at (\<lambda>sc. sc = Some ptr) t"
-                           in hoare_strengthen_post[rotated], fastforce)
-              apply (wp sched_context_resume_weak_valid_sched_action sched_context_resume_pred_tcb_at)
-             apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post[rotated], fastforce)
-             apply wp
-            apply (rule_tac Q'="\<lambda>_. valid_objs and pspace_aligned and pspace_distinct and
-                                   (\<lambda>s. sym_refs (state_refs_of s)) and current_time_bounded and
-                                   valid_ready_qs and valid_release_q and weak_valid_sched_action and
-                                   active_scs_valid and scheduler_act_not t and
-                                   sc_tcb_sc_at ((=) (Some t)) ptr and
-                                   bound_sc_tcb_at (\<lambda>a. a = Some ptr) t"
-                   in hoare_strengthen_post[rotated])
-             apply (clarsimp simp: sc_tcb_sc_at_def obj_at_def valid_sched_action_def dest!: sym[of "Some _"])
-            apply (wpsimp simp: if_cond_refill_unblock_check_def
-                            wp: refill_unblock_check_valid_release_q
-                                refill_unblock_check_valid_sched_action
-                                refill_unblock_check_active_scs_valid)
-           apply (rule_tac Q'="\<lambda>_. invs'" in hoare_strengthen_post[rotated], fastforce)
-           apply wpsimp
-          apply (rule_tac Q'="\<lambda>_. valid_objs and pspace_aligned and pspace_distinct and
-                                 (\<lambda>s. sym_refs (state_refs_of s)) and
-                                 valid_ready_qs and valid_release_q and active_scs_valid and
-                                 sc_tcb_sc_at (\<lambda>sc. sc \<noteq> None) ptr and
-                                 (\<lambda>s. (weak_valid_sched_action s \<and> current_time_bounded s \<and>
-                                       (\<forall>ya. sc_tcb_sc_at ((=) (Some ya)) ptr s \<longrightarrow>
-                                             not_in_release_q ya s \<and> scheduler_act_not ya s)) \<and>
-                                      active_scs_valid s \<and>
-                                      sc_tcb_sc_at ((=) (Some t)) ptr s \<and>
-                                      bound_sc_tcb_at (\<lambda>a. a = Some ptr) t s)"
-                 in hoare_strengthen_post[rotated])
-           apply (clarsimp simp: sc_tcb_sc_at_def obj_at_def is_sc_obj invs_def valid_state_def
-                                 valid_pspace_def option.case_eq_if opt_map_red opt_pred_def)
-           apply (drule (1) valid_sched_context_size_objsI)
-           apply clarsimp
-           apply (clarsimp simp: pred_tcb_at_def obj_at_def vs_all_heap_simps option.case_eq_if
-                                 opt_map_red)
-           apply (rename_tac sc ta tcb tcb')
-           apply (drule_tac tp=ta in sym_ref_tcb_sc)
-             apply (fastforce+)[3]
-          apply ((wpsimp wp: valid_irq_node_typ obj_set_prop_at get_sched_context_wp ssc_refs_of_Some
-                            update_sched_context_valid_objs_same valid_ioports_lift
-                            update_sched_context_iflive_update update_sched_context_refs_of_update
-                            update_sched_context_cur_sc_tcb_None update_sched_context_valid_idle
-                      simp: invs'_def valid_pspace_def
-                 | rule hoare_vcg_conj_lift update_sched_context_wp)+)[2]
-        apply (clarsimp simp: pred_conj_def)
-        apply ((wp set_tcb_sched_context_valid_ready_qs
-                   set_tcb_sched_context_valid_release_q_not_queued
-                   set_tcb_sched_context_simple_weak_valid_sched_action
-               | ((rule hoare_vcg_conj_lift)?, rule set_tcb_obj_ref_wp))+)[1]
-       apply (clarsimp simp: pred_conj_def valid_pspace'_def cong: conj_cong)
-       apply (wp threadSet_valid_objs' threadSet_valid_queues threadSet_valid_queues'
-                 threadSet_iflive' threadSet_not_inQ threadSet_ifunsafe'T threadSet_idle'T
-                 threadSet_sch_actT_P[where P=False, simplified] threadSet_ctes_ofT threadSet_mdb'
-                 threadSet_valid_release_queue threadSet_valid_release_queue' valid_irq_node_lift
-                 valid_irq_handlers_lift'' untyped_ranges_zero_lift threadSet_valid_dom_schedule'
-                 threadSet_ct_idle_or_in_cur_domain' threadSet_cur threadSet_valid_replies'
-              | clarsimp simp: tcb_cte_cases_def cteCaps_of_def
-              | rule hoare_vcg_conj_lift threadSet_wp refl)+
-   apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_sched_def)
-   apply (intro conjI impI allI; (solves clarsimp)?)
-            apply (fastforce simp: valid_obj_def obj_at_def sc_at_ppred_def is_sc_obj_def)
-           apply (clarsimp simp: valid_sched_context_def obj_at_def pred_tcb_at_def is_tcb_def)
-          apply (fastforce simp: obj_at_def pred_tcb_at_def sc_at_ppred_def
-                                 tcb_st_refs_of_def state_refs_of_def
-                           elim: delta_sym_refs split: if_splits)
-         apply (fastforce simp: tcb_at_kh_simps pred_map_eq_def
-                         dest!: valid_ready_qs_no_sc_not_queued)
-        apply (fastforce simp: tcb_at_kh_simps pred_map_eq_def
-                        elim!: valid_release_q_no_sc_not_in_release_q)
-       apply (fastforce simp: sc_at_pred_def sc_at_ppred_def obj_at_def bound_sc_tcb_at_def
-                       split: if_splits)
-      apply (clarsimp simp: weak_valid_sched_action_def simple_sched_action_def)
-     apply (fastforce simp: tcb_at_kh_simps pred_map_eq_def sc_tcb_sc_at_def obj_at_def
-                     elim!: valid_release_q_no_sc_not_in_release_q)
-    apply (clarsimp simp: sc_at_ppred_def obj_at_def bound_sc_tcb_at_def)
-   apply (clarsimp simp: sc_at_ppred_def obj_at_def bound_sc_tcb_at_def)
-  apply (subgoal_tac "obj_at' (\<lambda>sc. scTCB sc = None) ptr s'")
-   apply (subgoal_tac "bound_sc_tcb_at' ((=) None) t s'")
-    apply (subgoal_tac "ptr \<noteq> idle_sc_ptr")
-     apply (clarsimp simp: invs'_def valid_pspace'_def pred_tcb_at'_def
-                           sc_at_ppred_def obj_at'_def projectKO_eq projectKO_tcb projectKO_sc)
-     apply (intro conjI allI impI; (solves \<open>clarsimp simp: inQ_def comp_def\<close>)?)
-             apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def obj_at'_def projectKO_eq)
-            apply (fastforce simp: valid_obj'_def valid_sched_context'_def tcb_cte_cases_def
-                                   obj_at'_def projectKO_eq projectKO_sc projectKO_tcb)
-           apply (fastforce elim: valid_objs_sizeE'[OF valid_objs'_valid_objs_size']
-                            simp: objBits_def objBitsKO_def valid_obj_size'_def
-                                  valid_sched_context_size'_def)
-          apply (fastforce elim: ex_cap_to'_after_update simp: ko_wp_at'_def tcb_cte_cases_def)
-         apply (fastforce elim: ex_cap_to'_after_update simp: ko_wp_at'_def tcb_cte_cases_def)
-        apply (clarsimp simp: valid_release_queue'_def obj_at'_def projectKO_eq projectKO_tcb)
-       apply (clarsimp simp: valid_release_queue'_def obj_at'_def projectKO_eq projectKO_tcb)
-      apply (clarsimp simp: untyped_ranges_zero_inv_def cteCaps_of_def comp_def)
-     apply simp
-    apply (fastforce simp: invs'_def dest: global'_sc_no_ex_cap)
-   apply (clarsimp simp: state_relation_def invs_def valid_state_def valid_pspace_def)
-   apply (subgoal_tac "tcb_at' t s'")
-    apply (clarsimp simp: pspace_relation_def pred_tcb_at_def pred_tcb_at'_def obj_at_def obj_at'_def)
-    apply (drule_tac x=t in bspec; clarsimp simp: other_obj_relation_def tcb_relation_def projectKOs)
-   apply (fastforce elim: tcb_at_cross)
-  apply (clarsimp simp: sc_relation_def state_relation_def invs_def valid_state_def valid_pspace_def)
-  apply (subgoal_tac "sc_at' ptr s'")
-   apply (clarsimp simp: obj_at_def sc_at_pred_n_def obj_at'_def projectKOs pspace_relation_def)
-   apply (drule_tac x=ptr in bspec; clarsimp simp: sc_relation_def split: if_splits)
-  apply (fastforce simp: sc_at_pred_n_def obj_at_def is_sc_obj_def valid_obj_def elim!: sc_at_cross)
-  done
-
-schematic_goal finaliseSlot'_def:
-  "finaliseSlot' a b = ?X"
-  by (rule ext) simp
-
-lemma cteDelete_fh_lift:
-  assumes A: "\<And>x. \<lbrace>Q\<rbrace> emptySlot target x \<lbrace>\<lambda>_. P\<rbrace>"
-  and     B: "\<And>x. \<lbrace>R\<rbrace> cancelAllIPC x \<lbrace>\<lambda>_. Q\<rbrace>"
-  and     C: "\<And>s. (P and invs'  and L) s \<Longrightarrow> Q s \<and> R s"
-  shows "\<lbrace>P and invs' and cte_wp_at' (isValidFaultHandler \<circ> cteCap) target and L\<rbrace>
-         cteDelete target True
-         \<lbrace>\<lambda>_. P\<rbrace>"
-  apply (wpsimp wp: A simp: cteDelete_def)
-   prefer 2
-   apply assumption
-  apply (subst finaliseSlot_def)
-  apply (subst finaliseSlot'_def)
-  apply (rule bindE_wp_fwd)
-   apply (subst liftE_validE)
-   apply (rule getCTE_sp)
-  apply (clarsimp split del: if_split)
-  apply (rule_tac Q="P and invs' and L and cte_wp_at' (\<lambda>c. c = cte) target
-                       and K (isValidFaultHandler (cteCap cte))" in hoare_pre(2))
-   apply (case_tac "cteCap cte"; clarsimp simp: isValidFaultHandler_def split: bool.splits)
-    apply (wpsimp simp: C)+
-         apply (rule hoare_FalseE)
-        apply (rule hoare_FalseE)
-       apply (rule hoare_FalseE)
-      apply (wpsimp wp: B isFinal simp: capRemovable_def finaliseCap_def isEndpointCap_def)+
-   apply (fastforce simp: C cte_wp_at'_def final_matters'_def capRemovable_def invs'_def)+
-  done
-
-lemma installTCBCap_fh_ex_nonz_cap_to':
-  "\<lbrace>\<lambda>s. ex_nonz_cap_to' p s \<and> invs' s \<and> \<not>ep_at' p s \<and>
-        cte_wp_at' (isValidFaultHandler \<circ> cteCap) (cte_map (target, tcb_cnode_index 3)) s\<rbrace>
-   installTCBCap target slot 3 slot_opt
-   \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
-  unfolding installTCBCap_def getThreadFaultHandlerSlot_def locateSlotTCB_def locateSlotBasic_def
-  apply (case_tac slot_opt; clarsimp)
-   apply wpsimp
-  apply (rule validE_valid)
-  apply (rule bindE_wp_fwd)
-   apply (rule liftE_wp[OF hoare_return_sp])
-  apply (rule valid_validE)
-  apply (rule hoare_gen_asm)
-  apply (clarsimp simp: objBits_def objBitsKO_def)
-  apply (wpsimp wp: checkCap_wp assertDerived_wp_weak cteInsert_cap_to' split_del: if_splits)
-   apply (rule_tac Q'="\<lambda>_ s. cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap)
-                                       (target + 2 ^ cteSizeBits * tcbFaultHandlerSlot) s \<and>
-                            ex_nonz_cap_to' p s" in hoare_strengthen_postE)
-     apply (rule hoare_vcg_conj_liftE1[OF _ valid_validE])
-      apply (wpsimp wp: cteDelete_deletes)
-     apply (rule cteDelete_fh_lift)
-       apply (wpsimp wp: hoare_vcg_ex_lift emptySlot_cte_wp_cap_other simp: ex_nonz_cap_to'_def)
-      apply (wpsimp wp: hoare_vcg_ex_lift)
-     apply (clarsimp simp: ex_nonz_cap_to'_def)
-     apply (rule_tac x=cref in exI)
-     apply clarsimp
-     apply (prop_tac "\<not> ep_at' p s \<and> cte_wp_at' (isValidFaultHandler \<circ> cteCap)
-                                                 (target + 2 ^ cteSizeBits * tcbFaultHandlerSlot) s")
-      apply assumption
-     apply (clarsimp simp: cte_wp_at_ctes_of)
-     apply (prop_tac "s \<turnstile>' (cteCap cte)")
-      apply fastforce
-     apply (prop_tac "\<not> isEndpointCap (cteCap cte)")
-      apply (fastforce simp: valid_cap'_def isCap_simps)
-     apply (case_tac "cteCap cte"; clarsimp simp: isValidFaultHandler_def isEndpointCap_def)
-    apply (wpsimp wp: cteDelete_deletes)+
-  apply (clarsimp simp: comp_def cte_map_def tcb_cnode_index_def
-                        objBits_defs cte_level_bits_def tcbFaultHandlerSlot_def)
-  done
-
-lemma threadSetPriority_ex_nonz_cap_to'[wp]:
-  "threadSetPriority param_a param_b \<lbrace>ex_nonz_cap_to' p\<rbrace>"
-  by (wpsimp wp: threadSet_cap_to' simp: threadSetPriority_def)
-
-crunch setPriority
-  for ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' p"
-  (wp: crunch_wps simp: crunch_simps)
-
-crunch setMCPriority
-  for tcb_at'[wp]: "tcb_at' t"
-  and weak_sch_act_wf[wp]: "\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s"
-  (wp: crunch_wps simp: crunch_simps inQ_def)
-
-lemma setMCPriority_ex_nonz_cap_to'[wp]:
-  "setMCPriority param_a param_b \<lbrace>ex_nonz_cap_to' p\<rbrace>"
-  by (wpsimp wp: threadSet_cap_to' simp: setMCPriority_def)
-
-lemma mapTCBPtr_threadGet: "mapTCBPtr t f = threadGet f t"
-  by (clarsimp simp: mapTCBPtr_def threadGet_getObject)
-
-lemma monadic_rewrite_bind_unbind:
-  "monadic_rewrite False True (tcb_at t)
-   (case sc_opt of None \<Rightarrow> return ()
-                 | Some None \<Rightarrow> maybe_sched_context_unbind_tcb t
-                 | Some (Some sc_ptr) \<Rightarrow> maybe_sched_context_bind_tcb sc_ptr t)
-   (do y <- get_tcb_obj_ref tcb_sched_context t;
-       case sc_opt of None \<Rightarrow> return ()
-                    | Some None \<Rightarrow> case y of None \<Rightarrow> return ()
-                                           | Some x \<Rightarrow> sched_context_unbind_tcb x
-                    | Some (Some sc_ptr) \<Rightarrow> when (y \<noteq> Some sc_ptr) $ sched_context_bind_tcb sc_ptr t
-    od)"
-  apply (case_tac sc_opt; clarsimp)
-   apply (clarsimp simp: monadic_rewrite_def bind_def get_tcb_obj_ref_def thread_get_def
-                         gets_the_def get_tcb_def gets_def get_def obj_at_def is_tcb_def)
-   apply (case_tac ko; clarsimp simp: return_def)
-  apply (case_tac a; clarsimp simp: maybeM_def maybe_sched_context_unbind_tcb_def
-                                    maybe_sched_context_bind_tcb_def monadic_rewrite_def)
-  done
-
-defs tcs_cross_asrt1_def:
-  "tcs_cross_asrt1 t sc_opt \<equiv>
-     \<lambda>s. sym_refs (state_refs_of' s) \<and>
-         cte_wp_at' (isValidFaultHandler \<circ> cteCap) (cte_map (t, tcb_cnode_index 3)) s \<and>
-         (\<forall>x. sc_opt = Some (Some x) \<longrightarrow> bound_sc_tcb_at' (\<lambda>sc. sc = None) t s \<and>
-                                         obj_at' (\<lambda>sc. scTCB sc = None) x s)"
-
-defs tcs_cross_asrt2_def:
-  "tcs_cross_asrt2 \<equiv> \<lambda>s. ready_qs_runnable s \<and> ct_active' s \<and>
-                          bound_sc_tcb_at' bound (ksCurThread s) s"
-
-crunch setPriority, setMCPriority
-  for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  and cur_tcb'[wp]: cur_tcb'
-  (wp: crunch_wps cur_tcb_lift)
-
-crunch schedContextYieldTo, schedContextCompleteYieldTo
-  for tcb_at'[wp]: "tcb_at' tcbPtr"
-  (wp: crunch_wps)
-
-lemma schedContextUnbindTCB_corres':
-  "corres dc (invs and valid_sched and sc_tcb_sc_at ((\<noteq>) None) scp) invs'
-             (sched_context_unbind_tcb scp) (schedContextUnbindTCB scp)"
-  apply (rule corres_cross_add_guard[where Q="obj_at' (\<lambda>sc. \<exists>y. scTCB sc = Some y) scp"])
-   apply (fastforce elim: sc_tcb_sc_at_bound_cross dest!: state_relation_pspace_relation
-                    simp: invs_def valid_state_def valid_pspace_def)
-
-  apply (simp add: neq_None_bound)
-  apply (rule schedContextUnbindTCB_corres[simplified])
-  done
-
-lemma tc_corres_sched:
-  fixes t slot sc_fault_h p_auth mcp_auth sc_opt sl' sc_fault_h' sc_opt'
-  defines "tc_inv_sched \<equiv> tcb_invocation.ThreadControlSched t slot sc_fault_h mcp_auth p_auth sc_opt"
-  defines "tc_inv_sched' \<equiv> ThreadControlSched t sl' sc_fault_h' mcp_auth p_auth sc_opt'"
-  assumes "tcbinv_relation tc_inv_sched tc_inv_sched'"
-  shows
-    "corres (dc \<oplus> (=))
-    (einvs and valid_machine_time and simple_sched_action and tcb_inv_wf tc_inv_sched
-           and ct_released and ct_active and ct_not_in_release_q and current_time_bounded)
-    (invs' and sch_act_simple and tcb_inv_wf' tc_inv_sched')
-    (invoke_tcb tc_inv_sched)
-    (invokeTCB tc_inv_sched')"
-  using assms
-  apply -
-  apply add_sym_refs
-  apply add_valid_idle'
-  apply add_cur_tcb'
-  apply (simp add: invokeTCB_def liftE_bindE bind_assoc maybeM_def)
-  apply (rule corres_stateAssertE_add_assertion)
-  apply (rule corres_stateAssertE_add_assertion[rotated])
-   apply (clarsimp simp: valid_idle'_asrt_def)
-   apply (rule stronger_corres_guard_imp)
-     apply (rule corres_split_norE)
-        apply (rule installTCBCap_corres; clarsimp)
-       apply (rule corres_split_nor)
-          apply (rule_tac P=\<top> and P'=\<top> in corres_option_split; clarsimp)
-          apply (rule setMCPriority_corres)
-         apply (rule corres_stateAssert_add_assertion)
-          apply (rule stronger_corres_guard_imp)
-            apply (rule corres_split_nor)
-               apply (rule_tac P=\<top> and P'=\<top> in corres_option_split; clarsimp)
-               apply wpfix
-               apply (rule setPriority)
-              apply (simp add: bind_assoc[symmetric])
-              apply (rule corres_split_nor)
-                 apply (rule monadic_rewrite_corres_l[OF monadic_rewrite_bind_unbind])
-                 apply (rule corres_split_eqr)
-                    apply (simp only: mapTCBPtr_threadGet get_tcb_obj_ref_def)
-                    apply (rule threadGet_corres, clarsimp simp: tcb_relation_def)
-                   apply (rule_tac P=\<top> and P'=\<top> in corres_option_split; clarsimp)
-                   apply (rule corres_option_split; clarsimp?)
-                    apply (rule_tac P=\<top> and P'=\<top> in corres_option_split; clarsimp)
-                    apply (rule schedContextUnbindTCB_corres')
-                   apply (rule corres_when[OF _ schedContextBindTCB_corres], fastforce)
-                  apply (wp get_tcb_obj_ref_wp)
-                 apply (wpsimp wp: getTCB_wp simp: mapTCBPtr_def)
-                apply (clarsimp simp: returnOk_def)
-               apply (rule_tac P=\<top> in hoare_TrueI)
-              apply (rule hoare_TrueI)
-             apply (rule_tac Q'="\<lambda>_ s. invs s \<and> valid_machine_time s \<and> valid_sched s
-                                      \<and> simple_sched_action s \<and> current_time_bounded s \<and>
-                                      tcb_at t s \<and> ex_nonz_cap_to t s \<and>
-                                      (\<forall>scPtr. sc_opt = Some (Some scPtr) \<longrightarrow>
-                                                 ex_nonz_cap_to scPtr s \<and>
-                                                 sc_tcb_sc_at ((=) None) scPtr s \<and>
-                                                 bound_sc_tcb_at ((=) None) t s)"
-                          in hoare_strengthen_post[rotated])
-              apply (clarsimp simp: obj_at_def split: option.splits)
-              apply (frule invs_valid_objs)
-              apply (frule valid_sched_active_scs_valid)
-              apply (erule (1) valid_objsE)
-              apply (clarsimp simp: valid_obj_def valid_tcb_def obj_at_def is_sc_obj_def
-                                    invs_def valid_state_def valid_pspace_def)
-              apply (clarsimp split: Structures_A.kernel_object.splits)
-              apply (drule (2) bound_sc_tcb_bound_sc_at[where tcbptr=t])
-               apply (clarsimp simp: pred_tcb_at_def obj_at_def)
-              apply (clarsimp simp: sc_at_ppred_def obj_at_def)
-             apply (wpsimp wp: set_priority_valid_sched hoare_vcg_all_lift hoare_vcg_const_imp_lift)
-            apply (rule_tac Q'=" \<lambda>_ s. invs' s \<and> tcb_at' t s \<and> ex_nonz_cap_to' t s \<and>
-                                      (\<forall>scp. sc_opt = Some (Some scp) \<longrightarrow> ex_nonz_cap_to' scp s)"
-                         in hoare_strengthen_post[rotated], fastforce split: option.split)
-            apply (wpsimp wp: setP_invs' hoare_vcg_all_lift hoare_vcg_const_imp_lift)
-           apply clarsimp
-           apply (prop_tac "ct_active s \<and> ct_released s", erule conjunct1)
-           apply simp
-          apply clarsimp
-          \<comment> \<open>the following is unified with one of the guard schematics\<close>
-          apply (prop_tac "invs' s' \<and> tcb_at' t s' \<and> ex_nonz_cap_to' t s' \<and>
-                           (\<forall>x. p_auth = Some x \<longrightarrow> fst x \<le> maxPriority) \<and>
-                           (\<forall>scp. sc_opt = Some (Some scp) \<longrightarrow> ex_nonz_cap_to' scp s')")
-           apply assumption
-          apply (fastforce elim: ready_qs_runnable_cross ct_active_cross split: option.splits)
-         apply (clarsimp simp: tcs_cross_asrt2_def)
-         apply (intro conjI)
-           apply (fastforce elim: ready_qs_runnable_cross)
-          apply (fastforce elim: ct_active_cross)
-         apply (prop_tac "cur_tcb s", fastforce)
-         apply (frule cur_tcb_cross)
-            apply fastforce
-           apply fastforce
-          apply fastforce
-         apply (fastforce elim: ct_released_cross_weak[simplified])
-        apply (rule_tac Q'="\<lambda>_. invs" in hoare_post_add)
-        apply (clarsimp simp: invs_cur case_option_If2 if_fun_split
-                        cong: conj_cong imp_cong split del: if_split)
-        apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_const_imp_lift)
-       apply (rule_tac Q'="\<lambda>_. invs'" in hoare_post_add)
-       apply (clarsimp simp: invs_queues invs_queues' case_option_If2 if_fun_split
-                       cong: conj_cong imp_cong split del: if_split)
-       apply (rule_tac f="ksCurThread" in hoare_lift_Pf3)
-        apply (wpsimp wp: setMCPriority_invs' hoare_vcg_all_lift hoare_vcg_const_imp_lift)
-       apply wpsimp
-      apply (rule_tac Q'="\<lambda>_ s. einvs s \<and> valid_machine_time s \<and> simple_sched_action s \<and> tcb_at t s
-                               \<and> ex_nonz_cap_to t s \<and> ct_active s \<and> ct_released s
-                               \<and> ct_not_in_release_q s \<and> current_time_bounded s \<and>
-                               (\<forall>scp. sc_opt = Some (Some scp) \<longrightarrow> ex_nonz_cap_to scp s \<and>
-                                                                   sc_tcb_sc_at ((=) None) scp s \<and>
-                                                                   bound_sc_tcb_at ((=) None) t s)"
-                  and E'="\<lambda>_. \<top>" in hoare_strengthen_postE[rotated], fastforce split: option.splits, simp)
-      apply (rule hoare_vcg_conj_elimE)
-       apply wp
-      apply (wp install_tcb_cap_invs install_tcb_cap_ex_nonz_cap_to
-                install_tcb_cap_ct_active hoare_vcg_all_lift hoare_weak_lift_imp
-                hoare_lift_Pf3[where f=cur_thread, OF install_tcb_cap_released_sc_tcb_at
-                                                      install_tcb_cap_cur_thread])
-     apply (rule_tac Q'="\<lambda>_ s. invs' s \<and> tcb_at' t s \<and> ex_nonz_cap_to' t s \<and>
-                              (\<forall>scp. sc_opt = Some (Some scp) \<longrightarrow> ex_nonz_cap_to' scp s) \<and>
-                              (\<forall>p. p_auth = Some p \<longrightarrow> fst p \<le> maxPriority) \<and>
-                              (\<forall>p. mcp_auth = Some p \<longrightarrow> fst p \<le> maxPriority)"
-                 and E'="\<lambda>_. \<top>" in hoare_strengthen_postE[rotated], fastforce split: option.splits, simp)
-     apply (wp installTCBCap_invs' installTCBCap_fh_ex_nonz_cap_to'
-               hoare_vcg_all_lift hoare_vcg_const_imp_lift)
-    apply (prop_tac "(not ep_at t) s")
-     apply (clarsimp simp: pred_neg_def obj_at_def is_tcb_def is_ep_def)
-     apply (clarsimp split: Structures_A.kernel_object.splits)
-    apply (fastforce simp: tcb_cap_valid_def pred_tcb_at_def pred_neg_def
-                           sc_at_ppred_def obj_at_def is_ep_def is_tcb_def
-                     elim: cte_wp_at_weakenE dest: tcb_ep_slot_cte_wp_ats)
-   apply (clarsimp simp: tcs_cross_asrt1_def)
-   apply (intro conjI impI allI; clarsimp?)
-       apply (clarsimp simp: tcb_at_cte_at'_3)
-      apply (clarsimp simp: newroot_rel_def isCap_simps valid_fault_handler_def)
-      apply (case_tac a; clarsimp)
-     apply (clarsimp simp: newroot_rel_def isCap_simps valid_fault_handler_def)
-     apply (case_tac a; clarsimp)
-    apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_tcb projectKO_ep)
-   apply (clarsimp simp: obj_at'_def projectKO_eq projectKO_sc projectKO_ep)
-  apply (clarsimp simp: tcs_cross_asrt1_def)
-  apply (intro conjI impI allI)
-    apply (drule (1) tcb_ep_slot_cte_wp_ats)
-    apply (drule_tac p="(t, tcb_cnode_index 3)" in cte_wp_at_norm)
-    apply (fastforce simp: valid_fault_handler_def has_handler_rights_def
-                           isValidFaultHandler_def is_cap_simps cte_wp_at'_def
-                    dest!: pspace_relation_cte_wp_at[rotated])
-   apply (subgoal_tac "tcb_at' t s'")
-    apply (clarsimp simp: state_relation_def pspace_relation_def invs_def valid_state_def
-                          valid_pspace_def pred_tcb_at_def pred_tcb_at'_def obj_at_def obj_at'_def)
-    apply (drule_tac x=t in bspec, clarsimp)
-    apply (clarsimp simp: other_obj_relation_def tcb_relation_def projectKOs)
-   apply (fastforce elim: tcb_at_cross)
-  apply (subgoal_tac "sc_at' x s'")
-   apply (clarsimp simp: state_relation_def pspace_relation_def invs_def valid_state_def
-                         valid_pspace_def sc_at_ppred_def obj_at_def obj_at'_def)
-   apply (drule_tac x=x in bspec, clarsimp)
-   apply (clarsimp simp: other_obj_relation_def sc_relation_def projectKOs split: if_splits)
-  apply (fastforce elim: sc_at_cross)
-  done
-
-lemmas threadSet_ipcbuffer_trivial
-    = threadSet_invs_trivial[where F="tcbIPCBuffer_update F'" for F',
-                              simplified inQ_def, simplified]
-
-lemma tc_caps_invs':
-  "\<lbrace>invs' and sch_act_simple and tcb_inv_wf' (ThreadControlCaps t sl fault_h time_h croot vroot ipcb)\<rbrace>
-   invokeTCB (ThreadControlCaps t sl fault_h time_h croot vroot ipcb)
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: split_def invokeTCB_def getThreadCSpaceRoot getThreadVSpaceRoot
-                   getThreadBufferSlot_def locateSlot_conv
-             cong: option.case_cong)
-  apply (wpsimp wp: hoare_vcg_all_lift hoare_weak_lift_imp setP_invs' setMCPriority_invs'
-                    installTCBCap_invs' installThreadBuffer_invs' installTCBCap_sch_act_simple)
-  apply (clarsimp cong: conj_cong)
-  apply (intro conjI; intro allI impI; clarsimp;
-         fastforce simp: isValidFaultHandler_def isCap_simps isValidVTableRoot_def)
-  done
-
-lemma schedContextBindTCB_invs':
-  "\<lbrace>\<lambda>s. invs' s \<and> ex_nonz_cap_to' tcbPtr s \<and> ex_nonz_cap_to' scPtr s \<and>
-        bound_sc_tcb_at' (\<lambda>sc. sc = None) tcbPtr s \<and> obj_at' (\<lambda>sc. scTCB sc = None) scPtr s\<rbrace>
-   schedContextBindTCB scPtr tcbPtr
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: schedContextBindTCB_def)
-  apply (subst bind_assoc[symmetric, where m="threadSet _ _"])
-  apply (rule bind_wp)+
-      apply wpsimp
-     apply (wpsimp wp: isSchedulable_wp)
-    apply (clarsimp simp: isSchedulable_bool_runnableE)
-    apply (wp (once) hoare_drop_imps)
-     apply (wp hoare_vcg_imp_lift')
-     apply (wp hoare_drop_imps)
-    apply (wpsimp wp: hoare_vcg_imp_lift' simp: ifCondRefillUnblockCheck_def)
-   apply (rule_tac Q'="\<lambda>_ s. invs' s" in hoare_strengthen_post[rotated], simp)
-   apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
-   apply (wp threadSet_valid_objs' threadSet_mdb' threadSet_iflive'
-             threadSet_cap_to threadSet_ifunsafe'T threadSet_ctes_ofT
-             threadSet_valid_queues_new threadSet_valid_queues' threadSet_valid_release_queue
-             threadSet_valid_release_queue' untyped_ranges_zero_lift valid_irq_node_lift
-             valid_irq_handlers_lift'' hoare_vcg_const_imp_lift hoare_vcg_imp_lift'
-             threadSet_valid_replies'
-          | clarsimp simp: tcb_cte_cases_def cteCaps_of_def)+
-  apply (clarsimp simp: invs'_def valid_pspace'_def valid_dom_schedule'_def)
-  by (fastforce simp: pred_tcb_at'_def obj_at'_def projectKOs
-                      objBits_def objBitsKO_def valid_tcb'_def tcb_cte_cases_def comp_def
-                      valid_obj'_def valid_sched_context'_def valid_sched_context_size'_def
-                      valid_release_queue'_def inQ_def cteCaps_of_def
-                elim: ps_clear_domE split: if_splits)
-
-lemma threadSetPriority_bound_sc_tcb_at' [wp]:
-  "threadSetPriority tptr prio \<lbrace>\<lambda>s. Q (bound_sc_tcb_at' P t s)\<rbrace>"
-  by (wpsimp wp: threadSet_pred_tcb_no_state simp: threadSetPriority_def)
-
-crunch setPriority
-  for sc_tcb_sc_at'[wp]: "\<lambda>s. Q (obj_at' (\<lambda>sc. P (scTCB sc)) p s)"
-  and bound_sc_tcb_at'[wp]: "\<lambda>s. Q (bound_sc_tcb_at' P t s)"
-  and ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  (wp: crunch_wps)
-
-crunch setMCPriority
-  for sc_tcb_sc_at'[wp]: "\<lambda>s. Q (obj_at' (\<lambda>sc. P (scTCB sc)) p s)"
-  and bound_sc_tcb_at'[wp]: "\<lambda>s. Q (bound_sc_tcb_at' P t s)"
-  and st_tcb_at'[wp]: "\<lambda>s. Q (st_tcb_at' P t s)"
-  and ksSchedulerAction[wp]: "\<lambda>s. P (ksSchedulerAction s)"
-  and ksReadyQueues[wp]: "\<lambda>s. P (ksReadyQueues s)"
-  (wp: crunch_wps threadSet_pred_tcb_no_state)
-
-crunch finaliseCap, capSwapForDelete
-  for ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
-  (simp: crunch_simps wp: crunch_wps getObject_inv cteDelete_preservation)
-
-lemma updateRefillHd_sc_tcb_sc_at'[wp]:
-  "updateRefillHd scp f \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>sc. P (scTCB sc)) p s)\<rbrace>"
-  apply (wpsimp simp: updateRefillHd_def wp: updateSchedContext_wp)
-  by (clarsimp simp: obj_at'_def ps_clear_upd projectKOs opt_map_red objBits_simps)
-
-lemma refillPopHead_sc_tcb_sc_at'[wp]:
-  "refillPopHead scp \<lbrace>\<lambda>s. Q (obj_at' (\<lambda>sc. P (scTCB sc)) p s)\<rbrace>"
-  apply (wpsimp simp: refillPopHead_def wp: updateSchedContext_wp)
-  by (clarsimp simp: obj_at'_def ps_clear_upd projectKOs opt_map_red objBits_simps)
-
-crunch cteInsert, emptySlot, cancelAllIPC
-  for sc_tcb_sc_at'[wp]: "\<lambda>s. Q (obj_at' (\<lambda>sc. P (scTCB sc)) p s)"
-  (wp: crunch_wps simp: crunch_simps ignore: updateRefillHd)
-
-lemma installTCBCap_fh_sc_tcb_sc_at':
-  "\<lbrace>\<lambda>s. Q (obj_at' (\<lambda>sc. P (scTCB sc)) p s) \<and> invs' s \<and> tcb_at' target s \<and>
-        cte_wp_at' (isValidFaultHandler \<circ> cteCap) (cte_map (target, tcb_cnode_index 3)) s\<rbrace>
-   installTCBCap target slot 3 slot_opt
-   \<lbrace>\<lambda>_ s. Q (obj_at' (\<lambda>sc. P (scTCB sc)) p s)\<rbrace>"
-  by (wpsimp wp: checkCap_inv assertDerived_wp cteDelete_fh_lift
-           simp: installTCBCap_def locateSlotTCB_def locateSlotBasic_def tcbFaultHandlerSlot_def
-                 getThreadFaultHandlerSlot_def cte_level_bits_def cte_map_def
-                 tcb_cnode_index_def objBits_defs objBits_def objBitsKO_def)
-
-lemma installTCBCap_fh_bound_sc_tcb_at':
-  "\<lbrace>\<lambda>s. bound_sc_tcb_at' P t s \<and> invs' s \<and> tcb_at' target s \<and>
-          cte_wp_at' (isValidFaultHandler \<circ> cteCap) (cte_map (target, tcb_cnode_index 3)) s\<rbrace>
-   installTCBCap target slot 3 slot_opt
-   \<lbrace>\<lambda>_ s. bound_sc_tcb_at' P t s\<rbrace>"
-  by (wpsimp wp: checkCap_inv assertDerived_wp cteDelete_fh_lift hoare_vcg_const_imp_lift
-           simp: installTCBCap_def locateSlotTCB_def locateSlotBasic_def tcbFaultHandlerSlot_def
-                 getThreadFaultHandlerSlot_def cte_level_bits_def cte_map_def
-                 tcb_cnode_index_def objBits_defs objBits_def objBitsKO_def)
-
-lemma installTCBCap_ksCurThread[wp]:
-  "installTCBCap target slot n slot_opt \<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace>"
-  by (wpsimp wp: checkCap_inv assertDerived_wp cteDelete_preservation split_del: if_split
-           simp: installTCBCap_def getThreadFaultHandlerSlot_def getThreadTimeoutHandlerSlot_def)
-
-lemma tc_sched_invs':
-  "\<lbrace>invs' and sch_act_simple and tcb_inv_wf' (ThreadControlSched t sl sc_fault_h mcp pri sc_opt)\<rbrace>
-   invokeTCB (ThreadControlSched t sl sc_fault_h mcp pri sc_opt)
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: invokeTCB_def)
-  apply (wpsimp wp: schedContextUnbindTCB_invs' schedContextBindTCB_invs')
-        apply (wpsimp wp: getTCB_wp simp: mapTCBPtr_def)
-       apply (rule_tac Q'="\<lambda>rv s. invs' s \<and> ex_nonz_cap_to' t s \<and>
-                                 (sc_opt = Some None \<longrightarrow>
-                                  bound_sc_tcb_at' (\<lambda>sc. sc \<noteq> Some idle_sc_ptr) t s) \<and>
-                                 (\<forall>x. sc_opt = Some (Some x) \<longrightarrow>
-                                      ex_nonz_cap_to' x s \<and> obj_at' (\<lambda>sc. scTCB sc = None) x s \<and>
-                                      bound_sc_tcb_at' (\<lambda>sc. sc = None) t s \<and>
-                                      bound_sc_tcb_at' bound (ksCurThread s) s)"
-                    in hoare_strengthen_post[rotated])
-        apply (fastforce simp: pred_tcb_at'_def obj_at'_def projectKOs)
-       apply (rule hoare_lift_Pf3[where f=ksCurThread])
-        apply (wpsimp wp: setP_invs' hoare_vcg_all_lift hoare_vcg_const_imp_lift)
-       apply wpsimp
-      apply wpsimp
-     apply (clarsimp simp: tcs_cross_asrt2_def)
-     apply (wp (once) hoare_drop_imps)
-     apply (wpsimp wp: setMCPriority_invs' hoare_vcg_all_lift hoare_vcg_const_imp_lift)
-    apply (wpsimp wp: installTCBCap_invs' installTCBCap_fh_ex_nonz_cap_to'
-                      installTCBCap_fh_bound_sc_tcb_at' installTCBCap_fh_sc_tcb_sc_at'
-                      hoare_vcg_all_lift hoare_vcg_ball_lift2 hoare_vcg_const_imp_lift)
-   apply (wpsimp simp: stateAssertE_def)+
-  apply (clarsimp cong: conj_cong)
-  apply (subgoal_tac "sc_opt = Some None \<longrightarrow> bound_sc_tcb_at' (\<lambda>a. a \<noteq> Some idle_sc_ptr) t s")
-   apply (fastforce simp: tcs_cross_asrt1_def comp_def isValidFaultHandler_def
-                          isCap_simps pred_tcb_at'_def obj_at'_def projectKOs)
-  apply (clarsimp simp: invs'_def valid_idle'_def
-                        pred_tcb_at'_def obj_at'_def tcs_cross_asrt1_def valid_idle'_asrt_def)
-  apply (frule_tac p=t and ko="ko :: tcb" for ko in sym_refs_ko_atD'[rotated])
-   apply (auto simp: ko_wp_at'_def obj_at'_def projectKOs valid_idle'_def dest!: global'_no_ex_cap)
-  done
-
-lemma setSchedulerAction_invs'[wp]:
-  "\<lbrace>invs' and sch_act_wf sa\<rbrace>
-   setSchedulerAction sa
-   \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: setSchedulerAction_def)
-  apply wp
-  apply (clarsimp simp add: invs'_def valid_irq_node'_def valid_dom_schedule'_def
-                valid_queues_def valid_queues_no_bitmap_def bitmapQ_defs cur_tcb'_def
-                ct_not_inQ_def valid_release_queue_def valid_release_queue'_def)
-  done
-
 lemma invokeTCB_corres:
  "tcbinv_relation ti ti' \<Longrightarrow>
   corres (dc \<oplus> (=))
-         (einvs and valid_machine_time and simple_sched_action and Tcb_AI.tcb_inv_wf ti
-                and current_time_bounded and ct_released and ct_active and ct_not_in_release_q)
+         (einvs and simple_sched_action and Tcb_AI.tcb_inv_wf ti)
          (invs' and sch_act_simple and tcb_inv_wf' ti')
          (invoke_tcb ti) (invokeTCB ti')"
   apply (case_tac ti, simp_all only: tcbinv_relation.simps valid_tcb_invocation_def)
-          apply (rule corres_guard_imp[OF invokeTCB_WriteRegisters_corres], fastforce+)[1]
-         apply (rule corres_guard_imp[OF invokeTCB_ReadRegisters_corres], simp+)[1]
-        apply (rule corres_guard_imp[OF invokeTCB_CopyRegisters_corres], fastforce+)[1]
-       apply (clarsimp simp del: invoke_tcb.simps)
-       apply (rule corres_guard_imp[OF tc_corres_caps]; clarsimp)
+         apply (rule corres_guard_imp [OF invokeTCB_WriteRegisters_corres], simp+)[1]
+        apply (rule corres_guard_imp [OF invokeTCB_ReadRegisters_corres], simp+)[1]
+       apply (rule corres_guard_imp [OF invokeTCB_CopyRegisters_corres], simp+)[1]
       apply (clarsimp simp del: invoke_tcb.simps)
-      apply (rename_tac word a b sc_fault_h mcp prio sc_opt sl' sc_fault_h')
-      apply (rule corres_guard_imp[OF tc_corres_sched]; clarsimp)
-     apply (clarsimp simp: invokeTCB_def liftM_def[symmetric] o_def dc_def[symmetric])
-     apply (rule corres_guard_imp[OF suspend_corres]; clarsimp)
-    apply (clarsimp simp: invokeTCB_def liftM_def[symmetric] o_def dc_def[symmetric])
-    apply (rule corres_guard_imp[OF restart_corres]; clarsimp)
-   apply (clarsimp simp: invokeTCB_def)
+      apply (rename_tac word one t2 mcp t3 t4 t5 t6 t7 t8 t9 t10 t11)
+      apply (rule_tac F="is_aligned word 5" in corres_req)
+       apply (clarsimp simp add: is_aligned_weaken [OF tcb_aligned])
+      apply (rule corres_guard_imp [OF transferCaps_corres], clarsimp+)
+       apply (clarsimp simp: is_cnode_or_valid_arch_def
+                      split: option.split option.split_asm)
+      apply clarsimp
+      apply (auto split: option.split_asm simp: newroot_rel_def)[1]
+     apply (simp add: invokeTCB_def liftM_def[symmetric]
+                      o_def dc_def[symmetric])
+     apply (rule corres_guard_imp [OF suspend_corres], simp+)
+    apply (simp add: invokeTCB_def liftM_def[symmetric]
+                     o_def dc_def[symmetric])
+    apply (rule corres_guard_imp [OF restart_corres], simp+)
+   apply (simp add:invokeTCB_def)
    apply (rename_tac option)
-   apply (case_tac option
-          ; clarsimp simp: liftM_def[symmetric] o_def dc_def[symmetric])
-    apply (rule corres_guard_imp[OF unbindNotification_corres]; clarsimp)
-   apply (rule corres_guard_imp[OF bindNotification_corres]
-          ; clarsimp simp: obj_at'_def obj_at_def is_ntfn_def)
-  apply (clarsimp simp: invokeTCB_def tlsBaseRegister_def)
+   apply (case_tac option)
+    apply simp
+    apply (rule corres_guard_imp)
+      apply (rule corres_split[OF unbindNotification_corres])
+        apply (rule corres_trivial, simp)
+       apply wp+
+     apply (clarsimp)
+    apply clarsimp
+   apply simp
+   apply (rule corres_guard_imp)
+     apply (rule corres_split[OF bindNotification_corres])
+       apply (rule corres_trivial, simp)
+      apply wp+
+    apply clarsimp
+    apply (clarsimp simp: obj_at_def is_ntfn)
+   apply (clarsimp simp: obj_at'_def projectKOs)
+  apply (simp add: invokeTCB_def tlsBaseRegister_def)
   apply (rule corres_guard_imp)
     apply (rule corres_split[OF TcbAcc_R.asUser_setRegister_corres])
       apply (rule corres_split[OF Bits_R.getCurThread_corres])
@@ -2523,10 +1758,9 @@ lemma invokeTCB_corres:
             apply simp
            apply (rule TcbAcc_R.rescheduleRequired_corres)
           apply (rule corres_trivial, simp)
-         apply (solves \<open>wpsimp wp: hoare_drop_imp\<close>)+
-   apply (clarsimp simp: invs_valid_tcbs valid_sched_weak_strg invs_psp_aligned
-                         valid_sched_active_scs_valid)
-  apply (clarsimp simp: invs_valid_queues' invs_queues invs'_valid_tcbs' invs_valid_release_queue)
+         apply (wpsimp wp: hoare_drop_imp)+
+   apply (fastforce dest: valid_sched_valid_queues simp: valid_sched_weak_strg einvs_valid_etcbs)
+  apply fastforce
   done
 
 lemma tcbBoundNotification_caps_safe[simp]:
@@ -2534,6 +1768,17 @@ lemma tcbBoundNotification_caps_safe[simp]:
      getF (tcbBoundNotification_update (\<lambda>_. Some ntfnptr) tcb) = getF tcb"
   by (case_tac tcb, simp add: tcb_cte_cases_def)
 
+lemma valid_bound_ntfn_lift:
+  assumes P: "\<And>P T p. \<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
+  shows      "\<lbrace>\<lambda>s. valid_bound_ntfn' a s\<rbrace> f \<lbrace>\<lambda>rv s. valid_bound_ntfn' a s\<rbrace>"
+  apply (simp add: valid_bound_ntfn'_def, case_tac a, simp_all)
+  apply (wp typ_at_lifts[OF P])+
+  done
+
+crunch setBoundNotification
+  for sym_heap_sched_pointers[wp]: sym_heap_sched_pointers
+  (ignore: threadSet wp: threadSet_sched_pointers)
+
 lemma bindNotification_invs':
   "\<lbrace>bound_tcb_at' ((=) None) tcbptr
        and ex_nonz_cap_to' ntfnptr
@@ -2542,16 +1787,33 @@ lemma bindNotification_invs':
        and invs'\<rbrace>
     bindNotification tcbptr ntfnptr
    \<lbrace>\<lambda>_. invs'\<rbrace>"
-  unfolding bindNotification_def invs'_def valid_dom_schedule'_def
+  including no_pre
+  apply (simp add: bindNotification_def invs'_def valid_state'_def)
   apply (rule bind_wp[OF _ get_ntfn_sp'])
-  apply (wpsimp wp: set_ntfn_valid_pspace' sbn_sch_act' sbn_valid_queues valid_irq_node_lift
-                    setBoundNotification_ct_not_inQ valid_bound_ntfn_lift
-                    untyped_ranges_zero_lift irqs_masked_lift
-              simp: cteCaps_of_def)
-  apply (frule(1) ntfn_ko_at_valid_objs_valid_ntfn'[OF _ valid_pspace_valid_objs'])
-  apply (clarsimp simp: obj_at'_def pred_tcb_at'_def valid_ntfn'_def projectKOs o_def
-                        global'_no_ex_cap
-                 split: ntfn.splits)
+  apply (rule hoare_pre)
+   apply (wp set_ntfn_valid_pspace' sbn_sch_act' valid_irq_node_lift
+             setBoundNotification_ct_not_inQ valid_bound_ntfn_lift
+             untyped_ranges_zero_lift
+          | clarsimp dest!: global'_no_ex_cap simp: cteCaps_of_def)+
+  apply (clarsimp simp: valid_pspace'_def)
+  apply (cases "tcbptr = ntfnptr")
+   apply (clarsimp dest!: pred_tcb_at' simp: obj_at'_def projectKOs)
+  apply (clarsimp simp: pred_tcb_at' conj_comms o_def)
+  apply (subst delta_sym_refs, assumption)
+    apply (fastforce simp: ntfn_q_refs_of'_def obj_at'_def projectKOs
+                    dest!: symreftype_inverse'
+                    split: ntfn.splits if_split_asm)
+   apply (clarsimp split: if_split_asm)
+    apply (fastforce simp: tcb_st_refs_of'_def
+                    dest!: bound_tcb_at_state_refs_ofD'
+                    split: if_split_asm thread_state.splits)
+   apply (fastforce simp: obj_at'_def projectKOs state_refs_of'_def
+                   dest!: symreftype_inverse')
+  apply (clarsimp simp: valid_pspace'_def)
+  apply (frule_tac P="\<lambda>k. k=ntfn" in obj_at_valid_objs', simp)
+  apply (clarsimp simp: valid_obj'_def projectKOs valid_ntfn'_def obj_at'_def
+                    dest!: pred_tcb_at'
+                    split: ntfn.splits)
   done
 
 lemma tcbntfn_invs':
@@ -2570,20 +1832,22 @@ lemma setTLSBase_invs'[wp]:
   by (wpsimp simp: invokeTCB_def)
 
 lemma tcbinv_invs':
-  "\<lbrace>invs' and sch_act_simple and tcb_inv_wf' ti\<rbrace>
+  "\<lbrace>invs' and sch_act_simple and ct_in_state' runnable' and tcb_inv_wf' ti\<rbrace>
      invokeTCB ti
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
-  apply (case_tac ti; simp only:)
-          apply (simp add: invokeTCB_def)
-          apply wp
-          apply (clarsimp simp: invs'_def
-                          dest!: global'_no_ex_cap)
+  apply (case_tac ti, simp_all only:)
          apply (simp add: invokeTCB_def)
-         apply (wp restart_invs')
-         apply (clarsimp simp: invs'_def
+         apply wp
+         apply (clarsimp simp: invs'_def valid_state'_def
                          dest!: global'_no_ex_cap)
-        apply (wpsimp wp: tc_caps_invs' tc_sched_invs' writereg_invs' readreg_invs'
-                          copyreg_invs' tcbntfn_invs')+
+        apply (simp add: invokeTCB_def)
+        apply (wp restart_invs')
+        apply (clarsimp simp: invs'_def valid_state'_def
+                        dest!: global'_no_ex_cap)
+       apply (wp tc_invs')
+       apply (clarsimp split: option.split dest!: isCapDs)
+      apply (wp writereg_invs' readreg_invs' copyreg_invs' tcbntfn_invs'
+             | simp)+
   done
 
 declare assertDerived_wp [wp]
@@ -2721,21 +1985,19 @@ 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 (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile> (fst x)))
+       (cur_tcb and valid_etcbs 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')"
   apply (cases args; cases extras; cases extras';
-         clarsimp simp: decode_set_priority_def decodeSetPriority_def emptyTCSched_def)
+         clarsimp simp: decode_set_priority_def decodeSetPriority_def)
   apply (rename_tac auth_cap auth_slot auth_path rest auth_cap' rest')
   apply (rule corres_split_eqrE)
-     apply (case_tac auth_cap; clarsimp simp: corres_returnOk)
+     apply corresKsimp
     apply (rule corres_splitEE[OF checkPrio_corres])
       apply (rule corres_returnOkTT)
       apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2))
-     apply wpsimp+
-   apply (wpsimp simp: valid_cap_def valid_cap'_def)+
-  done
+  by (wpsimp simp: valid_cap_def valid_cap'_def)+
 
 lemma decodeSetMCPriority_corres:
   "\<lbrakk> cap_relation cap cap'; is_thread_cap cap;
@@ -2746,20 +2008,18 @@ lemma decodeSetMCPriority_corres:
        (decode_set_mcpriority args cap slot extras)
        (decodeSetMCPriority args cap' extras')"
   apply (cases args; cases extras; cases extras';
-         clarsimp simp: decode_set_mcpriority_def decodeSetMCPriority_def emptyTCSched_def)
+         clarsimp simp: decode_set_mcpriority_def decodeSetMCPriority_def)
   apply (rename_tac auth_cap auth_slot auth_path rest auth_cap' rest')
   apply (rule corres_split_eqrE)
-     apply (case_tac auth_cap; clarsimp simp: corres_returnOk)
+     apply corresKsimp
     apply (rule corres_splitEE[OF checkPrio_corres])
       apply (rule corres_returnOkTT)
       apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2))
-     apply wpsimp+
-   apply (wpsimp simp: valid_cap_def valid_cap'_def)+
-  done
+  by (wpsimp simp: valid_cap_def valid_cap'_def)+
 
 lemma getMCP_sp:
   "\<lbrace>P\<rbrace> threadGet tcbMCP t \<lbrace>\<lambda>rv. mcpriority_tcb_at' (\<lambda>st. st = rv) t and P\<rbrace>"
-  apply (simp add: threadGet_getObject)
+  apply (simp add: threadGet_def)
   apply wp
   apply (simp add: o_def pred_tcb_at'_def)
   apply (wp getObject_tcb_wp)
@@ -2796,26 +2056,16 @@ lemma checkPrio_lt_ct_weak:
   apply (clarsimp simp: pred_tcb_at'_def obj_at'_def)
   by (rule le_ucast_ucast_le) simp
 
-lemma checkPrio_lt_ct_weak':
-  "\<lbrace>P\<rbrace> checkPrio prio auth \<lbrace>\<lambda>rv s. P s \<and> mcpriority_tcb_at' (\<lambda>mcp. ucast prio \<le> mcp) auth s\<rbrace>, -"
-  apply (wpsimp wp: hoare_vcg_conj_liftE1)
-    apply (wpsimp wp: checkPrio_inv)
-   apply (wpsimp wp: checkPrio_lt_ct_weak)+
-  done
-
-crunch checkPrio
-  for tcb_at'[wp]: "tcb_at' t"
-  and ex_nonz_cap_to'[wp]: "ex_nonz_cap_to' t"
-
 lemma decodeSetPriority_wf[wp]:
   "\<lbrace>invs' and tcb_at' t and ex_nonz_cap_to' t \<rbrace>
-   decodeSetPriority args (ThreadCap t) extras
-   \<lbrace>tcb_inv_wf'\<rbrace>,-"
+    decodeSetPriority args (ThreadCap t) extras \<lbrace>tcb_inv_wf'\<rbrace>,-"
   unfolding decodeSetPriority_def
-  apply (wpsimp wp: checkPrio_lt_ct_weak simp: emptyTCSched_def)
-  apply (clarsimp simp: maxPriority_def numPriorities_def emptyTCSched_def)
+  apply (rule hoare_pre)
+  apply (wp checkPrio_lt_ct_weak | wpc | simp | wp (once) checkPrio_inv)+
+  apply (clarsimp simp: maxPriority_def numPriorities_def)
   using max_word_max [of \<open>UCAST(32 \<rightarrow> 8) x\<close> for x]
-  by (simp add: max_word_mask numeral_eq_Suc mask_Suc)
+  apply (simp add: max_word_mask numeral_eq_Suc mask_Suc)
+  done
 
 lemma decodeSetPriority_inv[wp]:
   "\<lbrace>P\<rbrace> decodeSetPriority args cap extras \<lbrace>\<lambda>rv. P\<rbrace>"
@@ -2828,13 +2078,14 @@ lemma decodeSetPriority_inv[wp]:
 
 lemma decodeSetMCPriority_wf[wp]:
   "\<lbrace>invs' and tcb_at' t and ex_nonz_cap_to' t \<rbrace>
-   decodeSetMCPriority args (ThreadCap t) extras
-   \<lbrace>tcb_inv_wf'\<rbrace>,-"
+    decodeSetMCPriority args (ThreadCap t) extras \<lbrace>tcb_inv_wf'\<rbrace>,-"
   unfolding decodeSetMCPriority_def Let_def
-  apply (wpsimp wp: checkPrio_lt_ct_weak simp: emptyTCSched_def)
-  apply (clarsimp simp: maxPriority_def numPriorities_def emptyTCSched_def)
+  apply (rule hoare_pre)
+  apply (wp checkPrio_lt_ct_weak | wpc | simp | wp (once) checkPrio_inv)+
+  apply (clarsimp simp: maxPriority_def numPriorities_def)
   using max_word_max [of \<open>UCAST(32 \<rightarrow> 8) x\<close> for x]
-  by (simp add: max_word_mask numeral_eq_Suc mask_Suc)
+  apply (simp add: max_word_mask numeral_eq_Suc mask_Suc)
+  done
 
 lemma decodeSetMCPriority_inv[wp]:
   "\<lbrace>P\<rbrace> decodeSetMCPriority args cap extras \<lbrace>\<lambda>rv. P\<rbrace>"
@@ -2845,114 +2096,40 @@ lemma decodeSetMCPriority_inv[wp]:
              | wpcw)+
   done
 
-lemma decodeSetSchedParams_wf:
-  "\<lbrace>invs' and tcb_at' t and ex_nonz_cap_to' t and cte_at' slot
-    and (\<lambda>s. \<forall>x \<in> set extras. real_cte_at' (snd x) s
-                              \<and> s \<turnstile>' fst x \<and> (\<forall>y \<in> zobj_refs' (fst x). ex_nonz_cap_to' y s))\<rbrace>
-   decodeSetSchedParams args (ThreadCap t) slot extras
+lemma decodeSetSchedParams_wf[wp]:
+  "\<lbrace>invs' and tcb_at' t and ex_nonz_cap_to' t \<rbrace>
+    decodeSetSchedParams args (ThreadCap t) extras
    \<lbrace>tcb_inv_wf'\<rbrace>,-"
-  unfolding decodeSetSchedParams_def scReleased_def refillReady_def scActive_def isBlocked_def
-  apply (cases args; cases extras; clarsimp; (solves \<open>wpsimp wp: checkPrio_inv\<close>)?)
-  apply (clarsimp split: list.splits; safe; (solves \<open>wpsimp wp: checkPrio_inv\<close>)?)
-  apply (clarsimp simp: validE_R_def)
-  apply (rule bindE_wp_fwd_skip, wpsimp wp: checkPrio_inv)
-  apply (rule bindE_wp[OF _ checkPrio_lt_ct_weak'[unfolded validE_R_def]])+
-  apply (wpsimp wp: checkPrio_lt_ct_weak gts_wp' threadGet_wp)
-  apply (clarsimp simp: maxPriority_def numPriorities_def pred_tcb_at'_def obj_at'_def projectKOs)
+  unfolding decodeSetSchedParams_def
+  apply (wpsimp wp: checkPrio_lt_ct_weak | wp (once) checkPrio_inv)+
+  apply (clarsimp simp: maxPriority_def numPriorities_def)
   using max_word_max [of \<open>UCAST(32 \<rightarrow> 8) x\<close> for x]
-  apply (auto simp: max_word_mask numeral_eq_Suc mask_Suc)
-  done
-
-(* FIXME RT: There's probably a way to avoid this using cap.case_eq_if and corres_if, but it
-             doesn't seem easy to do in a nice way. This lemma is used to "keep" the cap type
-             information all the way through to the final WP proofs. *)
-lemma corres_case_cap_null_sc:
-  assumes "cap_relation cp cp'"
-          "cp = cap.NullCap \<Longrightarrow> corres_underlying sr nf nf' rr Pnul Pnul' case_nul case_nul'"
-          "\<And>sc_ptr n. cp = cap.SchedContextCap sc_ptr n \<Longrightarrow>
-               corres_underlying sr nf nf' rr (Psc sc_ptr n) (Psc' sc_ptr n) (case_sc sc_ptr n)
-                   (case_sc' sc_ptr (min_sched_context_bits + n))"
-          "\<lbrakk>cp \<noteq> cap.NullCap; \<not>cap.is_SchedContextCap cp\<rbrakk> \<Longrightarrow>
-               corres_underlying sr nf nf' rr Pother Pother' case_other case_other'"
-  shows "corres_underlying sr nf nf' rr
-             (\<lambda>s. (cp = cap.NullCap \<longrightarrow> Pnul s)
-                  \<and> (\<forall>sc_ptr n. cp = cap.SchedContextCap sc_ptr n \<longrightarrow> Psc sc_ptr n s)
-                  \<and> (\<not>cap.is_SchedContextCap cp \<and> cp \<noteq> cap.NullCap \<longrightarrow> Pother s))
-             (\<lambda>s. (cp' = NullCap \<longrightarrow> Pnul' s)
-                  \<and> (\<forall>sc_ptr n. cp = cap.SchedContextCap sc_ptr n \<longrightarrow> Psc' sc_ptr n s)
-                  \<and> (\<not>cap.is_SchedContextCap cp \<and> cp \<noteq> cap.NullCap \<longrightarrow> Pother' s))
-             (case cp of cap.NullCap \<Rightarrow> case_nul
-              | cap.SchedContextCap sc_ptr n \<Rightarrow> case_sc sc_ptr n
-              | _ \<Rightarrow> case_other)
-             (case cp' of capability.NullCap \<Rightarrow> case_nul'
-              | capability.SchedContextCap sc_ptr n \<Rightarrow> case_sc' sc_ptr n
-              | _ \<Rightarrow> case_other')"
-  apply (insert assms)
-  apply (case_tac cp; clarsimp)
+  apply (simp add: max_word_mask numeral_eq_Suc mask_Suc)
   done
 
 lemma decodeSetSchedParams_corres:
-  "\<lbrakk> cap_relation cap cap'; is_thread_cap cap; slot' = cte_map slot;
+  "\<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)
-       (invs and valid_sched and (\<lambda>s. s \<turnstile> cap \<and> (\<forall>x \<in> set extras. s \<turnstile> (fst x))))
-       (invs' and (\<lambda>s. s \<turnstile>' cap' \<and> (\<forall>x \<in> set extras'. s \<turnstile>' (fst x))))
+       (cur_tcb and valid_etcbs 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)
-       (decodeSetSchedParams args cap' slot' extras')"
-  apply (clarsimp simp: is_cap_simps)
-  apply (simp add: decode_set_sched_params_def decodeSetSchedParams_def decode_update_sc_def
-                   check_handler_ep_def unlessE_whenE)
+       (decodeSetSchedParams args cap' extras')"
+  apply (simp add: decode_set_sched_params_def decodeSetSchedParams_def)
   apply (cases "length args < 2")
    apply (clarsimp split: list.split)
-  apply (cases "length extras < 3")
+  apply (cases "length extras < 1")
    apply (clarsimp split: list.split simp: list_all2_Cons2)
   apply (clarsimp simp: list_all2_Cons1 neq_Nil_conv val_le_length_Cons linorder_not_less)
-  apply (case_tac cap; clarsimp)
-  apply (rule corres_split_eqrE[THEN corres_guard_imp])
-       apply (clarsimp split: cap.splits
-              ; intro conjI impI allI
-              ; fastforce intro: corres_returnOkTT)
-      apply (rule corres_split_norE[OF checkPrio_corres])
-        apply (rule corres_split_norE[OF checkPrio_corres])
-          apply (rule corres_split_eqrE)
-             apply (rule corres_case_cap_null_sc[where Pother=\<top> and Pother'=\<top>]
-                    ; clarsimp
-                    ; (wpfix add: capability.sel)?)
-              apply (clarsimp simp: getCurThread_def)
-              apply (rule corres_split_liftEE[OF corres_gets_trivial])
-                 apply (clarsimp simp: state_relation_def)
-                apply (rule whenE_throwError_corres; clarsimp)
-                apply (rule corres_returnOkTT, simp)
-               apply wpsimp
-              apply wpsimp
-             apply (clarsimp simp: get_tcb_obj_ref_def)
-             apply (rule corres_split_eqrE)
-                apply clarsimp
-                apply (rule threadGet_corres)
-                apply (clarsimp simp: tcb_relation_def)
-               apply (rule whenE_throwError_corres; clarsimp)
-               apply (rule corres_split_liftEE[OF get_sc_corres])
-                 apply (rule whenE_throwError_corres; clarsimp simp: sc_relation_def)
-                 apply (rule corres_split_liftEE[OF is_blocked_corres])
-                   apply (rule corres_split_liftEE[OF get_sc_released_corres])
-                     apply (rule whenE_throwError_corres; clarsimp)
-                     apply (rule corres_returnOkTT, simp)
-                    apply (wpsimp simp: is_blocked_def)+
-              apply (wpsimp wp: thread_get_wp' threadGet_wp)+
-            apply (clarsimp simp: bindE_assoc)
-            apply (rule whenE_throwError_corres; simp add: cap_rel_valid_fh)
-            apply (rule corres_returnOkTT)
-            apply (clarsimp simp: newroot_rel_def)
-           apply (wpsimp wp: check_prio_inv checkPrio_inv)+
-   apply (fastforce simp: valid_cap_def)
-  apply (clarsimp simp: valid_cap_simps')
-  apply normalise_obj_at'
-  apply (intro exI impI conjI allI)
-    apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
-    apply (rename_tac obj)
-    apply (case_tac obj; clarsimp)
-   apply (erule invs_valid_objs')
-  apply (clarsimp simp: obj_at'_def)
+  apply (rule corres_split_eqrE)
+     apply corresKsimp
+    apply (rule corres_split_norE[OF checkPrio_corres])
+      apply (rule corres_splitEE[OF checkPrio_corres])
+        apply (rule corres_returnOkTT)
+        apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2))
+       apply (wpsimp wp: check_prio_inv checkPrio_inv
+                   simp: valid_cap_def valid_cap'_def)+
   done
 
 lemma checkValidIPCBuffer_corres:
@@ -2960,7 +2137,9 @@ lemma checkValidIPCBuffer_corres:
    corres (ser \<oplus> dc) \<top> \<top>
      (check_valid_ipc_buffer vptr cap)
      (checkValidIPCBuffer vptr cap')"
-  apply (simp add: check_valid_ipc_buffer_def checkValidIPCBuffer_def
+  apply (simp add: check_valid_ipc_buffer_def
+                   checkValidIPCBuffer_def
+                   ARM_H.checkValidIPCBuffer_def
                    unlessE_def Let_def
             split: cap_relation_split_asm arch_cap.split_asm bool.splits)
   apply (simp add: capTransferDataSize_def msgMaxLength_def
@@ -2975,7 +2154,9 @@ lemma checkValidIPCBuffer_ArchObject_wp:
   "\<lbrace>\<lambda>s. isArchObjectCap cap \<and> is_aligned x msg_align_bits \<longrightarrow> P s\<rbrace>
      checkValidIPCBuffer x cap
    \<lbrace>\<lambda>rv s. P s\<rbrace>,-"
-  apply (simp add: checkValidIPCBuffer_def whenE_def unlessE_def
+  apply (simp add: checkValidIPCBuffer_def
+                   ARM_H.checkValidIPCBuffer_def
+                   whenE_def unlessE_def
              cong: capability.case_cong
                    arch_capability.case_cong
             split del: if_split)
@@ -2993,21 +2174,22 @@ lemma decodeSetIPCBuffer_corres:
                             (\<lambda>s. invs' s \<and> (\<forall>x \<in> set extras'. cte_at' (snd x) s))
        (decode_set_ipc_buffer args cap slot extras)
        (decodeSetIPCBuffer args cap' (cte_map slot) extras')"
-  apply (simp add: decode_set_ipc_buffer_def decodeSetIPCBuffer_def)
+  apply (simp    add: decode_set_ipc_buffer_def decodeSetIPCBuffer_def
+           split del: if_split)
   apply (cases args)
    apply simp
   apply (cases extras)
    apply simp
-  apply (clarsimp simp: list_all2_Cons1 liftME_def[symmetric] is_cap_simps)
-  apply (clarsimp simp: returnOk_def newroot_rel_def emptyTCCaps_def)
+  apply (clarsimp simp: list_all2_Cons1 liftME_def[symmetric]
+                        is_cap_simps
+             split del: if_split)
+  apply (clarsimp simp add: returnOk_def newroot_rel_def)
   apply (rule corres_guard_imp)
     apply (rule corres_splitEE)
        apply (rule deriveCap_corres; simp)
-      apply (simp add: o_def newroot_rel_def dc_def[symmetric])
-      apply (rule corres_rel_imp)
-       apply (erule checkValidIPCBuffer_corres)
-      apply (simp add: dc_def)
-     apply wpsimp+
+        apply (simp add: o_def newroot_rel_def split_def dc_def[symmetric])
+        apply (erule checkValidIPCBuffer_corres)
+       apply (wp hoareE_TrueI | simp)+
   apply fastforce
   done
 
@@ -3016,7 +2198,7 @@ lemma decodeSetIPC_wf[wp]:
         and (\<lambda>s. \<forall>v \<in> set extras. s \<turnstile>' fst v \<and> cte_at' (snd v) s)\<rbrace>
      decodeSetIPCBuffer args (ThreadCap t) slot extras
    \<lbrace>tcb_inv_wf'\<rbrace>,-"
-  apply (simp   add: decodeSetIPCBuffer_def Let_def whenE_def emptyTCCaps_def
+  apply (simp   add: decodeSetIPCBuffer_def Let_def whenE_def
           split del: if_split cong: list.case_cong prod.case_cong)
   apply (rule hoare_pre)
    apply (wp | wpc | simp)+
@@ -3027,14 +2209,14 @@ lemma decodeSetIPC_wf[wp]:
   done
 
 lemma decodeSetIPCBuffer_is_tc[wp]:
-  "\<lbrace>\<top>\<rbrace> decodeSetIPCBuffer args cap slot extras \<lbrace>\<lambda>rv s. isThreadControlCaps rv\<rbrace>,-"
-  apply (simp add: decodeSetIPCBuffer_def Let_def emptyTCCaps_def
+  "\<lbrace>\<top>\<rbrace> decodeSetIPCBuffer args cap slot extras \<lbrace>\<lambda>rv s. isThreadControl rv\<rbrace>,-"
+  apply (simp add: decodeSetIPCBuffer_def Let_def
              split del: if_split cong: list.case_cong prod.case_cong)
   apply (rule hoare_pre)
    apply (wp | wpc)+
-   apply (simp only: isThreadControlCaps_def tcbinvocation.simps)
+   apply (simp only: isThreadControl_def tcbinvocation.simps)
    apply wp+
-  apply (clarsimp simp: isThreadControlCaps_def)
+  apply (clarsimp simp: isThreadControl_def)
   done
 
 crunch decodeSetIPCBuffer
@@ -3074,54 +2256,56 @@ lemma cap_CNode_case_throw:
      = (doE unlessE (isCNodeCap cap) (throw x); m odE)"
   by (cases cap, simp_all add: isCap_simps unlessE_def)
 
-lemma decodeCVSpace_corres:
+lemma decodeSetSpace_corres:
   notes if_cong [cong]
   shows
- "\<lbrakk>cap_relation cap cap';
-   list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras';
-   is_thread_cap cap\<rbrakk> \<Longrightarrow>
-  corres (ser \<oplus> (\<lambda>abs_inv conc_inv. tcbinv_relation abs_inv conc_inv))
-      (invs and valid_cap cap and (\<lambda>s. \<forall>x \<in> set extras. cte_at (snd x) s))
-      (invs' and valid_cap' cap' and (\<lambda>s. \<forall>x \<in> set extras'. cte_at' (snd x) s))
-      (decode_cv_space args cap slot extras)
-      (decodeCVSpace args cap' (cte_map slot) extras')"
-  apply (simp    add: decode_cv_space_def decodeCVSpace_def
+ "\<lbrakk> cap_relation cap cap'; list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras';
+      is_thread_cap cap \<rbrakk> \<Longrightarrow>
+  corres (ser \<oplus> tcbinv_relation)
+         (invs and valid_cap cap and (\<lambda>s. \<forall>x \<in> set extras. cte_at (snd x) s))
+         (invs' and valid_cap' cap'  and (\<lambda>s. \<forall>x \<in> set extras'. cte_at' (snd x) s))
+      (decode_set_space args cap slot extras)
+      (decodeSetSpace args cap' (cte_map slot) extras')"
+  apply (simp    add: decode_set_space_def decodeSetSpace_def
                       Let_def
            split del: if_split)
-  apply (cases "2 \<le> length args \<and> 2 \<le> length extras'")
+  apply (cases "3 \<le> length args \<and> 2 \<le> length extras'")
    apply (clarsimp simp: val_le_length_Cons list_all2_Cons2
               split del: if_split)
-   apply (simp add: liftE_bindE liftM_def cap_CNode_case_throw
-                    unlessE_throwError_returnOk unlessE_whenE
+   apply (simp add: liftE_bindE liftM_def unlessE_whenE
                     getThreadCSpaceRoot getThreadVSpaceRoot
                  split del: if_split)
    apply (rule corres_guard_imp)
      apply (rule corres_split[OF slotCapLongRunningDelete_corres])
         apply (clarsimp simp: is_cap_simps get_tcb_ctable_ptr_def cte_map_tcb_0)
        apply (rule corres_split[OF slotCapLongRunningDelete_corres])
-          apply (clarsimp simp: is_cap_simps get_tcb_vtable_ptr_def cte_map_tcb_1[simplified])
+          apply (clarsimp simp: is_cap_simps get_tcb_vtable_ptr_def cte_map_tcb_1[simplified] objBits_defs)
          apply (rule corres_split_norE)
             apply (rule corres_whenE)
               apply simp
              apply (rule corres_trivial, simp)
             apply simp
-           apply (simp(no_asm) add: bindE_assoc
+           apply (simp(no_asm) add: split_def unlessE_throwError_returnOk
+                                    bindE_assoc cap_CNode_case_throw unlessE_whenE
                          split del: if_split)
-           apply (rule corres_splitEE[OF deriveCap_corres])
-               apply (fastforce dest: list_all2_nthD2[where p=0] simp: cap_map_update_data)
-              apply (fastforce dest: list_all2_nthD2[where p=0])
+           apply (rule corres_splitEE)
+              apply (rule deriveCap_corres)
+               apply (clarsimp simp: cap_map_update_data)
+              apply simp
              apply (rule corres_split_norE)
                 apply (rule corres_whenE)
                   apply simp
                  apply (rule corres_trivial, simp)
                 apply simp
-               apply (rule corres_splitEE[OF deriveCap_corres])
-                   apply (clarsimp simp: cap_map_update_data)
+               apply (rule corres_splitEE)
+                  apply (rule deriveCap_corres)
+                   apply (fastforce dest: list_all2_nthD2[where p=0] simp: cap_map_update_data)
                   apply simp
                  apply (rule corres_split_norE)
+                    apply (unfold unlessE_whenE)
                     apply (rule corres_whenE)
                       apply (case_tac vroot_cap', simp_all add:
-                                       is_valid_vtable_root_def
+                                       is_valid_vtable_root_def isValidVTableRoot_def
                                        ARM_H.isValidVTableRoot_def)[1]
                       apply (rename_tac arch_cap)
                       apply (clarsimp, case_tac arch_cap, simp_all)[1]
@@ -3146,74 +2330,12 @@ lemma decodeCVSpace_corres:
   apply (clarsimp split: list.split)
   done
 
-lemma decode_cv_space_is_ThreadControlCaps[wp]:
-  "\<lbrace>\<top>\<rbrace>
-   decode_cv_space args cap slot excaps
-   \<lbrace>\<lambda>rv s. tcb_invocation.is_ThreadControlCaps rv\<rbrace>, -"
-  apply (clarsimp simp: decode_cv_space_def returnOk_def validE_R_def)
-  apply (rule bindE_wp_fwd_skip, wpsimp)+
-  apply (clarsimp simp: return_def validE_def valid_def)
-  done
-
-lemma decodeSetSpace_corres:
- "\<lbrakk>cap_relation cap cap';
-   list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras';
-   is_thread_cap cap\<rbrakk> \<Longrightarrow>
-  corres (ser \<oplus> tcbinv_relation)
-         (invs and valid_cap cap and (\<lambda>s. \<forall>x \<in> set extras. cte_at (snd x) s))
-         (invs' and valid_cap' cap' and (\<lambda>s. \<forall>x \<in> set extras'. cte_at' (snd x) s))
-      (decode_set_space args cap slot extras)
-      (decodeSetSpace args cap' (cte_map slot) extras')"
-  apply (simp add: decode_set_space_def decodeSetSpace_def check_handler_ep_def unlessE_whenE)
-  apply (cases "\<not> (2 \<le> length args \<and> 3 \<le> length extras')")
-   apply (clarsimp dest!: list_all2_lengthD split: list.split)
-   apply fastforce
-  apply (clarsimp simp: val_le_length_Cons list_all2_Cons2
-             split del: if_split)
-  apply (rule corres_guard_imp)
-    apply (rule corres_splitEE[OF decodeCVSpace_corres])
-         apply blast
-        apply fastforce+
-      apply (rename_tac abs_space conc_space)
-      apply (rule_tac F="tcb_invocation.is_ThreadControlCaps abs_space" in corres_gen_asm)
-      apply clarsimp
-      apply (intro conjI impI; simp add: cap_rel_valid_fh)
-      apply (prop_tac "newroot_rel (tc_new_croot abs_space) (tcCapsCRoot conc_space)")
-       apply (case_tac abs_space; clarsimp)
-      apply (prop_tac "newroot_rel (tc_new_vroot abs_space) (tcCapsVRoot conc_space)")
-       apply (case_tac abs_space; clarsimp)
-      apply (rule corres_returnOkTT)
-      apply (clarsimp simp: returnOk_def newroot_rel_def is_cap_simps list_all2_conv_all_nth)
-     apply wp+
-   apply fastforce+
-  done
-
-lemma decodeCVSpace_wf[wp]:
-  "\<lbrace>invs' and tcb_at' t and ex_nonz_cap_to' t and cte_at' slot
-      and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile>' fst x \<and> cte_at' (snd x) s \<and> t \<noteq> snd x \<and> t + 16 \<noteq> snd x)\<rbrace>
-     decodeCVSpace args (ThreadCap t) slot extras
-   \<lbrace>tcb_inv_wf'\<rbrace>,-"
-  apply (simp       add: decodeCVSpace_def Let_def split_def
-                         unlessE_def getThreadVSpaceRoot getThreadCSpaceRoot
-                         cap_CNode_case_throw
-              split del: if_split cong: if_cong list.case_cong)
-  apply (rule hoare_pre)
-   apply (wp
-             | simp    add: o_def split_def
-                 split del: if_split
-             | wpc
-             | rule hoare_drop_imps)+
-  apply (clarsimp simp del: length_greater_0_conv
-                 split del: if_split)
-  apply (simp del: length_greater_0_conv add: valid_updateCapDataI)
-  done
-
 lemma decodeSetSpace_wf[wp]:
   "\<lbrace>invs' and tcb_at' t and ex_nonz_cap_to' t and cte_at' slot
       and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile>' fst x \<and> cte_at' (snd x) s \<and> t \<noteq> snd x \<and> t + 16 \<noteq> snd x)\<rbrace>
      decodeSetSpace args (ThreadCap t) slot extras
    \<lbrace>tcb_inv_wf'\<rbrace>,-"
-  apply (simp       add: decodeSetSpace_def decodeCVSpace_def Let_def split_def
+  apply (simp       add: decodeSetSpace_def Let_def split_def
                          unlessE_def getThreadVSpaceRoot getThreadCSpaceRoot
                          cap_CNode_case_throw
               split del: if_split cong: if_cong list.case_cong)
@@ -3228,20 +2350,9 @@ lemma decodeSetSpace_wf[wp]:
   apply (simp del: length_greater_0_conv add: valid_updateCapDataI)
   done
 
-lemma decodeCVSpace_inv[wp]:
-  "decodeCVSpace args cap slot extras \<lbrace>P\<rbrace>"
-  apply (simp       add: decodeCVSpace_def Let_def split_def
-                         unlessE_def getThreadVSpaceRoot getThreadCSpaceRoot
-              split del: if_split cong: if_cong list.case_cong)
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps
-            | simp add: o_def split_def split del: if_split
-            | wpcw)+
-  done
-
 lemma decodeSetSpace_inv[wp]:
   "\<lbrace>P\<rbrace> decodeSetSpace args cap slot extras \<lbrace>\<lambda>rv. P\<rbrace>"
-  apply (simp       add: decodeSetSpace_def decodeCVSpace_def Let_def split_def
+  apply (simp       add: decodeSetSpace_def Let_def split_def
                          unlessE_def getThreadVSpaceRoot getThreadCSpaceRoot
               split del: if_split cong: if_cong list.case_cong)
   apply (rule hoare_pre)
@@ -3250,44 +2361,20 @@ lemma decodeSetSpace_inv[wp]:
             | wpcw)+
   done
 
-lemma decodeCVSpace_is_tc[wp]:
-  "\<lbrace>\<top>\<rbrace> decodeCVSpace args cap slot extras \<lbrace>\<lambda>rv s. isThreadControlCaps rv\<rbrace>,-"
-  apply (simp       add: decodeCVSpace_def Let_def split_def
-                         unlessE_def getThreadVSpaceRoot getThreadCSpaceRoot
-              split del: if_split cong: list.case_cong)
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps
-           | simp only: isThreadControlCaps_def tcbinvocation.simps
-           | wpcw)+
-  apply simp
-  done
-
 lemma decodeSetSpace_is_tc[wp]:
-  "\<lbrace>\<top>\<rbrace> decodeSetSpace args cap slot extras \<lbrace>\<lambda>rv s. isThreadControlCaps rv\<rbrace>,-"
+  "\<lbrace>\<top>\<rbrace> decodeSetSpace args cap slot extras \<lbrace>\<lambda>rv s. isThreadControl rv\<rbrace>,-"
   apply (simp       add: decodeSetSpace_def Let_def split_def
                          unlessE_def getThreadVSpaceRoot getThreadCSpaceRoot
               split del: if_split cong: list.case_cong)
   apply (rule hoare_pre)
    apply (wp hoare_drop_imps
-           | simp only: isThreadControlCaps_def tcbinvocation.simps
-           | wpcw)+
-  apply simp
-  done
-
-lemma decodeCVSpace_tc_target[wp]:
-  "\<lbrace>\<lambda>s. P (capTCBPtr cap)\<rbrace> decodeCVSpace args cap slot extras \<lbrace>\<lambda>rv s. P (tcCapsTarget rv)\<rbrace>,-"
-  apply (simp       add: decodeCVSpace_def Let_def split_def
-                         unlessE_def getThreadVSpaceRoot getThreadCSpaceRoot
-              split del: if_split cong: list.case_cong)
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps
-           | simp only: tcbinvocation.sel
+           | simp only: isThreadControl_def tcbinvocation.simps
            | wpcw)+
   apply simp
   done
 
 lemma decodeSetSpace_tc_target[wp]:
-  "\<lbrace>\<lambda>s. P (capTCBPtr cap)\<rbrace> decodeSetSpace args cap slot extras \<lbrace>\<lambda>rv s. P (tcCapsTarget rv)\<rbrace>,-"
+  "\<lbrace>\<lambda>s. P (capTCBPtr cap)\<rbrace> decodeSetSpace args cap slot extras \<lbrace>\<lambda>rv s. P (tcThread rv)\<rbrace>,-"
   apply (simp       add: decodeSetSpace_def Let_def split_def
                          unlessE_def getThreadVSpaceRoot getThreadCSpaceRoot
               split del: if_split cong: list.case_cong)
@@ -3298,18 +2385,8 @@ lemma decodeSetSpace_tc_target[wp]:
   apply simp
   done
 
-lemma decodeCVSpace_tc_slot[wp]:
-  "\<lbrace>\<lambda>s. P slot\<rbrace> decodeCVSpace args cap slot extras \<lbrace>\<lambda>rv s. P (tcCapsSlot rv)\<rbrace>,-"
-  apply (simp add: decodeCVSpace_def split_def unlessE_def
-                   getThreadVSpaceRoot getThreadCSpaceRoot
-             cong: list.case_cong)
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps | wpcw | simp only: tcbinvocation.sel)+
-  apply simp
-  done
-
 lemma decodeSetSpace_tc_slot[wp]:
-  "\<lbrace>\<lambda>s. P slot\<rbrace> decodeSetSpace args cap slot extras \<lbrace>\<lambda>rv s. P (tcCapsSlot rv)\<rbrace>,-"
+  "\<lbrace>\<lambda>s. P slot\<rbrace> decodeSetSpace args cap slot extras \<lbrace>\<lambda>rv s. P (tcThreadCapSlot rv)\<rbrace>,-"
   apply (simp add: decodeSetSpace_def split_def unlessE_def
                    getThreadVSpaceRoot getThreadCSpaceRoot
              cong: list.case_cong)
@@ -3321,52 +2398,40 @@ lemma decodeSetSpace_tc_slot[wp]:
 lemma decodeTCBConfigure_corres:
   notes if_cong [cong] option.case_cong [cong]
   shows
- "\<lbrakk>cap_relation cap cap';
-   list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras';
-   is_thread_cap cap\<rbrakk> \<Longrightarrow>
-  corres (ser \<oplus> tcbinv_relation)
-      (einvs and valid_cap cap and (\<lambda>s. \<forall>x \<in> set extras. cte_at (snd x) s))
-      (invs' and valid_cap' cap' and (\<lambda>s. \<forall>x \<in> set extras'. cte_at' (snd x) s))
+ "\<lbrakk> cap_relation cap cap'; list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras';
+     is_thread_cap cap \<rbrakk> \<Longrightarrow>
+  corres (ser \<oplus> tcbinv_relation) (einvs and valid_cap cap and (\<lambda>s. \<forall>x \<in> set extras. cte_at (snd x) s))
+                                 (invs' and valid_cap' cap' and (\<lambda>s. \<forall>x \<in> set extras'. cte_at' (snd x) s))
       (decode_tcb_configure args cap slot extras)
       (decodeTCBConfigure args cap' (cte_map slot) extras')"
   apply (clarsimp simp add: decode_tcb_configure_def decodeTCBConfigure_def)
+  apply (cases "length args < 4")
   apply (clarsimp split: list.split)
   apply (cases "length extras < 3")
-   apply (clarsimp split: list.split simp: list_all2_Cons2)
-  apply (clarsimp simp: linorder_not_less val_le_length_Cons list_all2_Cons1 priorityBits_def)
+  apply (clarsimp split: list.split simp: list_all2_Cons2)
+  apply (clarsimp simp: linorder_not_less val_le_length_Cons list_all2_Cons1
+      priorityBits_def)
   apply (rule corres_guard_imp)
     apply (rule corres_splitEE)
        apply (rule decodeSetIPCBuffer_corres; simp)
       apply (rule corres_splitEE)
-         apply (rule decodeCVSpace_corres; simp)
-        apply (rule_tac F="tcb_invocation.is_ThreadControlCaps set_params" in corres_gen_asm)
-        apply (rule_tac F="tcb_invocation.is_ThreadControlCaps set_space" in corres_gen_asm)
-        apply (rule_tac F="tcCapsSlot setSpace = cte_map slot" in corres_gen_asm2)
+         apply (rule decodeSetSpace_corres; simp)
+        apply (rule_tac F="tcb_invocation.is_ThreadControl set_params" in corres_gen_asm)
+        apply (rule_tac F="tcb_invocation.is_ThreadControl set_space" in corres_gen_asm)
+        apply (rule_tac F="tcThreadCapSlot setSpace = cte_map slot" in corres_gen_asm2)
         apply (rule corres_trivial)
-        apply (clarsimp simp: returnOk_def is_cap_simps newroot_rel_def
-                              tcb_invocation.is_ThreadControlCaps_def)
-       apply (wpsimp simp: invs_def valid_sched_def)+
+        apply (clarsimp simp: tcb_invocation.is_ThreadControl_def returnOk_def is_cap_simps)
+       apply (wp | simp add: invs_def valid_sched_def)+
   done
 
 lemma isThreadControl_def2:
-  "isThreadControlCaps tinv = (\<exists>a b c d e f g. tinv = ThreadControlCaps a b c d e f g)"
-  by (cases tinv, simp_all add: isThreadControlCaps_def)
-
-lemma decodeCVSpaceSome[wp]:
-  "\<lbrace>\<top>\<rbrace> decodeCVSpace xs cap y zs
-   \<lbrace>\<lambda>rv s. tcCapsCRoot rv \<noteq> None\<rbrace>,-"
-  apply (simp add: decodeCVSpace_def split_def cap_CNode_case_throw
-             cong: list.case_cong if_cong del: not_None_eq)
-  apply (rule hoare_pre)
-   apply (wp hoare_drop_imps | wpcw
-             | simp only: tcbinvocation.sel option.simps)+
-  apply simp
-  done
+  "isThreadControl tinv = (\<exists>a b c d e f g h. tinv = ThreadControl a b c d e f g h)"
+  by (cases tinv, simp_all add: isThreadControl_def)
 
 lemma decodeSetSpaceSome[wp]:
   "\<lbrace>\<top>\<rbrace> decodeSetSpace xs cap y zs
-   \<lbrace>\<lambda>rv s. tcCapsCRoot rv \<noteq> None\<rbrace>,-"
-  apply (simp add: decodeSetSpace_def decodeCVSpace_def split_def cap_CNode_case_throw
+   \<lbrace>\<lambda>rv s. tcNewCRoot rv \<noteq> None\<rbrace>,-"
+  apply (simp add: decodeSetSpace_def split_def cap_CNode_case_throw
              cong: list.case_cong if_cong del: not_None_eq)
   apply (rule hoare_pre)
    apply (wp hoare_drop_imps | wpcw
@@ -3384,8 +2449,8 @@ lemma decodeTCBConf_wf[wp]:
   apply (rule hoare_pre)
    apply (wp | wpc)+
     apply (rule_tac Q'="\<lambda>setSpace s. tcb_inv_wf' setSpace s \<and> tcb_inv_wf' setIPCParams s
-                             \<and> isThreadControlCaps setSpace \<and> isThreadControlCaps setIPCParams
-                             \<and> tcCapsTarget setSpace = t \<and> tcCapsCRoot setSpace \<noteq> None"
+                             \<and> isThreadControl setSpace \<and> isThreadControl setIPCParams
+                             \<and> tcThread setSpace = t \<and> tcNewCRoot setSpace \<noteq> None"
                         in hoare_strengthen_postE_R)
      apply wp
     apply (clarsimp simp: isThreadControl_def2 cong: option.case_cong)
@@ -3455,7 +2520,7 @@ notes if_cong[cong] shows
              apply (wp | simp add: whenE_def split del: if_split)+
            apply (wp | wpc | simp)+
        apply (simp | wp gbn_wp gbn_wp')+
-   apply (fastforce simp: valid_cap_def valid_cap'_def obj_at_def is_tcb dest: hd_in_set)+
+   apply (fastforce simp: valid_cap_def valid_cap'_def dest: hd_in_set)+
   done
 
 lemma decodeUnbindNotification_corres:
@@ -3481,19 +2546,7 @@ lemma decodeSetTLSBase_corres:
           (decode_set_tls_base w (cap.ThreadCap t))
           (decodeSetTLSBase w (capability.ThreadCap t))"
   by (clarsimp simp: decode_set_tls_base_def decodeSetTLSBase_def returnOk_def
-                 split: list.split)
-
-lemma decodeSetTimeoutEndpoint_corres:
-  "list_all2 (\<lambda>(c, sl) (c', sl'). cap_relation c c' \<and> sl' = cte_map sl) extras extras' \<Longrightarrow>
-   corres (ser \<oplus> tcbinv_relation) (tcb_at t) (tcb_at' t)
-          (decode_set_timeout_ep (cap.ThreadCap t) slot extras)
-          (decodeSetTimeoutEndpoint (capability.ThreadCap t) (cte_map slot) extras')"
-  apply (clarsimp simp: decode_set_timeout_ep_def decodeSetTimeoutEndpoint_def)
-  apply (cases extras; cases extras'; clarsimp)
-  apply (fastforce simp: check_handler_ep_def unlessE_def returnOk_def bindE_def
-                         newroot_rel_def emptyTCCaps_def throwError_def
-                   dest: cap_rel_valid_fh)
-  done
+               split: list.split)
 
 lemma decodeTCBInvocation_corres:
  "\<lbrakk> c = Structures_A.ThreadCap t; cap_relation c c';
@@ -3522,16 +2575,16 @@ lemma decodeTCBInvocation_corres:
              corres_guard_imp[OF decodeSetSpace_corres]
              corres_guard_imp[OF decodeBindNotification_corres]
              corres_guard_imp[OF decodeUnbindNotification_corres]
-             corres_guard_imp[OF decodeSetTLSBase_corres]
-             corres_guard_imp[OF decodeSetTimeoutEndpoint_corres],
-         simp_all add: valid_cap_simps valid_cap_simps' invs_def valid_sched_def)
+             corres_guard_imp[OF decodeSetTLSBase_corres],
+         simp_all add: valid_cap_simps valid_cap_simps' invs_def valid_state_def
+                       valid_pspace_def valid_sched_def)
   apply (auto simp: list_all2_map1 list_all2_map2
              elim!: list_all2_mono)
   done
 
 crunch decodeTCBInvocation
- for inv[wp]: P
-  (simp: crunch_simps wp: crunch_wps)
+  for inv[wp]: P
+(simp: crunch_simps)
 
 lemma real_cte_at_not_tcb_at':
   "real_cte_at' x s \<Longrightarrow> \<not> tcb_at' x s"
@@ -3550,9 +2603,9 @@ lemma decodeBindNotification_wf:
   apply (rule hoare_pre)
    apply (wp getNotification_wp getObject_tcb_wp
         | wpc
-        | simp add: threadGet_getObject getBoundNotification_def)+
+        | simp add: threadGet_def getBoundNotification_def)+
   apply (fastforce simp: valid_cap'_def[where c="capability.ThreadCap t"]
-                         is_ntfn invs_def valid_pspace'_def
+                         is_ntfn invs_def valid_state'_def valid_pspace'_def
                          projectKOs null_def pred_tcb_at'_def obj_at'_def
                    dest!: global'_no_ex_cap hd_in_set)
   done
@@ -3562,7 +2615,7 @@ lemma decodeUnbindNotification_wf:
      decodeUnbindNotification (capability.ThreadCap t)
    \<lbrace>tcb_inv_wf'\<rbrace>,-"
   apply (simp add: decodeUnbindNotification_def)
-  apply (wp getObject_tcb_wp | wpc | simp add: threadGet_getObject getBoundNotification_def)+
+  apply (wp getObject_tcb_wp | wpc | simp add: threadGet_def getBoundNotification_def)+
   apply (auto simp: obj_at'_def pred_tcb_at'_def)
   done
 
@@ -3574,36 +2627,37 @@ lemma decodeSetTLSBase_wf:
              cong: list.case_cong)
   by wpsimp
 
-lemma decodeSetTimeoutEndpoint_wf[wp]:
-  "\<lbrace>invs' and tcb_at' t and ex_nonz_cap_to' t and cte_at' slot
-     and (\<lambda>s. \<forall>x \<in> set extras. s \<turnstile>' fst x \<and> cte_at' (snd x) s)\<rbrace>
-   decodeSetTimeoutEndpoint (ThreadCap t) slot extras
-   \<lbrace>tcb_inv_wf'\<rbrace>,-"
-  apply (simp add: decodeSetTimeoutEndpoint_def emptyTCCaps_def
-             cong: list.case_cong)
-  apply wpsimp
-  done
-
 lemma decodeTCBInv_wf:
   "\<lbrace>invs' and tcb_at' t and cte_at' slot and ex_nonz_cap_to' t
          and (\<lambda>s. \<forall>x \<in> set extras. real_cte_at' (snd x) s
                           \<and> s \<turnstile>' fst x \<and> (\<forall>y \<in> zobj_refs' (fst x). ex_nonz_cap_to' y s))\<rbrace>
-   decodeTCBInvocation label args (capability.ThreadCap t) slot extras
+     decodeTCBInvocation label args (capability.ThreadCap t) slot extras
    \<lbrace>tcb_inv_wf'\<rbrace>,-"
   apply (simp add: decodeTCBInvocation_def Let_def
               cong: if_cong gen_invocation_labels.case_cong split del: if_split)
   apply (rule hoare_pre)
    apply (wpc, (wp decodeTCBConf_wf decodeReadReg_wf decodeWriteReg_wf decodeSetTLSBase_wf
-             decodeCopyReg_wf decodeBindNotification_wf decodeUnbindNotification_wf
-             decodeSetSchedParams_wf)+)
+             decodeCopyReg_wf decodeBindNotification_wf decodeUnbindNotification_wf)+)
   apply (clarsimp simp: real_cte_at')
   apply (fastforce simp: real_cte_at_not_tcb_at' objBits_defs)
   done
 
 crunch getThreadBufferSlot, setPriority, setMCPriority
   for irq_states'[wp]: valid_irq_states'
-  (simp: crunch_simps wp: crunch_wps)
+  (simp: crunch_simps)
 
+lemma inv_tcb_IRQInactive:
+  "\<lbrace>valid_irq_states'\<rbrace> invokeTCB tcb_inv
+  -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  including classic_wp_pre
+  apply (simp add: invokeTCB_def)
+  apply (rule hoare_pre)
+   apply (wpc |
+          wp withoutPreemption_R cteDelete_IRQInactive checkCap_inv
+             hoare_vcg_const_imp_liftE_R cteDelete_irq_states'
+             hoare_vcg_const_imp_lift |
+          simp add: split_def)+
+  done
 
 end
 
diff --git a/proof/refine/ARM/Untyped_R.thy b/proof/refine/ARM/Untyped_R.thy
index cbaac7a76d..5592f4b2eb 100644
--- a/proof/refine/ARM/Untyped_R.thy
+++ b/proof/refine/ARM/Untyped_R.thy
@@ -9,7 +9,7 @@
 theory Untyped_R
 imports Detype_R Invocations_R InterruptAcc_R
 begin
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 primrec
   untypinv_relation :: "Invocations_A.untyped_invocation \<Rightarrow>
@@ -35,8 +35,6 @@ where
           \<and> distinct (slot # slots)
           \<and> (ty = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> us > 0)
           \<and> (ty = APIObjectType ArchTypes_H.Untyped \<longrightarrow> minUntypedSizeBits \<le> us \<and> us \<le> maxUntypedSizeBits)
-          \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us)
           \<and> (\<forall>slot \<in> set slots. cte_wp_at' (\<lambda>c. cteCap c = NullCap) slot s)
           \<and> (\<forall>slot \<in> set slots. ex_cte_cap_to' slot s)
           \<and> sch_act_simple s \<and> 0 < length slots
@@ -196,12 +194,12 @@ next
     apply (simp add: returnOk_def APIType_map2_def toEnum_def
                      enum_apiobject_type enum_object_type)
     apply (intro conjI impI)
-     apply (subgoal_tac "unat v - 7 > 5")
+     apply (subgoal_tac "unat v - 5 > 5")
       apply (simp add: arch_data_to_obj_type_def)
      apply simp
-    apply (subgoal_tac "\<exists>n. unat v = n + 7")
+    apply (subgoal_tac "\<exists>n. unat v = n + 5")
      apply (clarsimp simp: arch_data_to_obj_type_def returnOk_def)
-    apply (rule_tac x="unat v - 7" in exI)
+    apply (rule_tac x="unat v - 5" in exI)
     apply arith
     done
   have S: "\<And>x (y :: ('g :: len) word) (z :: 'g word) bits. \<lbrakk> bits < len_of TYPE('g); x < 2 ^ bits \<rbrakk> \<Longrightarrow> toEnum x = (of_nat x :: 'g word)"
@@ -248,7 +246,8 @@ next
          pageBits_def pdBits_def ptBits_def)
       apply (rename_tac apiobject_type)
       apply (case_tac apiobject_type)
-       apply (simp_all add:apiGetObjectSize_def objBits_simps' slot_bits_def pdeBits_def pteBits_def)
+       apply (simp_all add:apiGetObjectSize_def tcbBlockSizeBits_def epSizeBits_def
+         ntfnSizeBits_def slot_bits_def cteSizeBits_def pdeBits_def pteBits_def)
       done
     obtain if_res where if_res_def: "\<And>reset. if_res reset = (if reset then 0 else idx)"
       by auto
@@ -295,14 +294,14 @@ next
          apply (clarsimp simp: fromAPIType_def)
         apply (rule whenE_throwError_corres, simp)
          apply (clarsimp simp: fromAPIType_def)
-        apply (rule whenE_throwError_corres, simp)
-         apply (clarsimp simp: fromAPIType_def min_sched_context_bits_def minSchedContextBits_def)
-        apply (rule_tac r' = "\<lambda>cap cap'. cap_relation cap cap'" in corres_splitEE[OF corres_if])
-             apply simp
+        apply (rule_tac r' = "\<lambda>cap cap'. cap_relation cap cap'"
+                in corres_splitEE)
+           apply (rule corres_if, simp)
             apply (rule corres_returnOkTT)
             apply (rule crel)
            apply simp
-           apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
+           apply (rule corres_splitEE)
+              apply (rule lookupSlotForCNodeOp_corres)
                apply (rule crel)
               apply simp
              apply simp
@@ -454,101 +453,98 @@ lemma ctes_of_ko:
    (\<forall>ptr\<in>capRange cap. \<exists>optr ko. ksPSpace s optr = Some ko \<and>
                                   ptr \<in> obj_range' optr ko)"
   apply (case_tac cap)
-               \<comment> \<open>TCB case\<close>
-               apply (simp_all add: isCap_simps capRange_def)
-         apply (clarsimp simp: valid_cap'_def obj_at'_def)
-         apply (intro exI conjI, assumption)
-         apply (clarsimp simp: projectKO_eq objBits_def obj_range'_def
-                        dest!: projectKO_opt_tcbD simp: objBitsKO_def)
-       \<comment> \<open>NTFN case\<close>
-        apply (clarsimp simp: valid_cap'_def obj_at'_def)
-        apply (intro exI conjI, assumption)
-        apply (clarsimp simp: projectKO_eq objBits_def obj_range'_def projectKO_ntfn objBitsKO_def)
-       \<comment> \<open>EP case\<close>
+             \<comment> \<open>TCB case\<close>
+             apply (simp_all add: isCap_simps capRange_def)
        apply (clarsimp simp: valid_cap'_def obj_at'_def)
        apply (intro exI conjI, assumption)
-       apply (clarsimp simp: projectKO_eq objBits_def obj_range'_def projectKO_ep objBitsKO_def)
-      \<comment> \<open>Zombie case\<close>
-      apply (rename_tac word zombie_type nat)
-      apply (case_tac zombie_type)
-       apply (clarsimp simp: valid_cap'_def obj_at'_def)
+       apply (clarsimp simp: projectKO_eq objBits_def obj_range'_def
+                       dest!: projectKO_opt_tcbD simp: objBitsKO_def)
+      \<comment> \<open>NTFN case\<close>
+      apply (clarsimp simp: valid_cap'_def obj_at'_def)
+      apply (intro exI conjI, assumption)
+      apply (clarsimp simp: projectKO_eq objBits_def
+     obj_range'_def projectKO_ntfn objBitsKO_def)
+     \<comment> \<open>EP case\<close>
+     apply (clarsimp simp: valid_cap'_def obj_at'_def)
+     apply (intro exI conjI, assumption)
+     apply (clarsimp simp: projectKO_eq objBits_def
+    obj_range'_def projectKO_ep objBitsKO_def)
+    \<comment> \<open>Zombie case\<close>
+    apply (rename_tac word zombie_type nat)
+    apply (case_tac zombie_type)
+     apply (clarsimp simp: valid_cap'_def obj_at'_def)
+     apply (intro exI conjI, assumption)
+     apply (clarsimp simp: projectKO_eq objBits_simps' obj_range'_def dest!:projectKO_opt_tcbD)
+    apply (clarsimp simp: valid_cap'_def obj_at'_def capAligned_def
+                          objBits_simps' projectKOs)
+    apply (frule_tac ptr=ptr and sz=4 in nasty_range [where 'a=32, folded word_bits_def], simp+)
+    apply clarsimp
+    apply (drule_tac x=idx in spec)
+    apply (clarsimp simp: less_mask_eq)
+    apply (fastforce simp: obj_range'_def projectKOs objBits_simps' field_simps)[1]
+   \<comment> \<open>Arch cases\<close>
+   apply (rename_tac arch_capability)
+   apply (case_tac arch_capability)
+       \<comment> \<open>ASID case\<close>
+       apply (clarsimp simp: valid_cap'_def  typ_at'_def ko_wp_at'_def)
        apply (intro exI conjI, assumption)
-       apply (clarsimp simp: projectKO_eq objBits_simps' obj_range'_def dest!:projectKO_opt_tcbD)
-      apply (clarsimp simp: valid_cap'_def obj_at'_def capAligned_def objBits_simps' projectKOs)
-      apply (frule_tac ptr=ptr and sz=4 in nasty_range [where 'a=32, folded word_bits_def], simp+)
-      apply clarsimp
-      apply (drule_tac x=idx in spec)
-      apply (clarsimp simp: less_mask_eq)
-      apply (fastforce simp: obj_range'_def projectKOs objBits_simps' field_simps)[1]
-     \<comment> \<open>Arch cases\<close>
-     apply (rename_tac arch_capability)
-     apply (case_tac arch_capability)
-         \<comment> \<open>ASID case\<close>
-         apply (clarsimp simp: valid_cap'_def  typ_at'_def ko_wp_at'_def)
-         apply (intro exI conjI, assumption)
-         apply (clarsimp simp: obj_range'_def archObjSize_def objBitsKO_def)
-         apply (case_tac ko, simp+)[1]
-           apply (rename_tac arch_kernel_object)
-           apply (case_tac arch_kernel_object
-                  ; simp add: archObjSize_def asid_low_bits_def pageBits_def)
-          apply simp
-         apply simp
-        apply simp
-       \<comment> \<open>Page case\<close>
-       apply (rename_tac word vmrights vmpage_size option)
-       apply (clarsimp simp: valid_cap'_def typ_at'_def ko_wp_at'_def capAligned_def)
-       apply (frule_tac ptr = ptr and sz = "pageBits"
-                     in nasty_range [where 'a=32, folded word_bits_def])
-          apply assumption
-         apply (simp add: pbfs_atleast_pageBits)+
-       apply (clarsimp,drule_tac x = idx in spec,clarsimp)
-       apply (intro exI conjI,assumption)
-       apply (clarsimp simp: obj_range'_def)
-       apply (case_tac ko, simp_all split: if_splits
-              , (simp add: objBitsKO_def archObjSize_def field_simps shiftl_t2n)+)[1]
-      \<comment> \<open>PT case\<close>
-      apply (rename_tac word option)
-      apply (clarsimp simp: valid_cap'_def obj_at'_def pageBits_def pteBits_def asid_bits_def
-                            page_table_at'_def typ_at'_def ko_wp_at'_def)
-      apply (frule_tac ptr=ptr and sz=2
-                  in nasty_range[where 'a=32 and bz="ptBits", folded word_bits_def,
+       apply (clarsimp simp: obj_range'_def archObjSize_def objBitsKO_def)
+       apply (case_tac ko, simp+)[1]
+       apply (rename_tac arch_kernel_object)
+       apply (case_tac arch_kernel_object;
+              simp add: archObjSize_def asid_low_bits_def pageBits_def)
+      apply simp
+     \<comment> \<open>Page case\<close>
+     apply (rename_tac word vmrights vmpage_size option)
+     apply (clarsimp simp: valid_cap'_def typ_at'_def ko_wp_at'_def capAligned_def)
+     apply (frule_tac ptr = ptr and sz = "pageBits" in nasty_range [where 'a=32, folded word_bits_def])
+        apply assumption
+       apply (simp add: pbfs_atleast_pageBits)+
+     apply (clarsimp,drule_tac x = idx in spec,clarsimp)
+     apply (intro exI conjI,assumption)
+     apply (clarsimp simp: obj_range'_def)
+     apply (case_tac ko, simp_all split: if_splits,
+             (simp add: objBitsKO_def archObjSize_def field_simps shiftl_t2n)+)[1]
+    \<comment> \<open>PT case\<close>
+    apply (rename_tac word option)
+    apply (clarsimp simp: valid_cap'_def obj_at'_def pageBits_def pteBits_def asid_bits_def
+                          page_table_at'_def typ_at'_def ko_wp_at'_def)
+    apply (frule_tac ptr=ptr and sz=2 in
+                     nasty_range[where 'a=32 and bz="ptBits", folded word_bits_def,
                                  simplified pageBits_def word_bits_def, simplified,rotated])
-         apply (clarsimp simp add: ptBits_def pteBits_def)+
-      apply (drule_tac x=idx in spec)
-      apply clarsimp
-      apply (intro exI conjI,assumption)
-      apply (clarsimp simp: obj_range'_def)
-      apply (case_tac ko; simp)
-      apply (rename_tac arch_kernel_object)
-      apply (case_tac arch_kernel_object; simp)
-      apply (simp add: objBitsKO_def archObjSize_def field_simps shiftl_t2n ptBits_def pteBits_def)
-     \<comment> \<open>PD case\<close>
-     apply (clarsimp simp: valid_cap'_def obj_at'_def pageBits_def pdBits_def page_directory_at'_def
-                           typ_at'_def ko_wp_at'_def)
-     apply (frule_tac ptr=ptr and sz=2
-                   in nasty_range[where 'a=32 and bz="pdBits", folded word_bits_def,rotated,
-                                  simplified pdBits_def pageBits_def word_bits_def, simplified])
-        apply (clarsimp simp add: pdBits_def pdeBits_def)+
-     apply (drule_tac x="idx" in spec)
-     apply clarsimp
-     apply (intro exI conjI, assumption)
-     apply (clarsimp simp: obj_range'_def objBitsKO_def field_simps)
-     apply (case_tac ko; simp)
-     apply (rename_tac arch_kernel_object)
-     apply (case_tac arch_kernel_object; simp)
-     apply (simp add: field_simps archObjSize_def shiftl_t2n pdBits_def pdeBits_def)
-    \<comment> \<open>Reply case\<close>
-    apply (clarsimp simp: valid_cap'_def obj_at'_def)
-    apply (fastforce simp: obj_range'_def projectKOs objBits_simps' field_simps)
-   \<comment> \<open>CNode case\<close>
-   apply (clarsimp simp: valid_cap'_def obj_at'_def capAligned_def objBits_simps' projectKOs)
-   apply (frule_tac ptr=ptr and sz=4 in nasty_range [where 'a=32, folded word_bits_def], simp+)
+    apply (clarsimp simp add: ptBits_def pteBits_def)+
+    apply (drule_tac x=idx in spec)
+    apply clarsimp
+    apply (intro exI conjI,assumption)
+    apply (clarsimp simp: obj_range'_def)
+    apply (case_tac ko; simp)
+    apply (rename_tac arch_kernel_object)
+    apply (case_tac arch_kernel_object; simp)
+    apply (simp add: objBitsKO_def archObjSize_def field_simps shiftl_t2n
+                     ptBits_def pteBits_def)
+   \<comment> \<open>PD case\<close>
+   apply (clarsimp simp: valid_cap'_def obj_at'_def pageBits_def pdBits_def
+                         page_directory_at'_def typ_at'_def ko_wp_at'_def)
+   apply (frule_tac ptr=ptr and sz=2 in
+                    nasty_range[where 'a=32 and bz="pdBits", folded word_bits_def,rotated,
+                                simplified pdBits_def pageBits_def word_bits_def, simplified])
+      apply (clarsimp simp add: pdBits_def pdeBits_def)+
+   apply (drule_tac x="idx" in spec)
    apply clarsimp
-   apply (drule_tac x=idx in spec)
-   apply (clarsimp simp: less_mask_eq)
-   apply (fastforce simp: obj_range'_def projectKOs objBits_simps' field_simps)
-  \<comment> \<open>SchedContext case\<close>
-  apply (fastforce simp: valid_cap'_def ko_wp_at'_def  obj_range'_def)
+   apply (intro exI conjI, assumption)
+   apply (clarsimp simp: obj_range'_def objBitsKO_def field_simps)
+   apply (case_tac ko; simp)
+   apply (rename_tac arch_kernel_object)
+   apply (case_tac arch_kernel_object; simp)
+   apply (simp add: field_simps archObjSize_def shiftl_t2n pdBits_def pdeBits_def)
+  \<comment> \<open>CNode case\<close>
+  apply (clarsimp simp: valid_cap'_def obj_at'_def capAligned_def
+                        objBits_simps' projectKOs)
+  apply (frule_tac ptr=ptr and sz=4 in nasty_range [where 'a=32, folded word_bits_def], simp+)
+  apply clarsimp
+  apply (drule_tac x=idx in spec)
+  apply (clarsimp simp: less_mask_eq)
+  apply (fastforce simp: obj_range'_def projectKOs objBits_simps' field_simps)[1]
   done
 
 lemma untypedCap_descendants_range':
@@ -614,7 +610,6 @@ lemma untypedCap_descendants_range':
   apply (clarsimp simp: ko_wp_at'_def simp del: usableUntypedRange.simps untypedRange.simps)
   apply (frule(1) pspace_alignedD')
   apply (frule(1) pspace_distinctD')
-  apply (frule(1) pspace_boundedD')
   apply (erule(1) impE)
   apply (clarsimp simp del: usableUntypedRange.simps untypedRange.simps)
   apply blast
@@ -717,7 +712,7 @@ lemma cte_cap_in_untyped_range:
      apply (clarsimp dest!: isCapDs)
     apply (rule_tac x=x in notemptyI)
     apply (simp add: subsetD [OF cte_refs_capRange])
-   apply (clarsimp simp: invs'_def valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
+   apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
   apply (frule_tac p=cref and p'=crefa in untyped_mdbD', assumption)
       apply (simp_all add: isUntypedCap_def)
     apply (frule valid_capAligned)
@@ -725,7 +720,7 @@ lemma cte_cap_in_untyped_range:
      apply (case_tac cap; simp)
     apply blast
    apply (case_tac cap; simp)
-  apply (clarsimp simp: invs'_def valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
+  apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
   done
 
 lemma cap_case_CNodeCap_True_throw:
@@ -888,11 +883,10 @@ lemma decodeUntyped_wf[wp]:
    apply (simp add:empty_descendants_range_in')
    apply (clarsimp simp:image_def isCap_simps nullPointer_def word_size field_simps)
    apply (intro conjI)
-      apply (clarsimp simp: image_def isCap_simps nullPointer_def word_size field_simps)
-      apply (drule_tac x=x in spec)+
-      apply simp
-     apply (clarsimp simp: APIType_capBits_def)
-    apply (clarsimp simp: APIType_capBits_def sc_size_bounds_def)
+     apply (clarsimp simp: image_def isCap_simps nullPointer_def word_size field_simps)
+     apply (drule_tac x=x in spec)+
+     apply simp
+    apply (clarsimp simp: APIType_capBits_def)
    apply clarsimp
   apply (clarsimp simp: image_def getFreeRef_def cte_level_bits_def objBits_simps' field_simps)
   apply (clarsimp simp: of_nat_shiftR word_le_nat_alt)
@@ -900,11 +894,10 @@ lemma decodeUntyped_wf[wp]:
             and bits = "(APIType_capBits (toEnum (unat (args ! 0))) (unat (args ! 1)))"
              in range_cover_stuff[where w=w and sz=sz and rv = idx,rotated -1]; simp?)
   apply (intro conjI; clarsimp simp add: image_def word_size)
-    apply (clarsimp simp: image_def isCap_simps nullPointer_def word_size field_simps)
-    apply (drule_tac x=x in spec)+
-    apply simp
-   apply (clarsimp simp: APIType_capBits_def)
-  apply (clarsimp simp: APIType_capBits_def sc_size_bounds_def)
+   apply (clarsimp simp: image_def isCap_simps nullPointer_def word_size field_simps)
+   apply (drule_tac x=x in spec)+
+   apply simp
+  apply (clarsimp simp: APIType_capBits_def)
   done
 
 lemma getCTE_known_cap:
@@ -1000,7 +993,7 @@ locale mdb_insert_again =
 
 context mdb_insert_again
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 lemmas parent = mdb_ptr_parent.m_p
 lemmas site = mdb_ptr_site.m_p
 
@@ -1339,14 +1332,13 @@ 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) s'} nf nf' dc P P' (create_cap_ext p z a) (return x)"
+  "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)"
   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
 
 crunch updateMDB, updateNewFreeIndex
   for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and ksIdleSC[wp]: "\<lambda>s. P (ksIdleSC s)"
   and ups'[wp]: "\<lambda>s. P (gsUserPages s)"
   and cns'[wp]: "\<lambda>s. P (gsCNodes s)"
   and ksDomainTime[wp]: "\<lambda>s. P (ksDomainTime s)"
@@ -1354,18 +1346,11 @@ crunch updateMDB, updateNewFreeIndex
   and ksWorkUnitsCompleted[wp]: "\<lambda>s. P (ksWorkUnitsCompleted s)"
   and ksMachineState[wp]: "\<lambda>s. P (ksMachineState s)"
   and ksArchState[wp]: "\<lambda>s. P (ksArchState s)"
-  and ksConsumedTime[wp]: "\<lambda>s. P (ksConsumedTime s)"
-  and ksCurrentTime[wp]: "\<lambda>s. P (ksCurTime s)"
-  and ksCurSc[wp]: "\<lambda>s. P (ksCurSc s)"
-  and ksReprogramTimer[wp]: "\<lambda>s. P (ksReprogramTimer s)"
-
 crunch insertNewCap
   for ksInterrupt[wp]: "\<lambda>s. P (ksInterruptState s)"
   and nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
   and norq[wp]: "\<lambda>s. P (ksReadyQueues s)"
-  and norlq[wp]: "\<lambda>s. P (ksReleaseQueue s)"
   and ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
-  and ksIdleSC[wp]: "\<lambda>s. P (ksIdleSC s)"
   and ksDomSchedule[wp]: "\<lambda>s. P (ksDomSchedule s)"
   and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
   and ksCurThread[wp]: "\<lambda>s. P (ksCurThread s)"
@@ -1389,7 +1374,7 @@ crunch create_cap_ext
   and work_units_completed[wp]: "\<lambda>s. P (work_units_completed s)"
   (ignore_del: create_cap_ext)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+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
@@ -1404,13 +1389,9 @@ lemma updateNewFreeIndex_noop_psp_corres:
         | simp add: updateTrackedFreeIndex_def getSlotCap_def)+
   done
 
-crunch updateMDB, updateNewFreeIndex
-  for sc_replies_of'[wp]: "\<lambda>s. P (replies_of' s) (scs_of' s)"
-
-crunch set_cap, set_cdt
-  for domain_index[wp]: "\<lambda>s. P (domain_index s)"
-  and reprogram_timer[wp]: "\<lambda>s. P (reprogram_timer 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)"
 
 lemma insertNewCap_corres:
 notes if_cong[cong del] if_weak_cong[cong]
@@ -1460,7 +1441,6 @@ shows
                                             apply ((wp | simp)+)[1]
                                            apply (wp updateMDB_ctes_of_cases
                                                   | simp add: o_def split del: if_split)+
-      apply (intro conjI; (solves \<open>simp add: state_relation_def\<close>)?)
             apply (clarsimp simp: cdt_relation_def cte_wp_at_ctes_of
                      split del: if_split cong: if_cong simp del: id_apply)
             apply (subst if_not_P, erule(1) valid_mdbD3')
@@ -1553,7 +1533,7 @@ shows
   apply(simp only: cdt_list_relation_def valid_mdb_def2)
   apply(subgoal_tac "finite_depth (cdt s)")
    prefer 2
-   apply(simp add: finite_depth valid_mdb_def2[simplified])
+   apply(simp add: finite_depth valid_mdb_def2[simplified,symmetric])
   apply(intro impI allI)
   apply(subgoal_tac "mdb_insert_abs (cdt s) p (a, b)")
    prefer 2
@@ -1641,6 +1621,18 @@ lemma setCTE_cteCaps_of[wp]:
   apply (clarsimp elim!: rsubst[where P=P] intro!: ext)
   done
 
+lemma insertNewCap_wps[wp]:
+  "\<lbrace>pspace_aligned'\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
+  "\<lbrace>pspace_distinct'\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
+  "\<lbrace>\<lambda>s. P ((cteCaps_of s)(slot \<mapsto> cap))\<rbrace>
+      insertNewCap parent slot cap
+   \<lbrace>\<lambda>rv s. P (cteCaps_of s)\<rbrace>"
+  apply (simp_all add: insertNewCap_def)
+   apply (wp hoare_drop_imps
+            | simp add: o_def)+
+  apply (clarsimp elim!: rsubst[where P=P] intro!: ext)
+  done
+
 definition apitype_of :: "cap \<Rightarrow> apiobject_type option"
 where
   "apitype_of c \<equiv> case c of
@@ -1700,7 +1692,7 @@ locale mdb_insert_again_all = mdb_insert_again_child +
   fixes n'
   defines "n' \<equiv> modify_map n (mdbNext parent_node) (cteMDBNode_update (mdbPrev_update (\<lambda>a. site)))"
 begin
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 lemma no_0_n' [simp]: "no_0 n'"
   using no_0_n by (simp add: n'_def)
 
@@ -2648,6 +2640,19 @@ lemma dist_z [simp]:
   apply auto
   done
 
+lemma reply_masters_rvk_fb_m:
+  "reply_masters_rvk_fb m"
+  using valid by auto
+
+lemma reply_masters_rvk_fb_n[simp]:
+  "reply_masters_rvk_fb n'"
+  using reply_masters_rvk_fb_m
+  apply (simp add: reply_masters_rvk_fb_def n'_def ball_ran_modify_map_eq
+                   n_def fun_upd_def[symmetric])
+  apply (rule ball_ran_fun_updI, assumption)
+  apply clarsimp
+  done
+
 lemma valid_n':
   "untypedRange c' \<inter> usableUntypedRange parent_cap = {} \<Longrightarrow> valid_mdb_ctes n'"
   by auto
@@ -2661,7 +2666,7 @@ lemma caps_overlap_reserved'_D:
    apply (erule(2) impE)
   apply fastforce
   done
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 lemma insertNewCap_valid_mdb:
   "\<lbrace>valid_mdb' and valid_objs' and K (slot \<noteq> p) and
     caps_overlap_reserved' (untypedRange cap) and
@@ -2702,12 +2707,7 @@ lemma no_default_zombie:
   "cap_relation (default_cap tp p sz d) cap \<Longrightarrow> \<not>isZombie cap"
   by (cases tp, auto simp: isCap_simps)
 
-end
-
-global_interpretation updateNewFreeIndex: typ_at_all_props' "updateNewFreeIndex slot"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas updateNewFreeIndex_typ_ats[wp] = typ_at_lifts[OF updateNewFreeIndex_typ_at']
 
 lemma updateNewFreeIndex_valid_objs[wp]:
   "\<lbrace>valid_objs'\<rbrace> updateNewFreeIndex slot \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
@@ -2893,8 +2893,6 @@ lemma inv_untyped_corres_helper1:
 
 lemma createNewCaps_valid_pspace_extras:
   "\<lbrace>(\<lambda>s.    n \<noteq> 0 \<and> ptr \<noteq> 0 \<and> range_cover ptr sz (APIType_capBits ty us) n
-          \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                   \<longrightarrow> sc_size_bounds us)
           \<and> pspace_no_overlap' ptr sz s
           \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
           \<and> caps_overlap_reserved' {ptr .. ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s
@@ -2903,8 +2901,6 @@ lemma createNewCaps_valid_pspace_extras:
      createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
   "\<lbrace>(\<lambda>s.    n \<noteq> 0 \<and> ptr \<noteq> 0 \<and> range_cover ptr sz (APIType_capBits ty us) n
-          \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                   \<longrightarrow> sc_size_bounds us)
           \<and> pspace_no_overlap' ptr sz s
           \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
           \<and> caps_overlap_reserved' {ptr .. ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s
@@ -2913,8 +2909,6 @@ lemma createNewCaps_valid_pspace_extras:
      createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
   "\<lbrace>(\<lambda>s.    n \<noteq> 0 \<and> ptr \<noteq> 0 \<and> range_cover ptr sz (APIType_capBits ty us) n
-          \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                   \<longrightarrow> sc_size_bounds us)
           \<and> pspace_no_overlap' ptr sz s
           \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
           \<and> caps_overlap_reserved' {ptr .. ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s
@@ -2923,8 +2917,6 @@ lemma createNewCaps_valid_pspace_extras:
      createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
   "\<lbrace>(\<lambda>s.    n \<noteq> 0 \<and> ptr \<noteq> 0 \<and> range_cover ptr sz (APIType_capBits ty us) n
-          \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                   \<longrightarrow> sc_size_bounds us)
           \<and> pspace_no_overlap' ptr sz s
           \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
           \<and> caps_overlap_reserved' {ptr .. ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s
@@ -2953,8 +2945,7 @@ declare map_snd_zip_prefix[simp]
 declare word_unat_power [symmetric, simp del]
 
 lemma createNewCaps_range_helper:
-  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n
-         \<and> (tp = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us)\<rbrace>
+  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n\<rbrace>
      createNewCaps tp ptr n us d
    \<lbrace>\<lambda>rv s. \<exists>capfn.
         rv = map capfn (map (\<lambda>p. ptr_add ptr (p * 2 ^ (APIType_capBits tp us)))
@@ -2970,7 +2961,6 @@ lemma createNewCaps_range_helper:
   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)
-              \<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 archObjSize_def ptr_add_def o_def)
@@ -2978,28 +2968,33 @@ lemma createNewCaps_range_helper:
                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 (rule hoare_pre,wp createObjects_ret2)
              apply (clarsimp simp: APIType_capBits_def word_bits_def
-                                   objBits_simps archObjSize_def ptr_add_def o_def)
+                objBits_simps archObjSize_def 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 archObjSize_def ptr_add_def o_def,
-                    fastforce simp: objBitsKO_def objBits_def scBits_simps)+)[5]
-       \<comment>\<open>Arch objects\<close>
-       by (wp createObjects_ret2
-         | clarsimp simp: APIType_capBits_def objBits_if_dev archObjSize_def word_bits_def
-                          pdBits_def pageBits_def ptBits_def pteBits_def pdeBits_def
-                    split del: if_split
-         | simp add: objBits_simps
-         | (rule exI, fastforce))+
+            apply (rule hoare_pre,wp createObjects_ret2)
+            apply (clarsimp simp: APIType_capBits_def word_bits_def
+                                  objBits_simps archObjSize_def 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 archObjSize_def 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 archObjSize_def 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 pdBits_def pageBits_def ptBits_def
+                        pteBits_def pdeBits_def
+                        split del: if_split
+          | simp add: objBits_simps
+          | (rule exI, fastforce))+
+  done
 
 lemma createNewCaps_range_helper2:
-  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n
-         \<and> (tp = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us)\<rbrace>
+  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n\<rbrace>
      createNewCaps tp ptr n us d
    \<lbrace>\<lambda>rv s. \<forall>cp \<in> set rv. capRange cp \<noteq> {} \<and> capRange cp \<subseteq> {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}\<rbrace>"
   apply (rule hoare_assume_pre)
@@ -3021,7 +3016,6 @@ lemma createNewCaps_range_helper2:
    apply (erule of_nat_mono_maybe[rotated])
    apply (drule (1) range_cover.range_cover_n_less )
   apply (clarsimp)
-  apply (thin_tac "tp = _ \<longrightarrow> _")
   apply (erule impE)
    apply (simp add:range_cover_def)
    apply (rule is_aligned_no_overflow)
@@ -3032,8 +3026,7 @@ lemma createNewCaps_range_helper2:
 
 lemma createNewCaps_children:
   "\<lbrace>\<lambda>s. cap = UntypedCap d (ptr && ~~ mask sz) sz idx
-     \<and> range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n
-         \<and> (tp = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us)\<rbrace>
+     \<and> range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n\<rbrace>
      createNewCaps tp ptr n us d
    \<lbrace>\<lambda>rv s. \<forall>y \<in> set rv. (sameRegionAs cap y)\<rbrace>"
   apply (rule hoare_assume_pre)
@@ -3061,9 +3054,7 @@ lemmas makeObjectKO_simp = makeObjectKO_def[split_simps ARM_H.object_type.split
 lemma createNewCaps_descendants_range':
   "\<lbrace>\<lambda>s. descendants_range' p q (ctes_of s) \<and>
         range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0 \<and>
-        (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us) \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
+        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
    createNewCaps ty ptr n us d
    \<lbrace> \<lambda>rv s. descendants_range' p q (ctes_of s)\<rbrace>"
   apply (clarsimp simp:descendants_range'_def2 descendants_range_in'_def2)
@@ -3093,10 +3084,8 @@ lemma caps_overlap_reserved'_def2:
   done
 
 lemma createNewCaps_caps_overlap_reserved':
-  "\<lbrace>\<lambda>s. caps_overlap_reserved' S s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and>
+  "\<lbrace>\<lambda>s. caps_overlap_reserved' S s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and>
         pspace_no_overlap' ptr sz s \<and> 0 < n \<and>
-        (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-                 \<longrightarrow> sc_size_bounds us) \<and>
         range_cover ptr sz (APIType_capBits ty us) n\<rbrace>
    createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv s. caps_overlap_reserved' S s\<rbrace>"
@@ -3108,9 +3097,7 @@ lemma createNewCaps_caps_overlap_reserved':
 lemma createNewCaps_caps_overlap_reserved_ret':
   "\<lbrace>\<lambda>s. caps_overlap_reserved'
           {ptr..ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s \<and>
-        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s \<and> pspace_no_overlap' ptr sz s \<and>
-        (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us) \<and>
+        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s \<and>
         0 < n \<and> range_cover ptr sz (APIType_capBits ty us) n\<rbrace>
    createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv s. \<forall>y\<in>set rv. caps_overlap_reserved' (capRange y) s\<rbrace>"
@@ -3125,15 +3112,14 @@ lemma createNewCaps_caps_overlap_reserved_ret':
   apply (drule(1) range_cover_subset)
    apply simp
   apply (clarsimp simp: ptr_add_def capRange_def
-                  simp del: atLeastAtMost_simps)
+                  simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+                            Int_atLeastAtMost atLeastatMost_empty_iff)
   done
 
 lemma createNewCaps_descendants_range_ret':
  "\<lbrace>\<lambda>s.  (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)
-        \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+        \<and> pspace_aligned' s \<and> pspace_distinct' s
         \<and> pspace_no_overlap' ptr sz s
-        \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us)
         \<and> descendants_range_in' {ptr..ptr + of_nat n * 2^(APIType_capBits ty us) - 1} cref (ctes_of s)\<rbrace>
    createNewCaps ty ptr n us d
   \<lbrace> \<lambda>rv s. \<forall>y\<in>set rv. descendants_range' y cref (ctes_of s)\<rbrace>"
@@ -3154,11 +3140,9 @@ lemma createNewCaps_descendants_range_ret':
 
 lemma createNewCaps_parent_helper:
   "\<lbrace>\<lambda>s. cte_wp_at' (\<lambda>cte. cteCap cte = UntypedCap d (ptr && ~~ mask sz) sz idx) p s
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> pspace_no_overlap' ptr sz s
       \<and> (ty = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> 0 < us)
-      \<and> (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us)
       \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n \<rbrace>
     createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
@@ -3182,7 +3166,6 @@ lemma createNewCaps_valid_cap':
         range_cover ptr sz (APIType_capBits ty us) n \<and>
         (ty = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> 0 < us) \<and>
         (ty = APIObjectType apiobject_type.Untyped \<longrightarrow> minUntypedSizeBits \<le> us \<and> us \<le> maxUntypedSizeBits) \<and>
-        (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow> sc_size_bounds us) \<and>
        ptr \<noteq> 0 \<rbrace>
     createNewCaps ty ptr n us d
   \<lbrace>\<lambda>r s. \<forall>cap\<in>set r. s \<turnstile>' cap\<rbrace>"
@@ -3197,8 +3180,7 @@ lemma dmo_ctes_of[wp]:
   by (simp add: doMachineOp_def split_def | wp)+
 
 lemma createNewCaps_ranges:
-  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits ty us) n \<and> 0<n
-         \<and> (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us)\<rbrace>
+  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits ty us) n \<and> 0<n \<rbrace>
   createNewCaps ty ptr n us d
   \<lbrace>\<lambda>rv s. distinct_sets (map capRange rv)\<rbrace>"
   apply (rule hoare_assume_pre)
@@ -3224,8 +3206,7 @@ lemma createNewCaps_ranges:
   done
 
 lemma createNewCaps_ranges':
-  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n
-         \<and> (ty = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us)\<rbrace>
+  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n\<rbrace>
   createNewCaps ty ptr n us d
   \<lbrace>\<lambda>rv s. distinct_sets (map capRange (map snd (zip xs rv)))\<rbrace>"
   apply (rule hoare_strengthen_post)
@@ -3249,23 +3230,22 @@ lemma retype_region_caps_overlap_reserved:
       {ptr..ptr + of_nat n * 2^obj_bits_api (APIType_map2 (Inr ao')) us - 1} and
     (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s) and
     K (APIType_map2 (Inr ao') = Structures_A.apiobject_type.CapTableObject \<longrightarrow> 0 < us) and
-    K (ao' = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us) and
     K (range_cover ptr sz (obj_bits_api (APIType_map2 (Inr ao')) us) n) and
     K (S \<subseteq> {ptr..ptr + of_nat n *
                   2 ^ obj_bits_api (APIType_map2 (Inr ao')) us - 1})\<rbrace>
    retype_region ptr n us (APIType_map2 (Inr ao')) dev
    \<lbrace>\<lambda>rv s. caps_overlap_reserved S s\<rbrace>"
   apply (rule hoare_gen_asm)+
-  apply (simp (no_asm) add: caps_overlap_reserved_def2)
+  apply (simp (no_asm) add:caps_overlap_reserved_def2)
   apply (rule hoare_pre)
   apply (wp retype_region_caps_of)
-    apply (simp add: sc_size_bounds_def untyped_max_bits_def maxUntypedSizeBits_def sc_const_eq(3))+
-  apply (simp add: caps_overlap_reserved_def2)
-  apply (intro conjI, simp+)
+   apply simp+
+  apply (simp add:caps_overlap_reserved_def2)
+  apply (intro conjI,simp+)
   apply clarsimp
   apply (drule bspec)
    apply simp+
-  apply (erule (1) disjoint_subset2)
+  apply (erule(1) disjoint_subset2)
   done
 
 lemma retype_region_caps_overlap_reserved_ret:
@@ -3275,7 +3255,6 @@ lemma retype_region_caps_overlap_reserved_ret:
       {ptr..ptr + of_nat n * 2^obj_bits_api (APIType_map2 (Inr ao')) us - 1} and
     (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s) and
     K (APIType_map2 (Inr ao') = Structures_A.apiobject_type.CapTableObject \<longrightarrow> 0 < us) and
-    K (ao' = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us) and
     K (range_cover ptr sz (obj_bits_api (APIType_map2 (Inr ao')) us) n)\<rbrace>
    retype_region ptr n us (APIType_map2 (Inr ao')) dev
    \<lbrace>\<lambda>rv s. \<forall>y\<in>set rv. caps_overlap_reserved (untyped_range (default_cap
@@ -3297,9 +3276,6 @@ lemma retype_region_caps_overlap_reserved_ret:
    apply (clarsimp)+
   done
 
-crunch updateCap, updateFreeIndex
-  for sc_at'_n[wp]: "sc_at'_n n p"
-
 lemma updateFreeIndex_pspace_no_overlap':
   "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and>
         valid_pspace' s \<and> cte_wp_at' (isUntypedCap o cteCap) src s\<rbrace>
@@ -3307,7 +3283,7 @@ lemma updateFreeIndex_pspace_no_overlap':
    \<lbrace>\<lambda>r s. pspace_no_overlap' ptr sz s\<rbrace>"
   apply (simp add: updateFreeIndex_def getSlotCap_def updateTrackedFreeIndex_def)
   apply (rule hoare_pre)
-   apply (wp getCTE_wp' | wp (once) pspace_no_overlap'_lift2
+   apply (wp getCTE_wp' | wp (once) pspace_no_overlap'_lift
      | simp)+
   apply (clarsimp simp:valid_pspace'_def pspace_no_overlap'_def)
   done
@@ -3381,20 +3357,24 @@ lemma updateFreeIndex_updateCap_caps_no_overlap'':
   apply (clarsimp simp:caps_no_overlap''_def)
   apply (wp updateCap_ctes_of_wp)
   apply (clarsimp simp: modify_map_def ran_def cte_wp_at_ctes_of
-              simp del: atLeastAtMost_simps)
+              simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+                        Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex)
   apply (case_tac "a = src")
-   apply (clarsimp simp del: atLeastAtMost_simps)
+   apply (clarsimp simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+     Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex)
    apply (erule subsetD[rotated])
    apply (elim allE impE)
      apply fastforce
     apply (clarsimp simp:isCap_simps)
    apply (erule subset_trans)
    apply (clarsimp simp:isCap_simps)
-  apply clarsimp
+  apply (clarsimp simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+     Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex)
+   apply (erule subsetD[rotated])
   apply (elim allE impE)
-    prefer 2
+   prefer 2
     apply assumption
-   apply fastforce+
+  apply fastforce+
   done
 
 lemma updateFreeIndex_caps_no_overlap'':
@@ -3568,14 +3548,15 @@ lemma updateFreeIndex_valid_pspace_no_overlap':
         descendants_of' src (ctes_of s) = {}\<rbrace>
      updateFreeIndex src idx
    \<lbrace>\<lambda>r s. valid_pspace' s\<rbrace>"
+
    apply (clarsimp simp:valid_pspace'_def updateFreeIndex_def
      updateTrackedFreeIndex_def)
    apply (rule hoare_pre)
     apply (rule hoare_vcg_conj_lift)
      apply (clarsimp simp:updateCap_def getSlotCap_def)
      apply (wp getCTE_wp | simp)+
-    apply (wpsimp wp: updateFreeIndex_mdb_simple' getCTE_wp' valid_replies'_lift
-                simp: getSlotCap_def)+
+    apply (wp updateFreeIndex_mdb_simple' getCTE_wp'
+       | simp add: getSlotCap_def)+
   apply (clarsimp simp:cte_wp_at_ctes_of valid_pspace'_def)
   apply (case_tac cte,simp add:isCap_simps)
   apply (frule(1) ctes_of_valid_cap')
@@ -3606,7 +3587,7 @@ lemma updateFreeIndex_clear_invs':
         \<and> descendants_of' src (ctes_of s) = {}\<rbrace>
    updateFreeIndex src idx
    \<lbrace>\<lambda>r s. invs' s\<rbrace>"
-  apply (clarsimp simp:invs'_def valid_dom_schedule'_def)
+  apply (clarsimp simp:invs'_def valid_state'_def)
   apply (wp updateFreeIndex_valid_pspace_no_overlap')
    apply (simp add: updateFreeIndex_def updateTrackedFreeIndex_def)
    apply (wp updateFreeIndex_valid_pspace_no_overlap' sch_act_wf_lift valid_queues_lift
@@ -3634,7 +3615,6 @@ lemma updateFreeIndex_clear_invs':
   apply (frule(1) valid_global_refsD_with_objSize)
   apply clarsimp
   apply (intro conjI allI impI)
-    apply (clarsimp simp: opt_map_def comp_def)
    apply (clarsimp simp: modify_map_def cteCaps_of_def ifunsafe'_def3 split:if_splits)
     apply (drule_tac x=src in spec)
     apply (clarsimp simp:isCap_simps)
@@ -3658,18 +3638,21 @@ lemma cte_wp_at_pspace_no_overlapI':
   apply (case_tac cte,clarsimp)
   apply (frule ctes_of_valid_cap')
     apply (simp add:invs_valid_objs')
-  apply (clarsimp simp:valid_cap'_def invs'_def valid_pspace'_def
+  apply (clarsimp simp:valid_cap'_def invs'_def valid_state'_def valid_pspace'_def
     valid_untyped'_def simp del:usableUntypedRange.simps)
   apply (unfold pspace_no_overlap'_def)
   apply (intro allI impI)
   apply (unfold ko_wp_at'_def)
-  apply (clarsimp simp del: atLeastAtMost_simps usableUntypedRange.simps)
+  apply (clarsimp simp del: atLeastAtMost_iff
+          atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff  usableUntypedRange.simps)
   apply (drule spec)+
   apply (frule(1) pspace_distinctD')
   apply (frule(1) pspace_alignedD')
-  apply (frule(1) pspace_boundedD')
   apply (erule(1) impE)+
-  apply (clarsimp simp: obj_range'_def simp del: atLeastAtMost_simps usableUntypedRange.simps)
+  apply (clarsimp simp: obj_range'_def simp del: atLeastAtMost_iff
+          atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff  usableUntypedRange.simps)
   apply (erule disjoint_subset2[rotated])
   apply (frule(1) le_mask_le_2p)
   apply (clarsimp simp:p_assoc_help)
@@ -3765,7 +3748,7 @@ lemma descendants_range_ex_cte':
     invs' s';ctes_of s' p = Some cte;isUntypedCap (cteCap cte)\<rbrakk> \<Longrightarrow> q \<notin> S"
    apply (frule invs_valid_objs')
    apply (frule invs_mdb')
-   apply (clarsimp simp: invs'_def)
+   apply (clarsimp simp:invs'_def valid_state'_def)
    apply (clarsimp simp: ex_cte_cap_to'_def cte_wp_at_ctes_of)
     apply (frule_tac cte = "cte" in  valid_global_refsD')
     apply simp
@@ -3884,7 +3867,7 @@ lemma cte_wp_at': "cte_wp_at' (\<lambda>cte. cteCap cte = capability.UntypedCap
       "\<forall>x\<in>set slots. ex_cte_cap_wp_to' (\<lambda>_. True) x s"
   using vui
   by (auto simp: cte_wp_at_ctes_of)
-interpretation Arch . (*FIXME: arch_split*)
+interpretation Arch . (*FIXME: arch-split*)
 
 lemma idx_cases:
   "((\<not> reset \<and> idx \<le> unat (ptr - (ptr && ~~ mask sz))) \<or> reset \<and> ptr = ptr && ~~ mask sz)"
@@ -3973,7 +3956,7 @@ lemma caps_no_overlap'[simp]: "caps_no_overlap'' ptr sz s"
     lemma cref_inv: "cref \<notin> usable_range"
       apply (insert misc cte_wp_at')
       apply (drule if_unsafe_then_capD')
-        apply (simp add: invs'_def)
+        apply (simp add: invs'_def valid_state'_def)
        apply simp
       apply (erule ex_cte_no_overlap')
       done
@@ -4028,19 +4011,26 @@ lemma idx_le_new_offs:
 
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+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)"
-  and ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
-  and irq_node[wp]: "\<lambda>s. P (irq_node' s)"
-  (simp: crunch_simps wp: hoare_drop_imps unless_wp)
+  (simp: crunch_simps wp: hoare_drop_imps unless_wp ignore: freeMemory)
+crunch deleteObjects
+  for ksCurDomain[wp]: "\<lambda>s. P (ksCurDomain s)"
+  (simp: crunch_simps wp: hoare_drop_imps unless_wp ignore: freeMemory)
+crunch deleteObjects
+  for irq_node[wp]: "\<lambda>s. P (irq_node' s)"
+  (simp: crunch_simps wp: hoare_drop_imps unless_wp ignore: freeMemory)
 
 lemma deleteObjects_ksCurThread[wp]:
   "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> deleteObjects ptr sz \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
-  apply (simp add: deleteObjects_def3)
-  apply (wp | simp add: doMachineOp_def split_def)+
-  done
+apply (simp add: deleteObjects_def3)
+apply (wp | simp add: doMachineOp_def split_def)+
+done
 
 lemma deleteObjects_ct_active':
   "\<lbrace>invs' and sch_act_simple and ct_active'
@@ -4051,10 +4041,10 @@ lemma deleteObjects_ct_active':
    \<lbrace>\<lambda>_. ct_active'\<rbrace>"
   apply (simp add: ct_in_state'_def)
   apply (rule hoare_pre)
-   apply wps
-   apply (wp deleteObjects_st_tcb_at')
+  apply wps
+  apply (wp deleteObjects_st_tcb_at')
   apply (auto simp: ct_in_state'_def elim: pred_tcb'_weakenE)
-  done
+done
 
 defs cNodeOverlap_def:
   "cNodeOverlap \<equiv> \<lambda>cns inRange. \<exists>p n. cns p = Some n
@@ -4179,34 +4169,35 @@ lemma ex_tupI:
   "P (fst x) (snd x) \<Longrightarrow> \<exists>a b. P a b"
   by blast
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 (* mostly stuff about PPtr/fromPPtr, which seems pretty soft *)
 
 lemma resetUntypedCap_corres:
   "untypinv_relation ui ui'
     \<Longrightarrow> corres (dc \<oplus> dc)
-    (invs and valid_machine_time and schact_is_rct
-     and valid_untyped_inv_wcap ui (Some (cap.UntypedCap dev ptr sz idx)) and ct_active and einvs
-     and (\<lambda>_. \<exists>ptr_base ptr' ty us slots dev'. ui = Invocations_A.Retype slot True
-             ptr_base ptr' ty us slots dev))
-     (invs' and valid_untyped_inv_wcap' ui' (Some (UntypedCap dev ptr sz idx)) and ct_active')
-     (reset_untyped_cap slot)
-     (resetUntypedCap (cte_map slot))"
+    (einvs and schact_is_rct and ct_active
+     and valid_untyped_inv_wcap ui (Some (cap.UntypedCap dev ptr sz idx))
+     and (\<lambda>_. \<exists>ptr_base ptr' ty us slots dev'.
+               ui = Invocations_A.Retype slot True ptr_base ptr' ty us slots dev))
+    (invs' and valid_untyped_inv_wcap' ui' (Some (UntypedCap dev ptr sz idx)) and ct_active')
+    (reset_untyped_cap slot) (resetUntypedCap (cte_map slot))"
   apply (rule corres_gen_asm, clarsimp)
   apply (simp add: reset_untyped_cap_def resetUntypedCap_def
-                   liftE_bindE cong: if_cong)
+                   liftE_bindE)
   apply (rule corres_guard_imp)
-    apply (rule corres_split[OF getSlotCap_corres], simp)
+    apply (rule corres_split[OF getSlotCap_corres])
+       apply simp
       apply (rule_tac F="cap = cap.UntypedCap dev ptr sz idx
               \<and> (\<exists>s. s \<turnstile> cap)" in corres_gen_asm)
       apply (clarsimp simp: bits_of_def free_index_of_def unlessE_def
                  split del: if_split)
       apply (rule corres_if[OF refl])
        apply (rule corres_returnOk[where P=\<top> and P'=\<top>], simp)
-      apply (simp split del: if_split)
-      apply (rule corres_split[OF deleteObjects_corres])
-          apply (clarsimp simp add: valid_cap_def cap_aligned_def)
-         apply (clarsimp simp add: valid_cap_def cap_aligned_def untyped_min_bits_def)
+      apply (simp add: liftE_bindE bits_of_def split del: if_split)
+      apply (rule corres_split)
+         apply (rule deleteObjects_corres)
+          apply (clarsimp simp: valid_cap_def cap_aligned_def)
+         apply (clarsimp simp: valid_cap_def cap_aligned_def untyped_min_bits_def)
         apply (rule corres_if)
           apply simp
          apply (simp add: bits_of_def shiftL_nat)
@@ -4226,7 +4217,6 @@ lemma resetUntypedCap_corres:
                          o_def rev_map
                     del: capFreeIndex_update.simps)
         apply (rule_tac P="\<lambda>x. valid_objs and pspace_aligned and pspace_distinct
-                               and cur_sc_tcb and valid_machine_time and active_scs_valid
                        and pspace_no_overlap {ptr .. ptr + 2 ^ sz - 1}
                        and cte_wp_at (\<lambda>a. is_untyped_cap a \<and> obj_ref_of a = ptr \<and> cap_bits a = sz
                            \<and> cap_is_device a = dev) slot"
@@ -4241,7 +4231,8 @@ lemma resetUntypedCap_corres:
                   apply (simp add: shiftL_nat getFreeRef_def shiftl_t2n mult.commute)
                  apply simp
                 apply wp
-               apply (rule corres_split_nor[OF updateFreeIndex_corres])
+               apply (rule corres_split_nor)
+                  apply (rule updateFreeIndex_corres)
                    apply simp
                   apply (simp add: getFreeRef_def getFreeIndex_def free_index_of_def)
                   apply clarify
@@ -4260,42 +4251,19 @@ lemma resetUntypedCap_corres:
                    apply (erule order_less_le_trans; simp)
                   apply simp
                  apply (rule preemptionPoint_corres)
-                apply (wpsimp wp: update_untyped_cap_valid_objs)
-               apply (strengthen valid_pspace_valid_objs'
-                      | wpsimp wp: updateFreeIndex_valid_pspace_no_overlap')+
-             apply (wpsimp wp: hoare_vcg_ex_lift doMachineOp_psp_no_overlap)+
-            apply (fastforce intro: valid_untyped_pspace_no_overlap
-                              simp: cte_wp_at_caps_of_state valid_cap_def cap_aligned_def)
-           apply simp
+                apply wp+
+            apply (clarsimp simp: cte_wp_at_caps_of_state)
            apply (clarsimp simp: getFreeRef_def valid_pspace'_def cte_wp_at_ctes_of
                                  valid_cap_def cap_aligned_def)
-           apply (rule conjI impI)
-            apply (erule aligned_add_aligned)
-             apply (rule is_aligned_weaken)
-              apply (rule is_aligned_mult_triv2)
-             apply (simp add: Kernel_Config.resetChunkBits_def)
-            apply (simp add: untyped_min_bits_def)
-           apply (clarsimp simp: getFreeIndex_def getFreeRef_def)
-           apply (subst is_aligned_weaken[OF is_aligned_mult_triv2])
-            apply (simp add: Kernel_Config.resetChunkBits_def minUntypedSizeBits_def)
-           apply (subst unat_mult_simple)
-            apply (subst unat_of_nat_eq)
-             apply (rule order_less_trans[rotated],
-                    rule_tac n=sz in power_strict_increasing; simp add: word_bits_def)
-             apply (erule order_less_le_trans; simp)
-            apply (subst unat_p2)
-             apply (simp add: Kernel_Config.resetChunkBits_def)
-            apply (rule order_less_trans[rotated],
-                   rule_tac n=sz in power_strict_increasing; simp add: word_bits_def)
-           apply (subst unat_of_nat_eq)
-            apply (rule order_less_trans[rotated],
-                 rule_tac n=sz in power_strict_increasing; simp add: word_bits_def)
-            apply (erule order_less_le_trans; simp)
-           apply simp
-          apply simp
+           apply (erule aligned_add_aligned)
+            apply (rule is_aligned_weaken)
+             apply (rule is_aligned_mult_triv2)
+            apply (simp add: Kernel_Config.resetChunkBits_def)
+           apply (simp add: untyped_min_bits_def)
           apply (rule hoare_pre)
+           apply simp
            apply (strengthen imp_consequent)
-           apply (wp set_cap_cte_wp_at
+           apply (wp preemption_point_inv set_cap_cte_wp_at
                      update_untyped_cap_valid_objs
                      set_cap_no_overlap | simp)+
           apply (clarsimp simp: exI cte_wp_at_caps_of_state)
@@ -4310,7 +4278,7 @@ lemma resetUntypedCap_corres:
                     updateFreeIndex_descendants_of2
                     doMachineOp_psp_no_overlap
                     updateFreeIndex_cte_wp_at
-                    pspace_no_overlap'_lift2
+                    pspace_no_overlap'_lift
                     preemptionPoint_inv
                     hoare_vcg_ex_lift
                     | simp)+
@@ -4334,14 +4302,15 @@ lemma resetUntypedCap_corres:
          apply simp
         apply simp
        apply (simp add: if_apply_def2)
-       apply (strengthen invs_valid_objs invs_psp_aligned invs_distinct invs_cur_sc_tcb)
+       apply (strengthen invs_valid_objs invs_psp_aligned invs_distinct)
        apply (wp hoare_vcg_const_imp_lift)
       apply (simp add: if_apply_def2)
-      apply (strengthen invs_pspace_aligned' invs_pspace_distinct' invs_valid_pspace')
+      apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
+                        invs_valid_pspace')
       apply (wp hoare_vcg_const_imp_lift deleteObjects_cte_wp_at'[where p="cte_map slot"]
                 deleteObjects_invs'[where p="cte_map slot"]
                 deleteObjects_descendants[where p="cte_map slot"]
-             | simp)+
+           | simp)+
      apply (wp get_cap_wp getCTE_wp' | simp add: getSlotCap_def)+
    apply (clarsimp simp: cte_wp_at_caps_of_state descendants_range_def2)
    apply (cases slot)
@@ -4353,7 +4322,8 @@ lemma resetUntypedCap_corres:
    apply (frule if_unsafe_then_capD[OF caps_of_state_cteD], clarsimp+)
    apply (drule(1) ex_cte_cap_protects[OF _ caps_of_state_cteD
        empty_descendants_range_in _ order_refl], clarsimp+)
-   subgoal by (auto simp: valid_sched_def)
+   apply (intro conjI impI; auto)[1]
+
   apply (clarsimp simp: cte_wp_at_ctes_of descendants_range'_def2
                         empty_descendants_range_in')
   apply (frule cte_wp_at_valid_objs_valid_cap'[OF ctes_of_cte_wpD], clarsimp+)
@@ -4414,7 +4384,7 @@ lemma ex_cte_cap_wp_to_irq_state_independent_H[simp]:
   "irq_state_independent_H (ex_cte_cap_wp_to' P slot)"
   by (simp add: ex_cte_cap_wp_to'_def)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 lemma updateFreeIndex_ctes_of:
   "\<lbrace>\<lambda>s.  P (modify_map (ctes_of s) ptr (cteCap_update (capFreeIndex_update (\<lambda>_. idx))))\<rbrace>
@@ -4515,7 +4485,7 @@ lemma resetUntypedCap_invs_etc:
               hoare_vcg_const_Ball_lift
               updateFreeIndex_descendants_of2
               sch_act_simple_lift
-              pspace_no_overlap'_lift2
+              pspace_no_overlap'_lift
               doMachineOp_psp_no_overlap
               updateFreeIndex_ctes_of
               updateFreeIndex_cte_wp_at
@@ -4532,25 +4502,25 @@ lemma resetUntypedCap_invs_etc:
       in mapME_x_validE_nth)
      apply (rule hoare_pre)
       apply simp
-      apply (wpsimp wp: preemptionPoint_invs
-                        updateFreeIndex_clear_invs'
-                        hoare_vcg_ex_lift
-                        updateFreeIndex_descendants_of2
-                        updateFreeIndex_ctes_of
-                        updateFreeIndex_cte_wp_at
-                        doMachineOp_psp_no_overlap
-                        hoare_vcg_ex_lift hoare_vcg_const_Ball_lift
-                        pspace_no_overlap'_lift[OF preemptionPoint_inv]
-                        pspace_no_overlap'_lift preemptionPoint_inv
-                        updateFreeIndex_ct_in_state[unfolded ct_in_state'_def]
+      apply (wp preemptionPoint_invs
+                updateFreeIndex_clear_invs'
+                hoare_vcg_ex_lift
+                updateFreeIndex_descendants_of2
+                updateFreeIndex_ctes_of
+                updateFreeIndex_cte_wp_at
+                doMachineOp_psp_no_overlap
+                hoare_vcg_ex_lift hoare_vcg_const_Ball_lift
+                pspace_no_overlap'_lift[OF preemptionPoint_inv]
+                pspace_no_overlap'_lift
+                updateFreeIndex_ct_in_state[unfolded ct_in_state'_def]
               | strengthen invs_pspace_aligned' invs_pspace_distinct'
-              | simp add: ct_in_state'_def getCurrentTime_independent_H_def ex_cte_cap_wp_to'_def
-                          time_state_independent_H_def sch_act_simple_def
+              | simp add: ct_in_state'_def
+                          sch_act_simple_def
               | rule hoare_vcg_conj_liftE_R
               | wp (once) preemptionPoint_inv
               | wps
               | wp (once) ex_cte_cap_to'_pres)+
-     apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps ex_cte_cap_wp_to'_def
+     apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps
                            conj_comms)
      apply (subgoal_tac "getFreeIndex ptr
             (rev [ptr , ptr + 2 ^ resetChunkBits .e. getFreeRef ptr idx - 1] ! i)
@@ -4636,7 +4606,7 @@ lemma (in range_cover) funky_aligned:
   apply simp
   done
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 defs archOverlap_def:
   "archOverlap \<equiv> \<lambda>_ _. False"
@@ -4644,7 +4614,7 @@ defs archOverlap_def:
 lemma inv_untyped_corres':
   "\<lbrakk> untypinv_relation ui ui' \<rbrakk> \<Longrightarrow>
    corres (dc \<oplus> (=))
-     (einvs and valid_machine_time and valid_untyped_inv ui and ct_active and schact_is_rct)
+     (einvs and valid_untyped_inv ui and ct_active and schact_is_rct)
      (invs' and valid_untyped_inv' ui' and ct_active')
      (invoke_untyped ui) (invokeUntyped ui')"
   apply (cases ui)
@@ -4663,7 +4633,7 @@ lemma inv_untyped_corres':
                   (cte_map cref) reset ptr_base ptr ao' us (map cte_map slots) dev"
 
     assume invs: "invs (s :: det_state)" "ct_active s" "valid_list s" "valid_sched s"
-                 "schact_is_rct s" "valid_machine_time s"
+                 "schact_is_rct s"
     and   invs': "invs' s'" "ct_active' s'"
     and      sr: "(s, s') \<in> state_relation"
     and     vui: "valid_untyped_inv_wcap ?ui (Some (cap.UntypedCap dev (ptr && ~~ mask sz) sz idx)) s"
@@ -4696,7 +4666,6 @@ lemma inv_untyped_corres':
       apply (cases ao')
       apply (simp_all add: obj_bits_api_def slot_bits_def arch_kobj_size_def default_arch_object_def
                            APIType_map2_def untyped_min_bits_def minUntypedSizeBits_def
-                           min_sched_context_bits_def
                     split: apiobject_type.splits)
       done
 
@@ -4774,8 +4743,8 @@ lemma inv_untyped_corres':
        apply (clarsimp simp:range_cover_def)
        done
 
-    note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
-                          usableUntypedRange.simps
+    note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex usableUntypedRange.simps
 
     have vc'[simp] : "s' \<turnstile>' capability.UntypedCap dev (ptr && ~~ mask sz) sz idx"
       using vui' invs'
@@ -4827,7 +4796,7 @@ lemma inv_untyped_corres':
 
     have maxDomain:"ksCurDomain s' \<le> maxDomain"
       using invs'
-      by (simp add:invs'_def)
+      by (simp add:invs'_def valid_state'_def)
 
     have sz_mask_less:
       "unat (ptr && mask sz) < 2 ^ sz"
@@ -4898,7 +4867,6 @@ lemma inv_untyped_corres':
                  apply simp+
              apply (simp add: insertNewCaps_def)
              apply (rule corres_split_retype_createNewCaps[where sz = sz,OF corres_rel_imp])
-                apply (clarsimp simp: mapM_x_def)
                 apply (rule inv_untyped_corres_helper1)
                 apply simp
                apply simp
@@ -4947,7 +4915,7 @@ lemma inv_untyped_corres':
                      set_cap_cte_wp_at
                      | strengthen exI[where x=cref])+
           apply (clarsimp simp:conj_comms ball_conj_distrib simp del:capFreeIndex_update.simps)
-          apply (strengthen invs_pspace_aligned' invs_pspace_distinct' invs_pspace_bounded'
+          apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
                invs_valid_pspace' invs_arch_state'
                imp_consequent[where Q = "(\<exists>x. x \<in> cte_map ` set slots)"]
              | clarsimp simp: conj_comms simp del: capFreeIndex_update.simps)+
@@ -4961,11 +4929,10 @@ lemma inv_untyped_corres':
                 invs_valid_pspace invs_arch_state invs_psp_aligned
                 invs_distinct)
          apply (clarsimp simp:conj_comms ball_conj_distrib ex_in_conv)
-         apply (rule validE_R_validE, rule_tac Q'="\<lambda>_ s. valid_list s \<and> invs s \<and> ct_active s
+         apply (rule validE_R_validE, rule_tac Q'="\<lambda>_ s. valid_etcbs s \<and> 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)
-          \<and> scheduler_action s = resume_cur_thread
           " in hoare_strengthen_postE_R)
           apply (simp add: whenE_def, wp)
            apply (rule validE_validE_R, rule hoare_strengthen_postE, rule reset_untyped_cap_invs_etc, auto)[1]
@@ -4995,7 +4962,7 @@ lemma inv_untyped_corres':
                           atLeastatMost_subset_iff[where b=x and d=x for x]
                           word_and_le2)
          apply (intro conjI impI)
-             apply (clarsimp simp: scBits_simps)
+
             (* offs *)
             apply (drule(1) invoke_untyped_proofs.idx_le_new_offs)
             apply simp
@@ -5023,7 +4990,7 @@ lemma inv_untyped_corres':
                               invokeUntyped_proofs.ps_no_overlap'
                               invokeUntyped_proofs.descendants_range
                               if_split[where P="\<lambda>v. v \<le> getFreeIndex x y" for x y]
-                              empty_descendants_range_in' invs_pspace_bounded'
+                              empty_descendants_range_in'
                               invs_pspace_aligned' invs_pspace_distinct'
                               invs_ksCurDomain_maxDomain'
                         cong: if_cong)
@@ -5050,7 +5017,7 @@ lemma inv_untyped_corres':
       apply (clarsimp simp only: pred_conj_def invs ui if_apply_def2)
       apply (strengthen vui)
       apply (cut_tac vui invs invs')
-      apply (clarsimp simp: cte_wp_at_caps_of_state schact_is_rct_def)
+      apply (clarsimp simp: cte_wp_at_caps_of_state valid_sched_etcbs schact_is_rct_def)
      apply (cut_tac vui' invs')
      apply (clarsimp simp: ui cte_wp_at_ctes_of if_apply_def2 ui')
      done
@@ -5067,8 +5034,12 @@ crunch doMachineOp
   (wp: crunch_wps)
 
 
+crunch set_thread_state
+  for irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
+crunch setQueue
+  for ctes_of[wp]: "\<lambda>s. P (ctes_of s)"
 crunch setQueue
- for cte_wp_at[wp]: "cte_wp_at' P p"
+  for cte_wp_at[wp]: "cte_wp_at' P p"
   (simp: cte_wp_at_ctes_of)
 
 lemma sts_valid_untyped_inv':
@@ -5086,9 +5057,7 @@ crunch invokeUntyped
 
 crunch insertNewCap
   for no_0_obj'[wp]: no_0_obj'
-  and reply_projs[wp]: "\<lambda>s. P (replyNexts_of s) (replyPrevs_of s) (replyTCBs_of s) (replySCs_of s)"
-  and valid_replies' [wp]: valid_replies'
-  (wp: crunch_wps valid_replies'_lift)
+  (wp: crunch_wps)
 
 lemma insertNewCap_valid_pspace':
   "\<lbrace>\<lambda>s. valid_pspace' s \<and> s \<turnstile>' cap
@@ -5099,7 +5068,8 @@ lemma insertNewCap_valid_pspace':
      insertNewCap parent slot cap
    \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
   apply (simp add: valid_pspace'_def)
-  apply (wpsimp wp: insertNewCap_valid_mdb)
+  apply (wp insertNewCap_valid_mdb)
+     apply simp_all
   done
 
 crunch insertNewCap
@@ -5115,19 +5085,15 @@ crunch insertNewCap
   for norqL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
   (wp: crunch_wps)
 crunch insertNewCap
- for state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
+  for ct[wp]: "\<lambda>s. P (ksCurThread s)"
+  (wp: crunch_wps)
+crunch insertNewCap
+  for state_refs_of'[wp]: "\<lambda>s. P (state_refs_of' s)"
   (wp: crunch_wps)
 crunch updateNewFreeIndex
- for if_unsafe_then_cap'[wp]: "if_unsafe_then_cap'"
-
-lemma insertNewCap_list_refs_of_replies'[wp]:
-  "insertNewCap parent slot cap \<lbrace>\<lambda>s. P (list_refs_of_replies' s)\<rbrace>"
-  apply (clarsimp simp: insertNewCap_def)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (rule bind_wp_fwd_skip, wpsimp)
-  apply (wpsimp wp: getCTE_wp)
-  apply (clarsimp simp: opt_map_def list_refs_of_reply'_def o_def split: option.splits)
-  done
+  for cteCaps[wp]: "\<lambda>s. P (cteCaps_of s)"
+crunch updateNewFreeIndex
+  for if_unsafe_then_cap'[wp]: "if_unsafe_then_cap'"
 
 lemma insertNewCap_ifunsafe'[wp]:
   "\<lbrace>if_unsafe_then_cap' and ex_cte_cap_to' slot\<rbrace>
@@ -5246,7 +5212,11 @@ crunch insertNewCap
   (wp: crunch_wps)
 
 crunch insertNewCap
- for tcbState_inv[wp]: "obj_at' (\<lambda>tcb. P (tcbState tcb)) t"
+  for ct_not_inQ[wp]: "ct_not_inQ"
+  (wp: crunch_wps)
+
+crunch insertNewCap
+  for tcbState_inv[wp]: "obj_at' (\<lambda>tcb. P (tcbState tcb)) t"
   (wp: crunch_simps hoare_drop_imps)
 crunch insertNewCap
   for tcbDomain_inv[wp]: "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
@@ -5268,11 +5238,6 @@ crunch insertNewCap
   for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
   (wp: crunch_simps hoare_drop_imps)
 
-crunch insertNewCap
-  for valid_release_queue[wp]: "valid_release_queue"
-  and valid_release_queue'[wp]: "valid_release_queue'"
-  (wp: crunch_wps)
-
 lemma capRange_subset_capBits:
   "capAligned cap \<Longrightarrow> capAligned cap'
     \<Longrightarrow> capRange cap \<subseteq> capRange cap'
@@ -5327,11 +5292,12 @@ lemma insertNewCap_invs':
           and K (\<not> isZombie cap) and (\<lambda>s. descendants_range' cap parent (ctes_of s))
           and caps_overlap_reserved' (untypedRange cap)
           and ex_cte_cap_to' slot
+          and (\<lambda>s. ksIdleThread s \<notin> capRange cap)
           and (\<lambda>s. \<forall>irq. cap = IRQHandlerCap irq \<longrightarrow> irq_issued' irq s)\<rbrace>
      insertNewCap parent slot cap
    \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (rule insertNewCap_nullcap)
-  apply (simp add: invs'_def valid_dom_schedule'_def)
+  apply (simp add: invs'_def valid_state'_def)
   apply (rule hoare_pre)
    apply (wp insertNewCap_valid_pspace' sch_act_wf_lift
              cur_tcb_lift tcb_in_cur_domain'_lift valid_bitmaps_lift
@@ -5365,6 +5331,7 @@ lemma zipWithM_x_insertNewCap_invs'':
         \<and> (\<forall>tup \<in> set ls. \<not> isZombie (snd tup))
         \<and> (\<forall>tup \<in> set ls. ex_cte_cap_to' (fst tup) s)
         \<and> (\<forall>tup \<in> set ls. descendants_range' (snd tup) parent (ctes_of s))
+        \<and> (\<forall>tup \<in> set ls. ksIdleThread s \<notin> capRange (snd tup))
         \<and> (\<forall>tup \<in> set ls. caps_overlap_reserved' (capRange (snd tup)) s)
         \<and> distinct_sets (map capRange (map snd ls))
         \<and> (\<forall>irq. IRQHandlerCap irq \<in> set (map snd ls) \<longrightarrow> irq_issued' irq s)
@@ -5390,19 +5357,21 @@ lemma zipWithM_x_insertNewCap_invs'':
 
 lemma createNewCaps_not_isZombie[wp]:
   "\<lbrace>\<top>\<rbrace> createNewCaps ty ptr bits sz d \<lbrace>\<lambda>rv s. (\<forall>cap \<in> set rv. \<not> isZombie cap)\<rbrace>"
-  apply (simp add: createNewCaps_def toAPIType_def
+  apply (simp add: createNewCaps_def toAPIType_def ARM_H.toAPIType_def
+                   createNewCaps_def
               split del: if_split cong: option.case_cong if_cong
                                         apiobject_type.case_cong
                                         ARM_H.object_type.case_cong)
-  apply (wp undefined_valid | wpc | simp add: isCap_simps)+
+  apply (rule hoare_pre)
+   apply (wp undefined_valid | wpc
+            | simp add: isCap_simps)+
+  apply auto?
   done
 
 lemma createNewCaps_cap_to':
   "\<lbrace>\<lambda>s. ex_cte_cap_to' p s \<and> 0 < n
       \<and> range_cover ptr sz (APIType_capBits ty us) n
-      \<and> pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_bounded' s
-      \<and>  (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us)
+      \<and> pspace_aligned' s \<and> pspace_distinct' s
       \<and> pspace_no_overlap' ptr sz s\<rbrace>
      createNewCaps ty ptr n us d
    \<lbrace>\<lambda>rv. ex_cte_cap_to' p\<rbrace>"
@@ -5413,13 +5382,25 @@ lemma createNewCaps_cap_to':
   apply fastforce
   done
 
+crunch copyGlobalMappings
+  for it[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (wp: mapM_x_wp' ignore: clearMemory)
+
+lemma createNewCaps_idlethread[wp]:
+  "\<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> createNewCaps tp ptr sz us d \<lbrace>\<lambda>rv s. P (ksIdleThread s)\<rbrace>"
+  apply (simp add: createNewCaps_def toAPIType_def
+            split: ARM_H.object_type.split
+                   apiobject_type.split)
+  apply safe
+          apply (wp mapM_x_wp' | simp)+
+  done
+
 lemma createNewCaps_idlethread_ranges[wp]:
   "\<lbrace>\<lambda>s. 0 < n \<and> range_cover ptr sz (APIType_capBits tp us) n
-           \<and> ksIdleThread s \<notin> {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}
-         \<and> (tp = APIObjectType SchedContextObject \<longrightarrow> sc_size_bounds us)\<rbrace>
+           \<and> ksIdleThread s \<notin> {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}\<rbrace>
      createNewCaps tp ptr n us d
    \<lbrace>\<lambda>rv s. \<forall>cap\<in>set rv. ksIdleThread s \<notin> capRange cap\<rbrace>"
-  apply (rule hoare_as_subst [OF createNewCaps_it])
+  apply (rule hoare_as_subst [OF createNewCaps_idlethread])
   apply (rule hoare_assume_pre)
   apply (rule hoare_chain, rule createNewCaps_range_helper2)
    apply fastforce
@@ -5435,11 +5416,11 @@ lemma createNewCaps_IRQHandler[wp]:
    apply (wp | wpc | simp add: image_def | rule hoare_pre_cont)+
   done
 
+crunch updateCap
+  for ksIdleThread[wp]: "\<lambda>s. P (ksIdleThread s)"
+
 lemma createNewCaps_ct_active':
-  "\<lbrace>ct_active' and pspace_aligned' and pspace_distinct' and pspace_bounded' and pspace_no_overlap' ptr sz and
-    K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n \<and>
-       (ty = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us))\<rbrace>
+  "\<lbrace>ct_active' and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)\<rbrace>
     createNewCaps ty ptr n us d
    \<lbrace>\<lambda>_. ct_active'\<rbrace>"
    apply (simp add: ct_in_state'_def)
@@ -5465,8 +5446,6 @@ lemma invokeUntyped_invs'':
  assumes createNew_Q: "\<And>tp ptr n us sz dev. \<lbrace>\<lambda>s. Q s
      \<and> range_cover ptr sz (APIType_capBits tp us) n
      \<and> (tp = APIObjectType ArchTypes_H.apiobject_type.CapTableObject \<longrightarrow> 0 < us)
-     \<and> (tp = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject
-               \<longrightarrow> sc_size_bounds us)
      \<and> 0 < n \<and> valid_pspace' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
     createNewCaps tp ptr n us dev \<lbrace>\<lambda>_. Q\<rbrace>"
  assumes set_free_Q[wp]: "\<And>slot idx. \<lbrace>invs' and Q\<rbrace> updateFreeIndex slot idx \<lbrace>\<lambda>_.Q\<rbrace>"
@@ -5506,7 +5485,6 @@ lemma invokeUntyped_invs'':
       and slots: "cref \<notin> set slots" "distinct slots" "slots \<noteq> []"
       and tps: "tp = APIObjectType ArchTypes_H.apiobject_type.CapTableObject \<longrightarrow> 0 < us"
             "tp = APIObjectType ArchTypes_H.apiobject_type.Untyped \<longrightarrow> minUntypedSizeBits \<le> us \<and> us \<le> maxUntypedSizeBits"
-            "tp = APIObjectType ArchTypes_H.apiobject_type.SchedContextObject \<longrightarrow> sc_size_bounds us"
       using vui
       by (clarsimp simp: ui cte_wp_at_ctes_of)+
 
@@ -5527,8 +5505,8 @@ lemma invokeUntyped_invs'':
        apply (clarsimp simp:range_cover_def)
        done
 
-    note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_simps
-                          usableUntypedRange.simps
+    note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
+          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex usableUntypedRange.simps
     note descendants_range[simp] = invokeUntyped_proofs.descendants_range[OF pf]
     note ps_no_overlap'[simp] = invokeUntyped_proofs.ps_no_overlap'[OF pf]
     note caps_no_overlap'[simp] = invokeUntyped_proofs.caps_no_overlap'[OF pf]
@@ -5603,7 +5581,7 @@ lemma invokeUntyped_invs'':
         apply (clarsimp simp: slots)
        apply (clarsimp simp:conj_comms ball_conj_distrib pred_conj_def
                    simp del:capFreeIndex_update.simps)
-       apply (strengthen invs_pspace_aligned' invs_pspace_distinct' invs_pspace_bounded'
+       apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
                 invs_valid_pspace' invs_arch_state'
                 imp_consequent[where Q = "(\<exists>x. x \<in> set slots)"]
               | clarsimp simp: conj_comms simp del: capFreeIndex_update.simps)+
@@ -5633,9 +5611,8 @@ lemma invokeUntyped_invs'':
           apply (erule is_aligned_weaken[OF range_cover.funky_aligned])
           apply (simp add: APIType_capBits_def objBits_simps' minUntypedSizeBits_def
                     split: object_type.split apiobject_type.split)[1]
-          apply (clarsimp simp: sc_size_bounds_def minSchedContextBits_def)
          apply (cases reset)
-          apply (clarsimp simp: sc_size_bounds_def minSchedContextBits_def)
+          apply clarsimp
          apply (clarsimp simp: invokeUntyped_proofs.ps_no_overlap')
         apply (drule invs_valid_global')
         apply (clarsimp simp: valid_global_refs'_def cte_at_valid_cap_sizes_0)
@@ -5646,7 +5623,10 @@ lemma invokeUntyped_invs'':
       apply (simp add: blah word_and_le2)
      apply (rule order_trans, erule invokeUntyped_proofs.subset_stuff)
      apply (simp add: blah word_and_le2)
-  done
+    apply (frule valid_global_refsD2', clarsimp)
+    apply (clarsimp simp: global_refs'_def)
+    apply (erule notE, erule subsetD[rotated], simp add: blah word_and_le2)
+    done
 qed
 
 lemma invokeUntyped_invs'[wp]:
@@ -5664,29 +5644,23 @@ lemma resetUntypedCap_st_tcb_at':
   "\<lbrace>invs' and st_tcb_at' (P and ((\<noteq>) Inactive) and ((\<noteq>) IdleThreadState)) t
       and cte_wp_at' (\<lambda>cp. isUntypedCap (cteCap cp)) slot
       and ct_active' and sch_act_simple and (\<lambda>s. descendants_of' slot (ctes_of s) = {})\<rbrace>
-   resetUntypedCap slot
-   \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
+    resetUntypedCap slot
+  \<lbrace>\<lambda>_. st_tcb_at' P t\<rbrace>"
+  apply (rule hoare_name_pre_state)
   apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
-  apply (rule_tac
-          Q="\<lambda>s. \<exists>d v0 v1 f. invs' s
-                             \<and> st_tcb_at' (P and (\<noteq>) Structures_H.thread_state.Inactive and
-                                            (\<noteq>) Structures_H.thread_state.IdleThreadState) t s
-                             \<and> (cte_wp_at' (\<lambda>cp. cteCap cp = capability.UntypedCap d v0 v1 f) slot s)
-                             \<and> ct_active' s
-                             \<and> sch_act_simple s
-                             \<and>  (descendants_of' slot (ctes_of s) = {})"
-          in hoare_weaken_pre[rotated])
-   apply (clarsimp simp: cte_wp_at'_def)
-  apply (subst hoare_ex_all[symmetric])+
-  apply (clarsimp simp: resetUntypedCap_def)
-  apply (wpsimp wp: unlessE_wp deleteObjects_st_tcb_at'[where p=slot] mapME_x_inv_wp
-                    preemptionPoint_inv hoare_drop_imps getSlotCap_wp)
+  apply (simp add: resetUntypedCap_def)
+  apply (rule hoare_pre)
+   apply (wp mapME_x_inv_wp preemptionPoint_inv
+             deleteObjects_st_tcb_at'[where p=slot] getSlotCap_wp
+           | simp add: unless_def
+           | wp (once) hoare_drop_imps)+
   apply (clarsimp simp: cte_wp_at_ctes_of)
+  apply (strengthen refl)
   apply (rule exI, strengthen refl)
   apply (frule cte_wp_at_valid_objs_valid_cap'[OF ctes_of_cte_wpD], clarsimp+)
   apply (clarsimp simp: valid_cap_simps' capAligned_def empty_descendants_range_in'
-                         descendants_range'_def2
-                  elim!: pred_tcb'_weakenE)
+                        descendants_range'_def2
+                 elim!: pred_tcb'_weakenE)
   done
 
 lemma inv_untyp_st_tcb_at'[wp]:
@@ -5725,5 +5699,24 @@ crunch deleteObjects, updateFreeIndex
   (wp: doMachineOp_irq_states' crunch_wps
    simp: freeMemory_def no_irq_storeWord unless_def)
 
+lemma resetUntypedCap_IRQInactive:
+  "\<lbrace>valid_irq_states'\<rbrace>
+    resetUntypedCap slot
+  \<lbrace>\<lambda>_ _. True\<rbrace>, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  (is "\<lbrace>?P\<rbrace> resetUntypedCap slot \<lbrace>?Q\<rbrace>,\<lbrace>?E\<rbrace>")
+  apply (simp add: resetUntypedCap_def)
+  apply (rule hoare_pre)
+   apply (wp mapME_x_inv_wp[where P=valid_irq_states' and E="?E", THEN hoare_strengthen_postE]
+             doMachineOp_irq_states' preemptionPoint_inv hoare_drop_imps
+     | simp add: no_irq_clearMemory if_apply_def2)+
+  done
+
+lemma inv_untyped_IRQInactive:
+  "\<lbrace>valid_irq_states'\<rbrace> invokeUntyped ui
+  -, \<lbrace>\<lambda>rv s. intStateIRQTable (ksInterruptState s) rv \<noteq> irqstate.IRQInactive\<rbrace>"
+  apply (simp add: invokeUntyped_def)
+  apply (wpsimp wp: resetUntypedCap_IRQInactive)
+  done
+
 end
 end
diff --git a/proof/refine/ARM/VSpace_R.thy b/proof/refine/ARM/VSpace_R.thy
index 05e30ec0f8..248c38f66c 100644
--- a/proof/refine/ARM/VSpace_R.thy
+++ b/proof/refine/ARM/VSpace_R.thy
@@ -1,5 +1,4 @@
 (*
- * Copyright 2022, Proofcraft Pty Ltd
  * Copyright 2014, General Dynamics C4 Systems
  *
  * SPDX-License-Identifier: GPL-2.0-only
@@ -12,16 +11,14 @@
 theory VSpace_R
 imports TcbAcc_R
 begin
+context Arch begin global_naming ARM (*FIXME: arch-split*)
 
-context Arch begin global_naming ARM (*FIXME: arch_split*)
-
-(*FIXME: move to ainvs*)
 lemmas store_pte_typ_ats[wp] = store_pte_typ_ats abs_atyp_at_lifts[OF store_pte_typ_at]
 lemmas store_pde_typ_ats[wp] = store_pde_typ_ats abs_atyp_at_lifts[OF store_pde_typ_at]
 
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 definition
   "pd_at_asid' pd asid \<equiv> \<lambda>s. \<exists>ap pool.
@@ -64,8 +61,8 @@ lemma findPDForASIDAssert_pd_at_wp:
   done
 
 crunch findPDForASIDAssert
- for inv[wp]: "P"
-  (simp: const_def crunch_simps wp: crunch_wps ignore_del: getObject)
+  for inv[wp]: "P"
+  (simp: const_def crunch_simps wp: loadObject_default_inv crunch_wps ignore_del: getObject)
 
 lemma pspace_relation_pd:
   assumes p: "pspace_relation (kheap a) (ksPSpace c)"
@@ -82,7 +79,7 @@ lemma pspace_relation_pd:
   apply (drule_tac x="ucast y" in spec, clarsimp)
   apply (simp add: ucast_ucast_mask iffD2 [OF mask_eq_iff_w2p] word_size)
   apply (clarsimp simp add: pde_relation_def)
-  apply (drule(2) aligned_distinct_pde_atI', simp)
+  apply (drule(2) aligned_distinct_pde_atI')
   apply (erule obj_at'_weakenE)
   apply simp
   done
@@ -119,7 +116,7 @@ lemma find_pd_for_asid_eq_helper:
   apply (drule ucast_up_inj, simp)
   apply (simp add: find_pd_for_asid_def bind_assoc
                    word_neq_0_conv[symmetric] liftE_bindE)
-  apply (simp add: exec_gets liftE_bindE bind_assoc gets_the_def
+  apply (simp add: exec_gets liftE_bindE bind_assoc
                    get_asid_pool_def get_object_def)
   apply (simp add: mask_asid_low_bits_ucast_ucast)
   apply (drule ucast_up_inj, simp)
@@ -142,8 +139,9 @@ lemma find_pd_for_asid_assert_eq:
                   cong: bind_apply_cong)
   apply (clarsimp split: Structures_A.kernel_object.splits
                          arch_kernel_obj.splits if_split_asm)
-  apply (simp add: get_pde_def get_pd_def get_object_def gets_the_def
-                   bind_assoc pd_bits_def pdBits_def pdeBits_def pageBits_def)
+  apply (simp add: get_pde_def get_pd_def get_object_def
+                   bind_assoc is_aligned_neg_mask_eq
+                   pd_bits_def pdBits_def pdeBits_def pageBits_def)
   apply (simp add: exec_gets)
   done
 
@@ -165,7 +163,8 @@ lemma find_pd_for_asid_valids:
   apply (simp_all add: validE_def validE_R_def validE_E_def
                        valid_def split: sum.split)
   apply (auto simp: returnOk_def return_def pdeBits_def
-                    pde_at_def pd_bits_def pdBits_def pageBits_def
+                    pde_at_def pd_bits_def pdBits_def
+                    pageBits_def is_aligned_neg_mask_eq
              dest!: find_pd_for_asid_eq_helper
              elim!: is_aligned_weaken)
   done
@@ -228,7 +227,7 @@ lemma findPDForASIDAssert_corres:
           apply (clarsimp split: Structures_A.kernel_object.splits
                                  arch_kernel_obj.splits if_split_asm)
           apply (simp add: get_pde_def exs_valid_def bind_def return_def
-                           get_pd_def get_object_def simpler_gets_def gets_the_def)
+                           get_pd_def get_object_def simpler_gets_def)
          apply wp
          apply simp
         apply (simp add: get_pde_def get_pd_def)
@@ -240,8 +239,9 @@ lemma findPDForASIDAssert_corres:
        apply simp
       apply (clarsimp simp: state_relation_def)
       apply (erule(3) pspace_relation_pd)
-      apply (simp add: pde_at_def pd_bits_def pdBits_def pdeBits_def pageBits_def)
-       apply (wp find_pd_for_asid_valids[where pd=pd])+
+      apply (simp add: pde_at_def pd_bits_def pdBits_def
+                       is_aligned_neg_mask_eq pdeBits_def pageBits_def)
+     apply (wp find_pd_for_asid_valids[where pd=pd])+
    apply (clarsimp simp: word_neq_0_conv valid_vspace_objs_def)
   apply simp
   done
@@ -597,6 +597,8 @@ lemma invalidate_tlb_by_asid_corres_ex:
    apply simp+
   done
 
+crunch do_machine_op
+  for valid_global_objs[wp]: "valid_global_objs"
 lemma state_relation_asid_map:
   "(s, s') \<in> state_relation \<Longrightarrow> armKSASIDMap (ksArchState s') = arm_asid_map (arch_state s)"
   by (simp add: state_relation_def arch_state_relation_def)
@@ -801,10 +803,21 @@ lemma invalidateASIDEntry_corres:
   apply simp
   done
 
+crunch invalidateASID
+  for aligned'[wp]: "pspace_aligned'"
+crunch invalidateASID
+  for distinct'[wp]: "pspace_distinct'"
+
+lemma invalidateASID_cur' [wp]:
+  "\<lbrace>cur_tcb'\<rbrace> invalidateASID x \<lbrace>\<lambda>_. cur_tcb'\<rbrace>"
+  by (simp add: invalidateASID_def|wp)+
+
 crunch invalidateASIDEntry
-  for aligned' [wp]: pspace_aligned'
-  and distinct' [wp]:  pspace_distinct'
-  and cur' [wp]:  cur_tcb'
+  for aligned'[wp]: pspace_aligned'
+crunch invalidateASIDEntry
+  for distinct'[wp]: pspace_distinct'
+crunch invalidateASIDEntry
+  for cur'[wp]: cur_tcb'
 
 lemma invalidateASID_valid_arch_state [wp]:
   "\<lbrace>valid_arch_state'\<rbrace> invalidateASIDEntry x \<lbrace>\<lambda>_. valid_arch_state'\<rbrace>"
@@ -818,12 +831,12 @@ lemma invalidateASID_valid_arch_state [wp]:
   done
 
 crunch deleteASID
- for no_0_obj'[wp]: "no_0_obj'"
-  (simp: crunch_simps wp: crunch_wps getObject_inv)
+  for no_0_obj'[wp]: "no_0_obj'"
+  (simp: crunch_simps wp: crunch_wps getObject_inv loadObject_default_inv)
 
 lemma deleteASID_corres:
   "corres dc
-          (invs and K (asid \<le> mask asid_bits \<and> asid \<noteq> 0))
+          (invs and valid_etcbs and K (asid \<le> mask asid_bits \<and> asid \<noteq> 0))
           (pspace_aligned' and pspace_distinct' and no_0_obj'
               and valid_arch_state' and cur_tcb')
           (delete_asid asid pd) (deleteASID asid pd)"
@@ -834,7 +847,7 @@ lemma deleteASID_corres:
       apply (rule_tac P="\<lambda>s. asid_high_bits_of asid \<in> dom (asidTable o ucast) \<longrightarrow>
                              asid_pool_at (the ((asidTable o ucast) (asid_high_bits_of asid))) s" and
                       P'="pspace_aligned' and pspace_distinct'" and
-                      Q="invs and K (asid \<le> mask asid_bits \<and> asid \<noteq> 0) and
+                      Q="invs and valid_etcbs and K (asid \<le> mask asid_bits \<and> asid \<noteq> 0) and
                          (\<lambda>s. arm_asid_table (arch_state s) = asidTable \<circ> ucast)" in
                       corres_split)
          apply (simp add: dom_def)
@@ -842,7 +855,8 @@ lemma deleteASID_corres:
         apply (rule corres_when, simp add: mask_asid_low_bits_ucast_ucast)
         apply (rule corres_split[OF flushSpace_corres[where pd=pd]])
           apply (rule corres_split[OF invalidateASIDEntry_corres[where pd=pd]])
-            apply (rule_tac P="asid_pool_at (the (asidTable (ucast (asid_high_bits_of asid))))"
+            apply (rule_tac P="asid_pool_at (the (asidTable (ucast (asid_high_bits_of asid))))
+                               and valid_etcbs"
                         and P'="pspace_aligned' and pspace_distinct'"
                          in corres_split)
                apply (simp del: fun_upd_apply)
@@ -898,8 +912,10 @@ lemma valid_arch_state_unmap_strg':
   apply (auto simp: ran_def split: if_split_asm)
   done
 
-crunch invalidateASIDEntry, flushSpace
- for armKSASIDTable_inv[wp]: "\<lambda>s. P (armKSASIDTable (ksArchState s))"
+crunch invalidateASIDEntry
+  for armKSASIDTable_inv[wp]: "\<lambda>s. P (armKSASIDTable (ksArchState s))"
+crunch flushSpace
+  for armKSASIDTable_inv[wp]: "\<lambda>s. P (armKSASIDTable (ksArchState s))"
 
 lemma deleteASIDPool_corres:
   "corres dc
@@ -980,7 +996,7 @@ lemma deleteASIDPool_corres:
                                   mask_eq_iff_w2p asid_low_bits_def word_size)
                 apply (rule_tac f="\<lambda>a. a && mask n" for n in arg_cong)
                 apply (rule shiftr_eq_mask_eq)
-                apply (simp add: is_aligned_add_helper)
+                apply (simp add: is_aligned_add_helper is_aligned_neg_mask_eq)
                apply clarsimp
                apply (subgoal_tac "base \<le> base + xa")
                 apply (simp add: valid_vs_lookup_def asid_high_bits_of_def)
@@ -1086,23 +1102,23 @@ proof -
     done
 qed
 
-crunch armv_contextSwitch, setVMRoot, setVMRootForFlush
-  for typ_at' [wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: hoare_drop_imps simp: crunch_simps)
+crunch armv_contextSwitch
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (simp: crunch_simps)
 
-end
+crunch setVMRoot
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (simp: crunch_simps)
 
-sublocale Arch < setVMRoot: typ_at_all_props' "setVMRoot tcb"
-  by typ_at_props'
+lemmas setVMRoot_typ_ats [wp] = typ_at_lifts [OF setVMRoot_typ_at']
 
-sublocale Arch < loadHWASID: typ_at_all_props' "loadHWASID asid"
-  by typ_at_props'
+lemmas loadHWASID_typ_ats [wp] = typ_at_lifts [OF loadHWASID_inv]
 
-sublocale Arch < setVMRootForFlush: typ_at_all_props' "setVMRootForFlush pd asid"
-  by typ_at_props'
+crunch setVMRootForFlush
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: hoare_drop_imps)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas setVMRootForFlush_typ_ats' [wp] = typ_at_lifts [OF setVMRootForFlush_typ_at']
 
 crunch setVMRootForFlush
   for aligned'[wp]: pspace_aligned'
@@ -1317,29 +1333,22 @@ lemma flushPage_corres:
               | clarsimp simp: cur_tcb_def [symmetric] cur_tcb'_def [symmetric])+
   done
 
-crunch flushTable, flushPage
-  for typ_at' [wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
+crunch flushTable
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
   (wp: crunch_wps)
 
-end
-
-sublocale Arch < flushTable: typ_at_all_props' "flushTable pd asid vptr"
-  by typ_at_props'
-
-sublocale Arch < flushPage: typ_at_all_props' "flushPage arg1 pd asid vptr"
-  by typ_at_props'
-
-sublocale Arch < findPDForASID: typ_at_all_props' "findPDForASID asid"
-  by typ_at_props'
+lemmas flushTable_typ_ats' [wp] = typ_at_lifts [OF flushTable_typ_at']
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas findPDForASID_typ_ats' [wp] = typ_at_lifts [OF findPDForASID_inv]
 
 crunch unmapPageTable
   for aligned'[wp]: "pspace_aligned'"
-  and distinct'[wp]: "pspace_distinct'"
   (simp: crunch_simps
-   wp: crunch_wps getObject_inv)
+   wp: crunch_wps getObject_inv loadObject_default_inv)
+crunch unmapPageTable
+  for distinct'[wp]: "pspace_distinct'"
+  (simp: crunch_simps
+   wp: crunch_wps getObject_inv loadObject_default_inv)
 
 lemma pageTableMapped_corres:
   "corres (=) (valid_arch_state and valid_vspace_objs and pspace_aligned
@@ -1362,11 +1371,17 @@ lemma pageTableMapped_corres:
   done
 
 crunch pageTableMapped
- for inv[wp]: "P"
+  for inv[wp]: "P"
+  (wp: loadObject_default_inv)
+
+crunch storePDE, storePTE
+  for no_0_obj'[wp]: no_0_obj'
+  and valid_arch'[wp]: valid_arch_state'
+  and cur_tcb'[wp]: cur_tcb'
 
 lemma unmapPageTable_corres:
   "corres dc
-          (invs and page_table_at pt and
+          (invs and valid_etcbs and page_table_at pt and
            K (0 < asid \<and> is_aligned vptr 20 \<and> asid \<le> mask asid_bits))
           (valid_arch_state' and pspace_aligned' and pspace_distinct'
             and no_0_obj' and cur_tcb' and valid_objs')
@@ -1399,15 +1414,25 @@ lemma unmapPageTable_corres:
   done
 
 crunch flushPage
- for valid_objs'[wp]: "valid_objs'"
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps hoare_drop_imps)
+
+lemmas flushPage_typ_ats' [wp] = typ_at_lifts [OF flushPage_typ_at']
+
+crunch flushPage
+  for valid_objs'[wp]: "valid_objs'"
   (wp: crunch_wps hoare_drop_imps simp: crunch_simps)
 
 crunch lookupPTSlot
- for inv: "P"
+  for inv: "P"
+  (wp: loadObject_default_inv)
 
 crunch unmapPage
-  for aligned' [wp]: pspace_aligned'
-  and distinct' [wp]: pspace_distinct'
+  for aligned'[wp]: pspace_aligned'
+  (wp: crunch_wps simp: crunch_simps)
+
+crunch unmapPage
+  for distinct'[wp]: pspace_distinct'
   (wp: crunch_wps simp: crunch_simps)
 
 lemma corres_split_strengthen_ftE:
@@ -1459,8 +1484,8 @@ lemma checkMappingPPtr_corres:
   done
 
 crunch checkMappingPPtr
- for inv[wp]: "P"
-  (wp: crunch_wps simp: crunch_simps)
+  for inv[wp]: "P"
+  (wp: crunch_wps loadObject_default_inv simp: crunch_simps)
 
 lemma store_pte_pd_at_asid[wp]:
   "\<lbrace>vspace_at_asid asid pd\<rbrace>
@@ -1471,7 +1496,7 @@ lemma store_pte_pd_at_asid[wp]:
   done
 
 lemma unmapPage_corres:
-  "corres dc (invs and
+  "corres dc (invs and valid_etcbs and
               K (valid_unmap sz (asid,vptr) \<and> vptr < kernel_base \<and> asid \<le> mask asid_bits))
              (valid_objs' and valid_arch_state' and pspace_aligned' and
               pspace_distinct' and no_0_obj' and cur_tcb')
@@ -1491,7 +1516,7 @@ lemma unmapPage_corres:
                               and (\<exists>\<rhd> (lookup_pd_slot pd vptr && ~~ mask pd_bits))
                               and valid_arch_state and valid_vspace_objs
                               and equal_kernel_mappings
-                              and pspace_aligned and valid_global_objs and
+                              and pspace_aligned and valid_global_objs and valid_etcbs and
                               K (valid_unmap sz (asid,vptr) )" and
                            P'="pspace_aligned' and pspace_distinct'" in corres_inst)
            apply clarsimp
@@ -1523,13 +1548,14 @@ lemma unmapPage_corres:
                  apply (simp add: is_aligned_mask[symmetric])
                  apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres])
                    apply (simp add: largePagePTEOffsets_def pteBits_def)
-                   apply (rule corres_split[OF corres_mapM])
+                   apply (rule corres_split)
+                      apply (rule corres_mapM)
                             prefer 7
                             apply (rule order_refl)
                            apply simp
                           apply simp
                          apply clarsimp
-                         apply (rule_tac P="(\<lambda>s. \<forall>x\<in>set [0, 4 .e. 0x3C]. pte_at (x + pa) s) and pspace_aligned"
+                         apply (rule_tac P="(\<lambda>s. \<forall>x\<in>set [0, 4 .e. 0x3C]. pte_at (x + pa) s) and pspace_aligned and valid_etcbs"
                                      and P'="pspace_aligned' and pspace_distinct'"
                                       in corres_guard_imp)
                            apply (rule storePTE_corres',  simp add:pte_relation_aligned_def)
@@ -1572,7 +1598,7 @@ lemma unmapPage_corres:
                              in corres_gen_asm)
                apply (simp add: is_aligned_mask[symmetric])
                apply (rule corres_split)
-                  apply (rule_tac P="page_directory_at pd and pspace_aligned
+                  apply (rule_tac P="page_directory_at pd and pspace_aligned and valid_etcbs
                                         and K (valid_unmap sz (asid, vptr))"
                               in corres_mapM [where r=dc], simp, simp)
                       prefer 5
@@ -1849,7 +1875,7 @@ crunch unmapPage
 
 lemma corres_store_pde_with_invalid_tail:
   "\<forall>slot \<in>set ys. \<not> is_aligned (slot >> 2) (pde_align' ab)
-  \<Longrightarrow>corres dc ((\<lambda>s. \<forall>y\<in> set ys. pde_at y s) and pspace_aligned)
+  \<Longrightarrow>corres dc ((\<lambda>s. \<forall>y\<in> set ys. pde_at y s) and pspace_aligned and valid_etcbs)
            (pspace_aligned' and pspace_distinct')
            (mapM (swp store_pde ARM_A.pde.InvalidPDE) ys)
            (mapM (swp storePDE ab) ys)"
@@ -1872,7 +1898,7 @@ lemma corres_store_pde_with_invalid_tail:
 
 lemma corres_store_pte_with_invalid_tail:
   "\<forall>slot\<in> set ys. \<not> is_aligned (slot >> 2) (pte_align' aa)
-  \<Longrightarrow> corres dc ((\<lambda>s. \<forall>y\<in>set ys. pte_at y s) and pspace_aligned)
+  \<Longrightarrow> corres dc ((\<lambda>s. \<forall>y\<in>set ys. pte_at y s) and pspace_aligned and valid_etcbs)
                 (pspace_aligned' and pspace_distinct')
              (mapM (swp store_pte ARM_A.pte.InvalidPTE) ys)
              (mapM (swp storePTE aa) ys)"
@@ -1931,7 +1957,8 @@ lemma pdeCheckIfMapped_corres:
   done
 
 crunch do_machine_op, store_pte
-  for valid_asid_map[wp]: "valid_asid_map"
+  for unique_table_refs[wp]: "\<lambda>s. (unique_table_refs (caps_of_state s))"
+  and valid_asid_map[wp]: "valid_asid_map"
 
 lemma set_cap_pd_at_asid [wp]:
   "\<lbrace>vspace_at_asid asid pd\<rbrace> set_cap t st \<lbrace>\<lambda>rv. vspace_at_asid asid pd\<rbrace>"
@@ -2045,17 +2072,12 @@ lemma set_mi_tcb' [wp]:
   "\<lbrace> tcb_at' t \<rbrace> setMessageInfo receiver msg \<lbrace>\<lambda>rv. tcb_at' t\<rbrace>"
   by (simp add: setMessageInfo_def) wp
 
-end
-
-crunch setMRs
-  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (simp: crunch_simps wp: crunch_wps)
 
-global_interpretation setMRs: typ_at_all_props' "setMRs thread buffer data"
-  by typ_at_props'
+lemma setMRs_typ_at':
+  "\<lbrace>\<lambda>s. P (typ_at' T p s)\<rbrace> setMRs receiver recv_buf mrs \<lbrace>\<lambda>rv s. P (typ_at' T p s)\<rbrace>"
+  by (simp add: setMRs_def zipWithM_x_mapM split_def, wp crunch_wps)
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemmas setMRs_typ_at_lifts[wp] = typ_at_lifts [OF setMRs_typ_at']
 
 lemma set_mrs_invs'[wp]:
   "\<lbrace> invs' and tcb_at' receiver \<rbrace> setMRs receiver recv_buf mrs \<lbrace>\<lambda>rv. invs' \<rbrace>"
@@ -2076,7 +2098,7 @@ lemma same_refs_vs_cap_ref_eq:
 
 lemma performPageInvocation_corres:
   assumes "page_invocation_map pgi pgi'"
-  shows "corres (=) (invs and valid_page_inv pgi)
+  shows "corres (=) (invs and valid_etcbs and valid_page_inv pgi)
             (invs' and valid_page_inv' pgi' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)))
             (perform_page_invocation pgi) (performPageInvocation pgi')"
 proof -
@@ -2085,7 +2107,6 @@ proof -
        (\<forall>c. caps_of_state s p = Some c \<longrightarrow> P s \<and> Q s c)"
    by blast
   show ?thesis
-  apply add_cur_tcb'
   using assms
   apply (cases pgi)
      apply (rename_tac word cap prod sum)
@@ -2094,7 +2115,7 @@ proof -
                            page_invocation_map_def)
      apply (rule corres_guard_imp)
        apply (rule_tac R="\<lambda>_. invs and (valid_page_map_inv word cap (a,b) sum)
-                              and (\<lambda>s. caps_of_state s (a,b) = Some cap)"
+                              and valid_etcbs and (\<lambda>s. caps_of_state s (a,b) = Some cap)"
          and R'="\<lambda>_. invs' and valid_slots' m' and pspace_aligned' and valid_slots_duplicated' m'
          and pspace_distinct' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s))" in corres_split)
           apply (erule updateCap_same_master)
@@ -2320,7 +2341,7 @@ definition
                                  and K (isPageTableCap cap)"
 
 lemma clear_page_table_corres:
-  "corres dc (pspace_aligned and page_table_at p)
+  "corres dc (pspace_aligned and page_table_at p and valid_etcbs)
              (pspace_aligned' and pspace_distinct')
     (mapM_x (swp store_pte ARM_A.InvalidPTE)
        [p , p + 4 .e. p + 2 ^ ptBits - 1])
@@ -2338,7 +2359,7 @@ lemma clear_page_table_corres:
                    mapM_x_mapM liftM_def[symmetric])
   apply (rule corres_guard_imp,
          rule_tac r'=dc and S="(=)"
-               and Q="\<lambda>xs s. \<forall>x \<in> set xs. pte_at x s \<and> pspace_aligned s"
+               and Q="\<lambda>xs s. \<forall>x \<in> set xs. pte_at x s \<and> pspace_aligned s \<and> valid_etcbs s"
                and Q'="\<lambda>xs. pspace_aligned' and pspace_distinct'"
                 in corres_mapM_list_all2, simp_all)
       apply (rule corres_guard_imp, rule storePTE_corres')
@@ -2353,25 +2374,17 @@ lemma clear_page_table_corres:
   done
 
 crunch unmapPageTable
-  for typ_at' [wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-
-end
-
-sublocale Arch < unmapPageTable: typ_at_all_props' "unmapPageTable asid vaddr pt"
-  by typ_at_props'
-
-context begin interpretation Arch . (*FIXME: arch_split*)
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+lemmas unmapPageTable_typ_ats[wp] = typ_at_lifts[OF unmapPageTable_typ_at']
 
 lemma performPageTableInvocation_corres:
   "page_table_invocation_map pti pti' \<Longrightarrow>
    corres dc
-          (invs and valid_pti pti)
+          (invs and valid_etcbs and valid_pti pti)
           (invs' and valid_pti' pti')
           (perform_page_table_invocation pti)
           (performPageTableInvocation pti')"
   (is "?mp \<Longrightarrow> corres dc ?P ?P' ?f ?g")
-  apply add_cur_tcb'
   apply (simp add: perform_page_table_invocation_def performPageTableInvocation_def)
   apply (cases pti)
    apply (clarsimp simp: page_table_invocation_map_def)
@@ -2447,7 +2460,7 @@ definition
 lemma performASIDPoolInvocation_corres:
   "ap' = asid_pool_invocation_map ap \<Longrightarrow>
   corres dc
-          (valid_objs and pspace_aligned and pspace_distinct and valid_apinv ap)
+          (valid_objs and pspace_aligned and pspace_distinct and valid_apinv ap and valid_etcbs)
           (pspace_aligned' and pspace_distinct' and valid_apinv' ap')
           (perform_asid_pool_invocation ap)
           (performASIDPoolInvocation ap')"
@@ -2459,7 +2472,7 @@ lemma performASIDPoolInvocation_corres:
        apply simp
       apply (rule_tac F="\<exists>p asid. rv = Structures_A.ArchObjectCap (ARM_A.PageDirectoryCap p asid)" in corres_gen_asm)
       apply clarsimp
-      apply (rule_tac Q="valid_objs and pspace_aligned and pspace_distinct and asid_pool_at word2 and
+      apply (rule_tac Q="valid_objs and pspace_aligned and pspace_distinct and asid_pool_at word2 and valid_etcbs and
                          cte_wp_at (\<lambda>c. cap_master_cap c =
                                         cap_master_cap (cap.ArchObjectCap (arch_cap.PageDirectoryCap p asid))) (a,b)"
                       in corres_split)
@@ -2508,7 +2521,23 @@ lemma storeHWASID_invs:
    apply fastforce
   apply (simp add: storeHWASID_def)
   apply (wp findPDForASIDAssert_pd_at_wp)
-  apply (clarsimp simp: invs'_def valid_arch_state'_def valid_dom_schedule'_def
+  apply (clarsimp simp: invs'_def valid_state'_def valid_arch_state'_def
+             valid_global_refs'_def global_refs'_def valid_machine_state'_def
+             ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
+  done
+
+lemma storeHWASID_invs_no_cicd':
+  "\<lbrace>invs_no_cicd' and
+   (\<lambda>s. armKSASIDMap (ksArchState s) asid = None \<and>
+        armKSHWASIDTable (ksArchState s) hw_asid = None)\<rbrace>
+  storeHWASID asid hw_asid
+  \<lbrace>\<lambda>x. invs_no_cicd'\<rbrace>"
+  apply (rule hoare_add_post)
+    apply (rule storeHWASID_valid_arch')
+   apply (fastforce simp: all_invs_but_ct_idle_or_in_cur_domain'_def)
+  apply (simp add: storeHWASID_def)
+  apply (wp findPDForASIDAssert_pd_at_wp)
+  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def valid_arch_state'_def
              valid_global_refs'_def global_refs'_def valid_machine_state'_def
              ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def)
   done
@@ -2522,9 +2551,9 @@ lemma findFreeHWASID_invs:
                    doMachineOp_def split_def
               cong: option.case_cong)
   apply (wp findPDForASIDAssert_pd_at_wp | wpc)+
-  apply (clarsimp simp: invs'_def valid_arch_state'_def
+  apply (clarsimp simp: invs'_def valid_state'_def valid_arch_state'_def
              valid_global_refs'_def global_refs'_def valid_machine_state'_def
-             ct_not_inQ_def valid_dom_schedule'_def
+             ct_not_inQ_def
            split del: if_split)
   apply (intro conjI)
    apply (fastforce dest: no_irq_use [OF no_irq_invalidateLocalTLB_ASID])
@@ -2536,6 +2565,29 @@ lemma findFreeHWASID_invs:
   apply clarsimp
   done
 
+lemma findFreeHWASID_invs_no_cicd':
+  "\<lbrace>invs_no_cicd'\<rbrace> findFreeHWASID \<lbrace>\<lambda>asid. invs_no_cicd'\<rbrace>"
+  apply (rule hoare_add_post)
+    apply (rule findFreeHWASID_valid_arch)
+   apply (fastforce simp: all_invs_but_ct_idle_or_in_cur_domain'_def)
+  apply (simp add: findFreeHWASID_def invalidateHWASIDEntry_def invalidateASID_def
+                   doMachineOp_def split_def
+              cong: option.case_cong)
+  apply (wp findPDForASIDAssert_pd_at_wp | wpc)+
+  apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def valid_arch_state'_def
+             valid_global_refs'_def global_refs'_def valid_machine_state'_def
+             ct_not_inQ_def
+           split del: if_split)
+  apply (intro conjI)
+    apply (fastforce dest: no_irq_use [OF no_irq_invalidateLocalTLB_ASID])
+   apply clarsimp
+   apply (drule_tac x=p in spec)
+   apply (drule use_valid)
+    apply (rule_tac p=p in invalidateLocalTLB_ASID_underlying_memory)
+    apply blast
+   apply clarsimp
+  done
+
 lemma getHWASID_invs [wp]:
   "\<lbrace>invs'\<rbrace> getHWASID asid \<lbrace>\<lambda>hw_asid. invs'\<rbrace>"
   apply (simp add: getHWASID_def)
@@ -2543,6 +2595,13 @@ lemma getHWASID_invs [wp]:
   apply simp
   done
 
+lemma getHWASID_invs_no_cicd':
+  "\<lbrace>invs_no_cicd'\<rbrace> getHWASID asid \<lbrace>\<lambda>hw_asid. invs_no_cicd'\<rbrace>"
+  apply (simp add: getHWASID_def)
+  apply (wp storeHWASID_invs_no_cicd' findFreeHWASID_invs_no_cicd'|wpc)+
+  apply simp
+  done
+
 lemmas armv_ctxt_sw_defs = armv_contextSwitch_HWASID_def setHardwareASID_def setCurrentPD_def
                            writeTTBR0_def writeTTBR0Ptr_def set_current_pd_def isb_def dsb_def
 
@@ -2562,9 +2621,21 @@ lemma armv_contextSwitch_invs [wp]:
   apply (drule_tac Q="\<lambda>_ m'. underlying_memory m' p = underlying_memory m p"
          in use_valid)
     apply (simp add: machine_op_lift_def machine_rest_lift_def split_def armv_ctxt_sw_defs
+                     writeTTBR0Ptr_def
               | wp)+
   done
 
+lemma armv_contextSwitch_invs_no_cicd':
+  "\<lbrace>invs_no_cicd'\<rbrace> armv_contextSwitch pd asid \<lbrace>\<lambda>rv. invs_no_cicd'\<rbrace>"
+  apply (simp add: armv_contextSwitch_def armv_contextSwitch_HWASID_def setCurrentPD_to_abs)
+  apply (wp dmo_invs_no_cicd' no_irq_setHardwareASID no_irq_set_current_pd no_irq)
+  apply (rule hoare_post_imp[rotated], rule getHWASID_invs_no_cicd')
+  apply clarsimp
+  apply (drule_tac Q="\<lambda>_ m'. underlying_memory m' p = underlying_memory m p"
+         in use_valid)
+    apply (clarsimp simp: machine_op_lift_def machine_rest_lift_def split_def armv_ctxt_sw_defs | wp)+
+  done
+
 lemma dmo_setCurrentPD_invs'[wp]:
   "\<lbrace>invs'\<rbrace> doMachineOp (setCurrentPD addr) \<lbrace>\<lambda>rv. invs'\<rbrace>"
   apply (wpsimp wp: dmo_invs' no_irq_set_current_pd no_irq simp: setCurrentPD_to_abs)
@@ -2574,25 +2645,50 @@ lemma dmo_setCurrentPD_invs'[wp]:
                           machine_rest_lift_def split_def | wp)+
   done
 
+lemma dmo_setCurrentPD_invs_no_cicd':
+  "\<lbrace>invs_no_cicd'\<rbrace> doMachineOp (setCurrentPD addr) \<lbrace>\<lambda>rv. invs_no_cicd'\<rbrace>"
+  apply (wpsimp wp: dmo_invs_no_cicd' no_irq_set_current_pd no_irq  simp: setCurrentPD_to_abs)
+  apply (drule_tac Q="\<lambda>_ m'. underlying_memory m' p = underlying_memory m p"
+         in use_valid)
+  apply (clarsimp simp: set_current_pd_def machine_op_lift_def writeTTBR0_def dsb_def isb_def
+                        machine_rest_lift_def split_def | wp)+
+  done
+
 crunch setVMRoot
- for invs[wp]: "invs'"
+  for invs[wp]: "invs'"
   (wp: crunch_wps simp: crunch_simps ignore: doMachineOp)
 
 crunch setVMRoot
- for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  for invs_no_cicd': "invs_no_cicd'"
+  (wp: crunch_wps dmo_setCurrentPD_invs_no_cicd' simp: crunch_simps ignore: doMachineOp)
+
+crunch setVMRoot
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
   (wp: crunch_wps getObject_inv simp: crunch_simps
        loadObject_default_def)
 
+crunch findPDForASID
+  for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (simp: crunch_simps loadObject_default_def wp: getObject_inv)
+
 crunch deleteASIDPool
- for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
+  for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
   (simp: crunch_simps loadObject_default_def wp: getObject_inv mapM_wp')
 
 crunch lookupPTSlot
   for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
   (simp: crunch_simps loadObject_default_def wp: getObject_inv)
 
+crunch storePTE
+  for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (simp: crunch_simps updateObject_default_def wp: setObject_idle')
+
+crunch storePDE
+  for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
+  (simp: crunch_simps updateObject_default_def wp: setObject_idle')
+
 crunch flushTable
- for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
+  for it'[wp]: "\<lambda>s. P (ksIdleThread s)"
   (simp: crunch_simps loadObject_default_def
    wp: setObject_idle' hoare_drop_imps mapM_wp')
 
@@ -2609,30 +2705,54 @@ lemma valid_slots_lift':
    apply (rule hoare_pre, wp hoare_vcg_const_Ball_lift t valid_pde_lift' valid_pte_lift', simp)+
   done
 
-crunch performPageTableInvocation, performPageDirectoryInvocation,
-         performPageInvocation, performASIDPoolInvocation
-  for typ_at' [wp]: "\<lambda>s. P (typ_at' T p s)"
-  and sc_at'_n[wp]: "\<lambda>s. P (sc_at'_n n p s)"
-  (wp: crunch_wps getASID_wp)
+crunch performPageTableInvocation
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps)
 
-end
+crunch performPageDirectoryInvocation
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps)
+
+crunch performPageInvocation
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: crunch_wps)
 
-sublocale Arch < performPageTableInvocation: typ_at_all_props' "performPageTableInvocation i"
-  by typ_at_props'
+crunch performASIDPoolInvocation
+  for typ_at'[wp]: "\<lambda>s. P (typ_at' T p s)"
+  (wp: getObject_cte_inv getASID_wp)
 
-sublocale Arch < performPageDirectoryInvocation: typ_at_all_props' "performPageDirectoryInvocation i"
-  by typ_at_props'
+lemmas performPageTableInvocation_typ_ats' [wp] =
+  typ_at_lifts [OF performPageTableInvocation_typ_at']
 
-sublocale Arch < performPageInvocation: typ_at_all_props' "performPageInvocation i"
-  by typ_at_props'
+lemmas performPageDirectoryInvocation_typ_ats' [wp] =
+  typ_at_lifts [OF performPageDirectoryInvocation_typ_at']
 
-sublocale Arch < performASIDPoolInvocation: typ_at_all_props' "performASIDPoolInvocation i"
-  by typ_at_props'
+lemmas performPageInvocation_typ_ats' [wp] =
+  typ_at_lifts [OF performPageInvocation_typ_at']
 
-sublocale Arch < unmapPage: typ_at_all_props' "unmapPage magnitude asid vptr ptr"
-  by typ_at_props'
+lemmas performASIDPoolInvocation_typ_ats' [wp] =
+  typ_at_lifts [OF performASIDPoolInvocation_typ_at']
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+lemma storePDE_pred_tcb_at' [wp]:
+  "\<lbrace>pred_tcb_at' proj P t\<rbrace> storePDE p pde \<lbrace>\<lambda>_. pred_tcb_at' proj P t\<rbrace>"
+  apply (simp add: storePDE_def pred_tcb_at'_def)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_default_def in_monad)
+  done
+
+lemma storePTE_pred_tcb_at' [wp]:
+  "\<lbrace>pred_tcb_at' proj P t\<rbrace> storePTE p pte \<lbrace>\<lambda>_. pred_tcb_at' proj P t\<rbrace>"
+  apply (simp add: storePTE_def pred_tcb_at'_def)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_default_def in_monad)
+  done
+
+lemma setASID_pred_tcb_at' [wp]:
+  "\<lbrace>pred_tcb_at' proj P t\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. pred_tcb_at' proj P t\<rbrace>"
+  apply (simp add: pred_tcb_at'_def)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_default_def in_monad)
+  done
 
 lemma dmo_ct[wp]:
   "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> doMachineOp m \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
@@ -2641,6 +2761,33 @@ lemma dmo_ct[wp]:
   apply clarsimp
   done
 
+lemma storePDE_valid_mdb [wp]:
+  "\<lbrace>valid_mdb'\<rbrace> storePDE p pde \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
+  by (simp add: valid_mdb'_def) wp
+
+crunch storePDE
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  (simp: updateObject_default_def ignore_del: setObject)
+
+crunch storePDE
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  (simp: updateObject_default_def)
+
+lemma storePDE_inQ[wp]:
+  "\<lbrace>\<lambda>s. P (obj_at' (inQ d p) t s)\<rbrace> storePDE ptr pde \<lbrace>\<lambda>rv s. P (obj_at' (inQ d p) t s)\<rbrace>"
+  apply (simp add: obj_at'_real_def storePDE_def)
+  apply (wp setObject_ko_wp_at | simp add: objBits_simps archObjSize_def pdeBits_def)+
+  apply (clarsimp simp: projectKOs obj_at'_def ko_wp_at'_def)
+  done
+
+crunch storePDE
+  for norqL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  (simp: updateObject_default_def)
+
+crunch storePDE
+  for norqL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  (simp: updateObject_default_def)
+
 lemma storePDE_state_refs' [wp]:
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace> storePDE p pde \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (clarsimp simp: storePDE_def)
@@ -2661,6 +2808,46 @@ lemma storePDE_iflive [wp]:
      apply (auto simp: updateObject_default_def in_monad projectKOs pdeBits_def)
   done
 
+lemma setObject_pde_ksInt [wp]:
+  "\<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> setObject p (pde::pde) \<lbrace>\<lambda>_. \<lambda>s. P (ksInterruptState s)\<rbrace>"
+  by (wp setObject_ksInterrupt updateObject_default_inv|simp)+
+
+crunch storePDE
+  for ksInterruptState[wp]: "\<lambda>s. P (ksInterruptState s)"
+
+lemma storePDE_ifunsafe [wp]:
+  "\<lbrace>if_unsafe_then_cap'\<rbrace> storePDE p pde \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
+  apply (simp add: storePDE_def)
+  apply (rule hoare_pre)
+   apply (rule setObject_ifunsafe' [where P=\<top>], simp)
+     apply (auto simp: updateObject_default_def in_monad projectKOs)[2]
+   apply wp
+  apply simp
+  done
+
+method valid_idle'_setObject uses simp =
+  simp add: valid_idle'_def, rule hoare_lift_Pf [where f="ksIdleThread"]; wpsimp?;
+  (wpsimp wp: obj_at_setObject2[where P="idle_tcb'", simplified] hoare_drop_imp
+        simp: simp
+   | clarsimp dest!: updateObject_default_result)+
+
+lemma storePDE_idle [wp]:
+  "\<lbrace>valid_idle'\<rbrace> storePDE p pde \<lbrace>\<lambda>rv. valid_idle'\<rbrace>" by (valid_idle'_setObject simp: storePDE_def)
+
+crunch storePDE
+  for arch'[wp]: "\<lambda>s. P (ksArchState s)"
+  and cur'[wp]: "\<lambda>s. P (ksCurThread s)"
+
+lemma storePDE_irq_states' [wp]:
+  "\<lbrace>valid_irq_states'\<rbrace> storePDE pde p \<lbrace>\<lambda>_. valid_irq_states'\<rbrace>"
+  apply (simp add: storePDE_def)
+  apply (wpsimp wp: valid_irq_states_lift' dmo_lift' no_irq_storeWord setObject_ksMachine
+                    updateObject_default_inv)
+  done
+
+crunch storePDE
+  for no_0_obj'[wp]: no_0_obj'
+
 lemma storePDE_pde_mappings'[wp]:
   "\<lbrace>valid_pde_mappings' and K (valid_pde_mapping' (p && mask pdBits) pde)\<rbrace>
       storePDE p pde
@@ -2673,16 +2860,97 @@ lemma storePDE_pde_mappings'[wp]:
    apply (wp setObject_ko_wp_at)
       apply simp
      apply (simp add: objBits_simps archObjSize_def)
+    apply (simp add: pdeBits_def)
    apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
   apply assumption
   done
 
+lemma storePDE_vms'[wp]:
+  "\<lbrace>valid_machine_state'\<rbrace> storePDE p pde \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
+  apply (simp add: storePDE_def valid_machine_state'_def pointerInUserData_def
+                   pointerInDeviceData_def)
+  apply (wp setObject_typ_at_inv setObject_ksMachine updateObject_default_inv
+            hoare_vcg_all_lift hoare_vcg_disj_lift | simp)+
+  done
+
+crunch storePDE
+  for pspace_domain_valid[wp]: "pspace_domain_valid"
+
+lemma storePDE_ct_not_inQ[wp]:
+  "\<lbrace>ct_not_inQ\<rbrace> storePDE p pde \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+  apply (rule ct_not_inQ_lift [OF storePDE_nosch])
+  apply (simp add: storePDE_def)
+  apply (rule hoare_weaken_pre)
+   apply (wps setObject_PDE_ct)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp: updateObject_default_def in_monad)+
+  done
+
+lemma setObject_pde_cur_domain[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> setObject t (v::pde) \<lbrace>\<lambda>rv s. P (ksCurDomain s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_pde_ksDomSchedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> setObject t (v::pde) \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma storePDE_cur_domain[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> storePDE p pde \<lbrace>\<lambda>rv s. P (ksCurDomain s)\<rbrace>"
+by (simp add: storePDE_def) wp
+
+lemma storePDE_ksDomSchedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> storePDE p pde \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
+by (simp add: storePDE_def) wp
+
+lemma storePDE_tcb_obj_at'[wp]:
+  "\<lbrace>obj_at' (P::tcb \<Rightarrow> bool) t\<rbrace> storePDE p pde \<lbrace>\<lambda>_. obj_at' P t\<rbrace>"
+  apply (simp add: storePDE_def)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_default_def in_monad)
+  done
+
+lemma storePDE_tcb_in_cur_domain'[wp]:
+  "\<lbrace>tcb_in_cur_domain' t\<rbrace> storePDE p pde \<lbrace>\<lambda>_. tcb_in_cur_domain' t\<rbrace>"
+  by (wp tcb_in_cur_domain'_lift)
+
+lemma storePDE_ct_idle_or_in_cur_domain'[wp]:
+  "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> storePDE p pde \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
+  by (wp ct_idle_or_in_cur_domain'_lift hoare_vcg_disj_lift)
+
+lemma setObject_pte_ksDomScheduleIdx [wp]:
+  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setObject p (pte::pte) \<lbrace>\<lambda>_. \<lambda>s. P (ksDomScheduleIdx s)\<rbrace>"
+  by (wp updateObject_default_inv|simp add:setObject_def | wpc)+
+
+lemma setObject_pde_ksDomScheduleIdx [wp]:
+  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setObject p (pde::pde) \<lbrace>\<lambda>_. \<lambda>s. P (ksDomScheduleIdx s)\<rbrace>"
+  by (wp updateObject_default_inv|simp add:setObject_def | wpc)+
+
+crunch storePTE, storePDE
+  for ksDomScheduleIdx[wp]: "\<lambda>s. P (ksDomScheduleIdx s)"
+  and gsMaxObjectSize[wp]: "\<lambda>s. P (gsMaxObjectSize s)"
+  and gsUntypedZeroRanges[wp]: "\<lambda>s. P (gsUntypedZeroRanges s)"
+  (wp: setObject_ksPSpace_only updateObject_default_inv simp: o_def)
+
+lemma storePTE_tcbs_of'[wp]:
+  "storePTE c (pte::pte) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  unfolding storePTE_def
+  by setObject_easy_cases
+
+lemma storePDE_tcbs_of'[wp]:
+  "storePDE c (pde::pde) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  unfolding storePDE_def
+  by setObject_easy_cases
+
 lemma storePDE_invs[wp]:
   "\<lbrace>invs' and valid_pde' pde
           and (\<lambda>s. valid_pde_mapping' (p && mask pdBits) pde)\<rbrace>
       storePDE p pde
    \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
   apply (rule hoare_pre)
    apply (wp sch_act_wf_lift valid_global_refs_lift'
              irqs_masked_lift
@@ -2693,6 +2961,33 @@ lemma storePDE_invs[wp]:
   apply clarsimp
   done
 
+lemma storePTE_valid_mdb [wp]:
+  "\<lbrace>valid_mdb'\<rbrace> storePTE p pte \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
+  by (simp add: valid_mdb'_def) wp
+
+crunch storePTE
+  for nosch[wp]: "\<lambda>s. P (ksSchedulerAction s)"
+  (simp: updateObject_default_def ignore_del: setObject)
+
+crunch storePTE
+  for ksQ[wp]: "\<lambda>s. P (ksReadyQueues s)"
+  (simp: updateObject_default_def)
+
+lemma storePTE_inQ[wp]:
+  "\<lbrace>\<lambda>s. P (obj_at' (inQ d p) t s)\<rbrace> storePTE ptr pde \<lbrace>\<lambda>rv s. P (obj_at' (inQ d p) t s)\<rbrace>"
+  apply (simp add: obj_at'_real_def storePTE_def)
+  apply (wp setObject_ko_wp_at | simp add: objBits_simps archObjSize_def pteBits_def)+
+  apply (clarsimp simp: projectKOs obj_at'_def ko_wp_at'_def)
+  done
+
+crunch storePTE
+  for norqL1[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
+  (simp: updateObject_default_def)
+
+crunch storePTE
+  for norqL2[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
+  (simp: updateObject_default_def)
+
 lemma storePTE_state_refs' [wp]:
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace> storePTE p pte \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (clarsimp simp: storePTE_def)
@@ -2713,6 +3008,52 @@ lemma storePTE_iflive [wp]:
      apply (auto simp: updateObject_default_def in_monad projectKOs pteBits_def)
   done
 
+lemma setObject_pte_ksInt [wp]:
+  "\<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> setObject p (pte::pte) \<lbrace>\<lambda>_. \<lambda>s. P (ksInterruptState s)\<rbrace>"
+  by (wp setObject_ksInterrupt updateObject_default_inv|simp)+
+
+crunch storePTE
+  for ksInt'[wp]: "\<lambda>s. P (ksInterruptState s)"
+
+lemma storePTE_ifunsafe [wp]:
+  "\<lbrace>if_unsafe_then_cap'\<rbrace> storePTE p pte \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
+  apply (simp add: storePTE_def)
+  apply (rule hoare_pre)
+   apply (rule setObject_ifunsafe' [where P=\<top>], simp)
+     apply (auto simp: updateObject_default_def in_monad projectKOs)[2]
+   apply wp
+  apply simp
+  done
+
+lemma storePTE_idle [wp]:
+  "\<lbrace>valid_idle'\<rbrace> storePTE p pte \<lbrace>\<lambda>rv. valid_idle'\<rbrace>" by (valid_idle'_setObject simp: storePTE_def)
+
+crunch storePTE
+  for arch'[wp]: "\<lambda>s. P (ksArchState s)"
+  and cur'[wp]: "\<lambda>s. P (ksCurThread s)"
+
+lemma storePTE_irq_states' [wp]:
+  "\<lbrace>valid_irq_states'\<rbrace> storePTE pte p \<lbrace>\<lambda>_. valid_irq_states'\<rbrace>"
+  apply (simp add: storePTE_def)
+  apply (wpsimp wp: valid_irq_states_lift' dmo_lift' no_irq_storeWord setObject_ksMachine
+                    updateObject_default_inv)
+  done
+
+lemma storePTE_valid_objs [wp]:
+  "\<lbrace>valid_objs' and valid_pte' pte\<rbrace> storePTE p pte \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
+  apply (simp add: storePTE_def doMachineOp_def split_def)
+  apply (rule hoare_pre)
+   apply (wp hoare_drop_imps|wpc|simp)+
+   apply (rule setObject_valid_objs')
+   prefer 2
+   apply assumption
+  apply (clarsimp simp: updateObject_default_def in_monad)
+  apply (clarsimp simp: valid_obj'_def)
+  done
+
+crunch storePTE
+  for no_0_obj'[wp]: no_0_obj'
+
 lemma storePTE_pde_mappings'[wp]:
   "\<lbrace>valid_pde_mappings'\<rbrace> storePTE p pte \<lbrace>\<lambda>rv. valid_pde_mappings'\<rbrace>"
   apply (wp valid_pde_mappings_lift')
@@ -2722,9 +3063,66 @@ lemma storePTE_pde_mappings'[wp]:
   apply assumption
   done
 
+lemma storePTE_vms'[wp]:
+  "\<lbrace>valid_machine_state'\<rbrace> storePTE p pde \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
+  apply (simp add: storePTE_def valid_machine_state'_def pointerInUserData_def
+                   pointerInDeviceData_def)
+  apply (wp setObject_typ_at_inv setObject_ksMachine updateObject_default_inv
+            hoare_vcg_all_lift hoare_vcg_disj_lift | simp)+
+  done
+
+crunch storePTE
+  for pspace_domain_valid[wp]: "pspace_domain_valid"
+
+lemma storePTE_ct_not_inQ[wp]:
+  "\<lbrace>ct_not_inQ\<rbrace> storePTE p pte \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+  apply (rule ct_not_inQ_lift [OF storePTE_nosch])
+  apply (simp add: storePTE_def)
+  apply (rule hoare_weaken_pre)
+   apply (wps setObject_pte_ct)
+  apply (rule obj_at_setObject2)
+   apply (clarsimp simp: updateObject_default_def in_monad)+
+  done
+
+lemma setObject_pte_cur_domain[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> setObject t (v::pte) \<lbrace>\<lambda>rv s. P (ksCurDomain s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_pte_ksDomSchedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> setObject t (v::pte) \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma storePTE_cur_domain[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> storePTE p pde \<lbrace>\<lambda>rv s. P (ksCurDomain s)\<rbrace>"
+  by (simp add: storePTE_def) wp
+
+lemma storePTE_ksDomSchedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> storePTE p pde \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
+  by (simp add: storePTE_def) wp
+
+
+lemma storePTE_tcb_obj_at'[wp]:
+  "\<lbrace>obj_at' (P::tcb \<Rightarrow> bool) t\<rbrace> storePTE p pte \<lbrace>\<lambda>_. obj_at' P t\<rbrace>"
+  apply (simp add: storePTE_def)
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_default_def in_monad)
+  done
+
+lemma storePTE_tcb_in_cur_domain'[wp]:
+  "\<lbrace>tcb_in_cur_domain' t\<rbrace> storePTE p pte \<lbrace>\<lambda>_. tcb_in_cur_domain' t\<rbrace>"
+  by (wp tcb_in_cur_domain'_lift)
+
+lemma storePTE_ct_idle_or_in_cur_domain'[wp]:
+  "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> storePTE p pte \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
+  by (wp ct_idle_or_in_cur_domain'_lift hoare_vcg_disj_lift)
+
 lemma storePTE_invs [wp]:
   "\<lbrace>invs' and valid_pte' pte\<rbrace> storePTE p pte \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
   apply (rule hoare_pre)
    apply (wp sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
@@ -2744,6 +3142,37 @@ lemma setASIDPool_valid_objs [wp]:
   apply (clarsimp simp: valid_obj'_def)
   done
 
+lemma setASIDPool_valid_mdb [wp]:
+  "\<lbrace>valid_mdb'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
+  by (simp add: valid_mdb'_def) wp
+
+lemma setASIDPool_nosch [wp]:
+  "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
+  by (wp setObject_nosch updateObject_default_inv|simp)+
+
+lemma setASIDPool_ksQ [wp]:
+  "\<lbrace>\<lambda>s. P (ksReadyQueues s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv s. P (ksReadyQueues s)\<rbrace>"
+  by (wp setObject_qs updateObject_default_inv|simp)+
+
+lemma setASIDPool_inQ[wp]:
+  "\<lbrace>\<lambda>s. P (obj_at' (inQ d p) t s)\<rbrace>
+     setObject ptr (ap::asidpool)
+   \<lbrace>\<lambda>rv s. P (obj_at' (inQ d p) t s)\<rbrace>"
+  apply (simp add: obj_at'_real_def)
+  apply (wp setObject_ko_wp_at
+            | simp add: objBits_simps archObjSize_def)+
+   apply (simp add: pageBits_def)
+  apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
+  done
+
+lemma setASIDPool_qsL1 [wp]:
+  "\<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
+  by (wp setObject_qs updateObject_default_inv|simp)+
+
+lemma setASIDPool_qsL2 [wp]:
+  "\<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
+  by (wp setObject_qs updateObject_default_inv|simp)+
+
 lemma setASIDPool_state_refs' [wp]:
   "\<lbrace>\<lambda>s. P (state_refs_of' s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv s. P (state_refs_of' s)\<rbrace>"
   apply (clarsimp simp: setObject_def valid_def in_monad split_def
@@ -2762,14 +3191,107 @@ lemma setASIDPool_iflive [wp]:
      apply (auto simp: updateObject_default_def in_monad projectKOs pageBits_def)
   done
 
+lemma setASIDPool_ksInt [wp]:
+  "\<lbrace>\<lambda>s. P (ksInterruptState s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. \<lambda>s. P (ksInterruptState s)\<rbrace>"
+  by (wp setObject_ksInterrupt updateObject_default_inv|simp)+
+
+lemma setASIDPool_ifunsafe [wp]:
+  "\<lbrace>if_unsafe_then_cap'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv. if_unsafe_then_cap'\<rbrace>"
+  apply (rule hoare_pre)
+   apply (rule setObject_ifunsafe' [where P=\<top>], simp)
+     apply (auto simp: updateObject_default_def in_monad projectKOs)[2]
+   apply wp
+  apply simp
+  done
+
+lemma setASIDPool_it' [wp]:
+  "\<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. \<lambda>s. P (ksIdleThread s)\<rbrace>"
+  by (wp setObject_it updateObject_default_inv|simp)+
+
+lemma setASIDPool_idle [wp]:
+  "\<lbrace>valid_idle'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv. valid_idle'\<rbrace>" by valid_idle'_setObject
+
+lemma setASIDPool_irq_states' [wp]:
+  "\<lbrace>valid_irq_states'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. valid_irq_states'\<rbrace>"
+  apply (rule hoare_pre)
+   apply (rule hoare_use_eq [where f=ksInterruptState, OF setObject_ksInterrupt])
+    apply (simp, rule updateObject_default_inv)
+   apply (rule hoare_use_eq [where f=ksMachineState, OF setObject_ksMachine])
+    apply (simp, rule updateObject_default_inv)
+   apply wp
+  apply assumption
+  done
+
 lemma setObject_asidpool_mappings'[wp]:
   "\<lbrace>valid_pde_mappings'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv. valid_pde_mappings'\<rbrace>"
   apply (wp valid_pde_mappings_lift')
+   apply (rule obj_at_setObject2)
+   apply (clarsimp dest!: updateObject_default_result)
+  apply assumption
+  done
+
+lemma setASIDPool_vms'[wp]:
+  "\<lbrace>valid_machine_state'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. valid_machine_state'\<rbrace>"
+  apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def)
+  apply (wp setObject_typ_at_inv setObject_ksMachine updateObject_default_inv
+            hoare_vcg_all_lift hoare_vcg_disj_lift | simp)+
+  done
+
+lemma setASIDPool_ct_not_inQ[wp]:
+  "\<lbrace>ct_not_inQ\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. ct_not_inQ\<rbrace>"
+  apply (rule ct_not_inQ_lift [OF setObject_nosch])
+   apply (simp add: updateObject_default_def | wp)+
+  apply (rule hoare_weaken_pre)
+   apply (wps setObject_ASID_ct)
+  apply (rule obj_at_setObject2)
+   apply (clarsimp simp: updateObject_default_def in_monad)+
+  done
+
+lemma setObject_asidpool_cur'[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv s. P (ksCurThread s)\<rbrace>"
+  apply (simp add: setObject_def)
+  apply (wp | wpc | simp add: updateObject_default_def)+
+  done
+
+lemma setObject_asidpool_cur_domain[wp]:
+  "\<lbrace>\<lambda>s. P (ksCurDomain s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv s. P (ksCurDomain s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_asidpool_ksDomSchedule[wp]:
+  "\<lbrace>\<lambda>s. P (ksDomSchedule s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>rv s. P (ksDomSchedule s)\<rbrace>"
+  apply (simp add: setObject_def split_def)
+  apply (wp updateObject_default_inv | simp)+
+  done
+
+lemma setObject_tcb_obj_at'[wp]:
+  "\<lbrace>obj_at' (P::tcb \<Rightarrow> bool) t\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. obj_at' P t\<rbrace>"
+  apply (rule obj_at_setObject2)
+  apply (clarsimp simp add: updateObject_default_def in_monad)
+  done
+
+lemma setObject_asidpool_tcb_in_cur_domain'[wp]:
+  "\<lbrace>tcb_in_cur_domain' t\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. tcb_in_cur_domain' t\<rbrace>"
+  by (wp tcb_in_cur_domain'_lift)
+
+lemma setObject_asidpool_ct_idle_or_in_cur_domain'[wp]:
+  "\<lbrace>ct_idle_or_in_cur_domain'\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
+  apply (rule ct_idle_or_in_cur_domain'_lift)
+      apply (wp hoare_vcg_disj_lift)+
   done
 
+lemma setObject_ap_ksDomScheduleIdx [wp]:
+  "\<lbrace>\<lambda>s. P (ksDomScheduleIdx s)\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. \<lambda>s. P (ksDomScheduleIdx s)\<rbrace>"
+  by (wp updateObject_default_inv|simp add:setObject_def | wpc)+
+
+lemma setObject_asidpool_tcbs_of'[wp]:
+  "setObject c (asidpool::asidpool) \<lbrace>\<lambda>s. P' (tcbs_of' s)\<rbrace>"
+  by setObject_easy_cases
+
 lemma setASIDPool_invs [wp]:
   "\<lbrace>invs' and valid_asid_pool' ap\<rbrace> setObject p (ap::asidpool) \<lbrace>\<lambda>_. invs'\<rbrace>"
-  apply (simp add: invs'_def valid_pspace'_def valid_dom_schedule'_def)
+  apply (simp add: invs'_def valid_state'_def valid_pspace'_def)
   apply (rule hoare_pre)
    apply (wp sch_act_wf_lift valid_global_refs_lift' irqs_masked_lift
              valid_arch_state_lift' valid_irq_node_lift
@@ -2852,10 +3374,6 @@ crunch unmapPageTable
            crunch_wps
      simp: crunch_simps setCurrentPD_to_abs)
 
-crunch unmapPageTable
-  for sc_at'_n[wp]: "sc_at'_n n p"
-  (simp: crunch_simps wp: crunch_wps)
-
 lemma perform_pti_invs [wp]:
   "\<lbrace>invs' and valid_pti' pti\<rbrace> performPageTableInvocation pti \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (clarsimp simp: performPageTableInvocation_def getSlotCap_def
@@ -2876,6 +3394,9 @@ lemma perform_pti_invs [wp]:
   apply (clarsimp simp: cte_wp_at_ctes_of valid_pti'_def)
   done
 
+crunch setVMRootForFlush
+  for invs'[wp]: "invs'"
+
 lemma mapM_storePTE_invs:
   "\<lbrace>invs' and valid_pte' pte\<rbrace> mapM (swp storePTE pte) ps \<lbrace>\<lambda>xa. invs'\<rbrace>"
   apply (rule hoare_post_imp)
@@ -2902,6 +3423,12 @@ crunch unmapPage
   for cte_wp_at': "\<lambda>s. P (cte_wp_at' P' p s)"
   (wp: crunch_wps simp: crunch_simps)
 
+lemmas unmapPage_typ_ats [wp] = typ_at_lifts [OF unmapPage_typ_at']
+
+crunch lookupPTSlot
+  for inv: P
+  (wp: crunch_wps simp: crunch_simps)
+
 lemma flushPage_invs' [wp]:
   "\<lbrace>invs'\<rbrace> flushPage sz pd asid vptr \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: flushPage_def)
@@ -2935,8 +3462,8 @@ lemma perform_pt_invs [wp]:
   "\<lbrace>invs' and valid_page_inv' pt\<rbrace> performPageInvocation pt \<lbrace>\<lambda>_. invs'\<rbrace>"
   apply (simp add: performPageInvocation_def)
   apply (cases pt)
-     apply (clarsimp simp: cur_tcb'_asrt_def)
-     apply ((wp dmo_invs' hoare_vcg_all_lift setVMRootForFlush_invs' | simp add: cur_tcb'_def)+)[2]
+     apply clarsimp
+     apply ((wp dmo_invs' hoare_vcg_all_lift setVMRootForFlush_invs' | simp add: tcb_at_invs')+)[2]
        apply (rule hoare_pre_imp[of _ \<top>], assumption)
        apply (clarsimp simp: valid_def
                              disj_commute[of "pointerInUserData p s" for p s])
@@ -3013,46 +3540,10 @@ lemma isPDCap_PD :
   "isPDCap (ArchObjectCap (PageDirectoryCap r m))"
   by (simp add: isPDCap_def)
 
-lemma lookupIPCBuffer_valid_ipc_buffer [wp]:
-  "\<lbrace>valid_objs'\<rbrace> lookupIPCBuffer b t \<lbrace>case_option \<top> valid_ipc_buffer_ptr'\<rbrace>"
-  unfolding lookupIPCBuffer_def ARM_H.lookupIPCBuffer_def
-  apply (simp add: Let_def getSlotCap_def getThreadBufferSlot_def
-                   locateSlot_conv threadGet_getObject)
-  apply (wp getCTE_wp getObject_tcb_wp | wpc)+
-  apply (clarsimp simp del: imp_disjL)
-  apply (drule obj_at_ko_at')
-  apply (clarsimp simp del: imp_disjL)
-  apply (rule_tac x = ko in exI)
-  apply (frule ko_at_cte_ipcbuffer)
-  apply (clarsimp simp: cte_wp_at_ctes_of simp del: imp_disjL)
-  apply (rename_tac d ref rghts sz mapdata)
-  apply (clarsimp simp: valid_ipc_buffer_ptr'_def)
-  apply (frule (1) ko_at_valid_objs')
-   apply (clarsimp simp: projectKO_opts_defs split: kernel_object.split_asm)
-  apply (clarsimp simp: valid_obj'_def valid_tcb'_def
-                        isCap_simps cte_level_bits_def field_simps)
-  apply (drule bspec [OF _ ranI [where a = "0x20"]])
-   apply simp
-  apply (clarsimp simp: valid_cap'_def)
-  apply (rule conjI)
-   apply (rule aligned_add_aligned)
-     apply (clarsimp simp: capAligned_def)
-     apply assumption
-    apply (erule is_aligned_andI1)
-   apply (case_tac sz; simp add: msg_align_bits)
-  apply (clarsimp simp: capAligned_def)
-  apply (drule_tac x = "(tcbIPCBuffer ko && mask (pageBitsForSize sz)) >> pageBits" in spec)
-  apply (subst(asm) mult.commute mult.left_commute, subst(asm) shiftl_t2n[symmetric])
-  apply (simp add: shiftr_shiftl1)
-  apply (subst (asm) mask_out_add_aligned)
-   apply (erule is_aligned_weaken [OF _ pbfs_atleast_pageBits])
-  apply (erule mp)
-  apply (rule shiftr_less_t2n)
-  apply (clarsimp simp: pbfs_atleast_pageBits)
-  apply (rule and_mask_less')
-  apply (simp add: word_bits_conv)
-  done
 
 end
 
+lemma cteCaps_of_ctes_of_lift:
+  "(\<And>P. \<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ctes_of s)\<rbrace>) \<Longrightarrow> \<lbrace>\<lambda>s. P (cteCaps_of s) \<rbrace> f \<lbrace>\<lambda>_ s. P (cteCaps_of s)\<rbrace>"
+  unfolding cteCaps_of_def .
 end
diff --git a/proof/refine/ARM/orphanage/Orphanage.thy b/proof/refine/ARM/orphanage/Orphanage.thy
index b4a61208b5..efe187dda3 100644
--- a/proof/refine/ARM/orphanage/Orphanage.thy
+++ b/proof/refine/ARM/orphanage/Orphanage.thy
@@ -14,7 +14,7 @@ text \<open>
   or about to be switched to, or be in a scheduling queue.
 \<close>
 
-(*FIXME: arch_split: move up? *)
+(*FIXME: arch-split: move up? *)
 context Arch begin
 
 requalify_facts
@@ -30,7 +30,7 @@ requalify_facts
 end
 end
 
-context begin interpretation Arch . (*FIXME: arch_split*)
+context begin interpretation Arch . (*FIXME: arch-split*)
 
 definition
    is_active_thread_state :: "thread_state \<Rightarrow> bool"
@@ -1058,7 +1058,7 @@ crunch cteInsert, setExtraBadge, setMessageInfo, transferCaps, copyMRs,
 crunch doIPCTransfer, setMRs, setEndpoint
   for ksReadyQueues [wp]: "\<lambda>s. P (ksReadyQueues s)"
   and no_orphans [wp]: "no_orphans"
-  (wp: transferCapsToSlots_pres1 crunch_wps no_orphans_lift updateObject_default_inv)
+  (wp: no_orphans_lift updateObject_default_inv)
 
 lemma sendIPC_no_orphans [wp]:
   "\<lbrace>\<lambda>s. no_orphans s \<and> valid_objs' s \<and> sch_act_wf (ksSchedulerAction s) s\<rbrace>
@@ -1797,11 +1797,11 @@ lemma invokeIRQControl_no_orphans [wp]:
   apply (wp | clarsimp)+
   done
 
-lemma invokeIRQHandler_no_orphans [wp]:
+lemma arch_invokeIRQHandler_no_orphans[wp]:
   "\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
-   invokeIRQHandler i
+   ARM_H.invokeIRQHandler i
    \<lbrace> \<lambda>reply s. no_orphans s \<rbrace>"
-  apply (cases i, simp_all add: invokeIRQHandler_def)
+  apply (cases i, simp_all add: ARM_H.invokeIRQHandler_def)
     apply (wp | clarsimp | fastforce)+
   done
 
@@ -1939,7 +1939,7 @@ lemma setDomain_no_orphans [wp]:
   apply (fastforce simp: tcb_at_typ_at'  is_active_tcb_ptr_runnable')
   done
 
-crunch InterruptDecls_H.invokeIRQHandler
+crunch invokeIRQHandler
   for no_orphans[wp]: no_orphans
 
 lemma performInvocation_no_orphans [wp]: